summaryrefslogtreecommitdiffstats
path: root/Tests/FindPython/Python3Fail
diff options
context:
space:
mode:
authorSebastian Holtermann <sebholt@xwmw.org>2019-09-08 13:27:02 (GMT)
committerSebastian Holtermann <sebholt@xwmw.org>2019-09-16 16:18:48 (GMT)
commit05126d23f6a285731dfef940012c6b78feb9fa62 (patch)
treebf5ba7ee2514cbffa2bfdcc95bad591c65c0d810 /Tests/FindPython/Python3Fail
parentf54c5ee52195ae2d73a54faef9399ab977b83a1b (diff)
downloadCMake-05126d23f6a285731dfef940012c6b78feb9fa62.zip
CMake-05126d23f6a285731dfef940012c6b78feb9fa62.tar.gz
CMake-05126d23f6a285731dfef940012c6b78feb9fa62.tar.bz2
Autogen: Remove CMAKE_INCLUDE_DIRECTORIES_PROJECT_BEFORE sort duplication
This removes code that sorts include directories for `AUTOMOC` according to `CMAKE_INCLUDE_DIRECTORIES_PROJECT_BEFORE`. This is possible because the included directories passed to `AUTOMOC` are already sorted, also with respect to `CMAKE_INCLUDE_DIRECTORIES_PROJECT_BEFORE`.
Diffstat (limited to 'Tests/FindPython/Python3Fail')
0 files changed, 0 insertions, 0 deletions
generated by cgit v0.12 at 2026-01-13 01:46:35 (GMT)
*/ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ - Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ - Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */ - Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ - Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ + int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ + int (*tcl_UniCharToLower) (int ch); /* 321 */ + int (*tcl_UniCharToTitle) (int ch); /* 322 */ + int (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ @@ -2223,7 +2223,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ - Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 15411d8..987d2ae 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2261,8 +2261,11 @@ UtfToUtfProc( const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result, numChars; - Tcl_UniChar ch; + Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; + if (flags & TCL_ENCODING_START) { + *chPtr = 0; + } result = TCL_OK; srcStart = src; @@ -2311,12 +2314,14 @@ UtfToUtfProc( * incomplete char its byts are made to represent themselves. */ - ch = (unsigned char) *src; + *chPtr = (unsigned char) *src; src += 1; - dst += Tcl_UniCharToUtf(ch, dst); + dst += Tcl_UniCharToUtf(*chPtr, dst); } else { - src += Tcl_UtfToUniChar(src, &ch); - dst += Tcl_UniCharToUtf(ch, dst); + int n = Tcl_UtfToUniChar(src, chPtr); + src += n; + if (!n) numChars--; + dst += Tcl_UniCharToUtf(*chPtr, dst); } } @@ -2372,8 +2377,11 @@ UnicodeToUtfProc( const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars; - Tcl_UniChar ch; + Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; + if (flags & TCL_ENCODING_START) { + *chPtr = 0; + } result = TCL_OK; if ((srcLen % sizeof(Tcl_UniChar)) != 0) { result = TCL_CONVERT_MULTIBYTE; @@ -2398,11 +2406,13 @@ UnicodeToUtfProc( * Tcl_UniChar-size data. */ - ch = *(Tcl_UniChar *)src; - if (ch && ch < 0x80) { - *dst++ = (ch & 0xFF); + *chPtr = *(Tcl_UniChar *)src; + if (*chPtr && *chPtr < 0x80) { + *dst++ = (*chPtr & 0xFF); } else { - dst += Tcl_UniCharToUtf(ch, dst); + int n = Tcl_UniCharToUtf(*chPtr, dst); + dst += n; + if (!n) --numChars;/* Don't count high surrogates */ } src += sizeof(Tcl_UniChar); } @@ -2459,8 +2469,11 @@ UtfToUnicodeProc( { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; - Tcl_UniChar ch; + Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; + if (flags & TCL_ENCODING_START) { + *chPtr = 0; + } srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; @@ -2486,7 +2499,7 @@ UtfToUnicodeProc( result = TCL_CONVERT_NOSPACE; break; } - src += TclUtfToUniChar(src, &ch); + src += TclUtfToUniChar(src, chPtr); /* * Need to handle this in a way that won't cause misalignment by @@ -2495,11 +2508,11 @@ UtfToUnicodeProc( */ #ifdef WORDS_BIGENDIAN - *dst++ = (ch >> 8); - *dst++ = (ch & 0xFF); + *dst++ = (*chPtr >> 8); + *dst++ = (*chPtr & 0xFF); #else - *dst++ = (ch & 0xFF); - *dst++ = (ch >> 8); + *dst++ = (*chPtr & 0xFF); + *dst++ = (*chPtr >> 8); #endif } *srcReadPtr = src - srcStart; @@ -2556,7 +2569,7 @@ TableToUtfProc( const char *srcStart, *srcEnd; const char *dstEnd, *dstStart, *prefixBytes; int result, byte, numChars; - Tcl_UniChar ch; + Tcl_UniChar ch = 0; const unsigned short *const *toUnicode; const unsigned short *pageZero; TableEncodingData *dataPtr = clientData; @@ -2665,7 +2678,7 @@ TableFromUtfProc( { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd, *prefixBytes; - Tcl_UniChar ch; + Tcl_UniChar ch = 0; int result, len, word, numChars; TableEncodingData *dataPtr = clientData; const unsigned short *const *fromUnicode; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 691c8d7..2df935b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4557,7 +4557,7 @@ TEBCresume( valuePtr->bytes+index, 1); } else { char buf[TCL_UTF_MAX]; - Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index); + int ch = Tcl_GetUniChar(valuePtr, index); /* * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1) diff --git a/generic/tclParse.c b/generic/tclParse.c index 3c984bf..66a1575 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -808,7 +808,7 @@ TclParseBackslash( * written there. */ { register const char *p = src+1; - Tcl_UniChar unichar; + Tcl_UniChar unichar = 0; int result; int count; char buf[TCL_UTF_MAX]; @@ -958,6 +958,15 @@ TclParseBackslash( if (readPtr != NULL) { *readPtr = count; } + if ((result & 0xF800) == 0xD800) { + /* If result is a surrogate, Tcl_UniCharToUtf will try to + * handle that especially, but we don't want that here. + */ + dst[2] = (char) ((result | 0x80) & 0xBF); + dst[1] = (char) (((result >> 6) | 0x80) & 0xBF); + dst[0] = (char) ((result >> 12) | 0xE0); + return 3; + } return Tcl_UniCharToUtf(result, dst); } @@ -1356,7 +1365,7 @@ Tcl_ParseVarName( register const char *src; unsigned char c; int varIndex, offset; - Tcl_UniChar ch; + Tcl_UniChar ch = 0; unsigned array; if ((numBytes == 0) || (start == NULL)) { diff --git a/generic/tclScan.c b/generic/tclScan.c index d21bfaf..0a6f49f 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -72,7 +72,7 @@ BuildCharSet( CharSet *cset, const char *format) /* Points to first char of set. */ { - Tcl_UniChar ch, start; + Tcl_UniChar ch = 0, start; int offset, nranges; const char *end; @@ -257,7 +257,7 @@ ValidateFormat( { int gotXpg, gotSequential, value, i, flags; char *end; - Tcl_UniChar ch; + Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); char buf[TCL_UTF_MAX+1]; @@ -570,7 +570,7 @@ Tcl_ScanObjCmd( char op = 0; int width, underflow = 0; Tcl_WideInt wideValue; - Tcl_UniChar ch, sch; + Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; char buf[513]; /* Temporary buffer to hold scanned number @@ -870,9 +870,15 @@ Tcl_ScanObjCmd( * Scan a single Unicode character. */ - string += Tcl_UtfToUniChar(string, &sch); + offset = Tcl_UtfToUniChar(string, &sch); + i = (int)sch; + if (!offset) { + offset = Tcl_UtfToUniChar(string, &sch); + i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); + } + string += offset; if (!(flags & SCAN_SUPPRESS)) { - objPtr = Tcl_NewIntObj((int)sch); + objPtr = Tcl_NewIntObj(i); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 993a694..5838c0f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -531,7 +531,7 @@ Tcl_GetCharLength( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ @@ -548,7 +548,7 @@ Tcl_GetUniChar( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); - return (Tcl_UniChar) bytes[index]; + return (int) bytes[index]; } /* @@ -572,7 +572,7 @@ Tcl_GetUniChar( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - return stringPtr->unicode[index]; + return (int) stringPtr->unicode[index]; } /* @@ -1708,6 +1708,7 @@ Tcl_AppendFormatToObj( const char *span = format, *msg, *errCode; int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; int originalLength, limit; + Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; static const char *const badIndex[2] = { @@ -1732,7 +1733,6 @@ Tcl_AppendFormatToObj( int width, gotPrecision, precision, useShort, useWide, useBig; int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; Tcl_Obj *segment; - Tcl_UniChar ch; int step = Tcl_UtfToUniChar(format, &ch); format += step; diff --git a/generic/tclUniData.c b/generic/tclUniData.c index 6cff83a..c5343da 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -151,7 +151,247 @@ static const unsigned short pageMap[] = { 42, 42, 291, 42, 291, 42, 42, 292, 56, 293, 294, 295, 42, 42, 296, 297, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 298, 299, 42, 300, 42, 301, 302, 303, 304, 305, 306, 42, 42, 42, 307, 308, 2, 309, 310, 311, - 312, 313, 314 + 312, 313, 314, 315, 316, 317, 56, 42, 42, 42, 247, 318, 319, 320, 321, + 322, 56, 323, 324, 56, 56, 56, 56, 140, 42, 325, 56, 312, 326, 327, + 56, 328, 42, 329, 56, 330, 331, 332, 42, 333, 334, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 335, 336, 337, 56, 56, 56, 56, 56, 338, 339, 56, + 56, 56, 56, 56, 56, 340, 341, 342, 343, 56, 56, 56, 56, 42, 344, 345, + 346, 56, 56, 56, 56, 42, 42, 347, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 348, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 349, 350, 351, 352, 156, 353, 354, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 355, 56, 56, 56, 56, 320, 320, 320, 356, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 355, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 357, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 358, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 146, 146, 146, 146, + 146, 146, 146, 238, 146, 359, 146, 360, 361, 362, 363, 56, 146, 146, + 364, 56, 56, 56, 56, 56, 146, 146, 365, 366, 56, 56, 56, 56, 367, 368, + 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 367, 368, 380, + 370, 381, 382, 383, 374, 384, 385, 386, 387, 388, 389, 390, 391, 392, + 393, 394, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 146, 395, 146, 146, 237, 396, 397, 56, + 398, 399, 146, 400, 401, 56, 56, 402, 403, 401, 404, 56, 56, 56, 56, + 56, 146, 405, 146, 406, 237, 146, 407, 408, 146, 249, 409, 146, 146, + 146, 146, 410, 146, 363, 323, 411, 56, 56, 56, 412, 413, 414, 415, + 56, 146, 146, 416, 56, 146, 146, 146, 237, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 232, 56, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 123, 42, 42, + 42, 42, 42, 42, 333, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, + 56, 56, 56, 56, 56, 56, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 42, 42, 42, 42, 333 }; /* @@ -723,7 +963,189 @@ static const unsigned char groupMap[] = { 46, 46, 46, 46, 46, 46, 0, 0, 46, 46, 46, 46, 46, 46, 0, 0, 46, 46, 46, 46, 46, 46, 0, 0, 46, 46, 46, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, - 14, 0, 0 + 14, 0, 0, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 0, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 46, 46, 0, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 3, 3, 14, 0, 0, 0, 0, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, + 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, + 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, + 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, + 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 85, 0, 0, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 117, 46, 46, 46, 46, 46, 46, 46, 46, 117, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 3, 46, 46, 46, 46, 0, 0, + 0, 0, 46, 46, 46, 46, 46, 46, 46, 46, 3, 117, 117, 117, 117, 117, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 166, 166, 166, 166, 166, 166, 166, 166, + 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, + 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, + 166, 166, 166, 166, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, + 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, + 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, + 167, 167, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 46, 46, 46, 46, 46, 46, 0, 0, 46, 0, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 0, 46, 46, 0, 0, 0, 46, 0, 0, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 0, 0, 0, 0, 0, 3, 46, 85, 85, 85, 0, 85, 85, 0, 0, 0, 0, 0, 85, + 85, 85, 85, 46, 46, 46, 46, 0, 46, 46, 46, 0, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 0, 0, 0, 0, 85, 85, 85, 0, 0, 0, 0, 85, 18, 18, 18, + 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 18, 18, 3, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 0, + 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 115, + 85, 115, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 115, 115, + 115, 85, 85, 85, 85, 115, 115, 85, 85, 3, 3, 17, 3, 3, 3, 3, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 117, 117, + 117, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, + 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 0, 0, 0, 0, + 0, 0, 0, 46, 46, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 115, 115, 85, 85, 85, + 14, 14, 14, 115, 115, 115, 115, 115, 115, 17, 17, 17, 17, 17, 17, 17, + 17, 85, 85, 85, 85, 85, 85, 85, 85, 14, 14, 85, 85, 85, 85, 85, 85, + 85, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 85, 85, 85, + 85, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, + 14, 85, 85, 85, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 99, 0, 99, 99, 0, 0, 99, 0, 0, 99, 99, 0, 0, 99, 99, 99, 99, 0, 99, + 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, + 99, 0, 99, 99, 99, 99, 0, 0, 99, 99, 99, 99, 99, 99, 99, 99, 0, 99, + 99, 99, 99, 99, 99, 99, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, + 99, 0, 99, 99, 99, 99, 0, 99, 99, 99, 99, 99, 0, 99, 0, 0, 0, 99, 99, + 99, 99, 99, 99, 99, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, 99, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 15, 15, 15, 15, 15, 15, 0, 0, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, + 15, 15, 15, 15, 15, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 7, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, + 15, 15, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 7, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 7, 15, 15, 15, 15, 15, 15, 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, + 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 99, + 15, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, + 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 0, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 0, 14, 0, 14, + 0, 14, 0, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, + 14, 0, 14, 0, 0, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0 }; /* @@ -767,7 +1189,7 @@ static const int groups[] = { 13, 14, -246316991, -274694079, -270729151, 917569, 917634, 524362, 524426, 852061, 852125, -352026559, -124977087, -351502271, 353730690, 353632386, -353238975, -352223167, -353337279, -353304511, -354385855, - 238026882, -1157758911, -1385430975, 18, 17 + 238026882, -1157758911, -1385430975, 18, 17, 1310785, 1310850 }; /* @@ -775,7 +1197,8 @@ static const int groups[] = { * Unicode character. */ -#define UNICODE_CATEGORY_MASK 0X1F +#define UNICODE_CATEGORY_MASK 0x1F +#define UNICODE_OUT_OF_RANGE 0x2FA20u enum { UNASSIGNED, @@ -817,13 +1240,13 @@ enum { */ #define GetCaseType(info) (((info) & 0xE0) >> 5) -#define GetCategory(info) ((info) & 0x1F) +#define GetCategory(ch) (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) #define GetDelta(info) (((info) > 0) ? ((info) >> 15) : (~(~((info)) >> 15))) /* * This macro extracts the information about a character from the - * Unicode character tables. + * Unicode character tables. It may only be used for (unsigned) ch < UNICODE_OUT_OF_RANGE */ -#define GetUniCharInfo(ch) (groups[groupMap[(pageMap[(((int)(ch)) & 0xffff) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))]]) +#define GetUniCharInfo(ch) (groups[groupMap[(pageMap[((int)(ch)) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))]]) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index ab26779..5819bcd 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -122,6 +122,11 @@ UtfCount( return 3; } #if TCL_UTF_MAX > 3 +#if TCL_UTF_MAX == 4 + if (ch <= 0x10FFFF) { + return 4; + } +#else if (ch <= 0x1FFFFF) { return 4; } @@ -132,6 +137,7 @@ UtfCount( return 6; } #endif +#endif return 3; } @@ -173,6 +179,23 @@ Tcl_UniCharToUtf( return 2; } if (ch <= 0xFFFF) { +#if TCL_UTF_MAX == 4 + if ((ch & 0xF800) == 0xD800) { + if (ch & 0x0400) { + /* Low surrogate */ + buf[3] = (char) ((ch | 0x80) & 0xBF); + buf[2] |= (char) (((ch >> 6) | 0x80) & 0x8F); + return 4; + } else { + /* High surrogate */ + ch += 0x40; + buf[2] = (char) (((ch << 4) | 0x80) & 0xB0); + buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF); + buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7); + return 0; + } + } +#endif three: buf[2] = (char) ((ch | 0x80) & 0xBF); buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF); @@ -181,6 +204,15 @@ Tcl_UniCharToUtf( } #if TCL_UTF_MAX > 3 +#if TCL_UTF_MAX == 4 + if (ch <= 0x10FFFF) { + buf[3] = (char) ((ch | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 18) | 0xF0); + return 4; + } +#else if (ch <= 0x1FFFFF) { buf[3] = (char) ((ch | 0x80) & 0xBF); buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF); @@ -206,6 +238,7 @@ Tcl_UniCharToUtf( return 6; } #endif +#endif } ch = 0xFFFD; @@ -282,6 +315,16 @@ Tcl_UniCharToUtfDString( * *chPtr is filled with the Tcl_UniChar, and the return value is the * number of bytes from the UTF-8 string that were consumed. * + * If TCL_UTF_MAX == 4, special handling of Surrogate pairs is done: + * + * If the UTF-8 string represents a character outside of the BMP, the + * first call to this function will fill *chPtr with the high surrogate + * and generate a return value of 0. Calling Tcl_UtfToUniChar again + * will produce the low surrogate and a return value of 4. Because *chPtr + * is used to remember whether the high surrogate is already produced, it + * is recommended to initialize the variable it points to as 0 before + * the first call to Tcl_UtfToUniChar is done. + * * Side effects: * None. * @@ -345,8 +388,40 @@ Tcl_UtfToUniChar( *chPtr = (Tcl_UniChar) byte; return 1; +#if TCL_UTF_MAX == 4 + } else if (byte < 0xF8) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { + Tcl_UniChar surrogate; + /* + * Four-byte-character lead byte followed by three trail bytes. + */ + + byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) + | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000; + surrogate = 0xD800 + (byte >> 10); + if (byte & 0x100000) { + /* out of range, < 0x10000 or > 0x10ffff */ + } else if (*chPtr != surrogate) { + /* produce high surrogate, but don't advance source pointer */ + *chPtr = surrogate; + return 0; + } else { + /* produce low surrogate, and advance source pointer */ + *chPtr = (Tcl_UniChar) (0xDC00 | (byte & 0x3FF)); + return 4; + } + } + + /* + * A four-byte-character lead-byte not followed by three trail-bytes + * or representing a character < 0x10000 or > 0x10ffff represents itself. + */ + + *chPtr = (Tcl_UniChar) byte; + return 1; +#endif } -#if TCL_UTF_MAX > 3 +#if TCL_UTF_MAX > 4 { int ch, total, trail; @@ -401,7 +476,7 @@ Tcl_UtfToUniCharDString( * appended to this previously initialized * DString. */ { - Tcl_UniChar *w, *wString; + Tcl_UniChar ch, *w, *wString; const char *p, *end; int oldLength; @@ -423,8 +498,8 @@ Tcl_UtfToUniCharDString( w = wString; end = src + length; for (p = src; p < end; ) { - p += TclUtfToUniChar(p, w); - w++; + p += TclUtfToUniChar(p, &ch); + *w++ = ch; } *w = '\0'; Tcl_DStringSetLength(dsPtr, @@ -488,7 +563,7 @@ Tcl_NumUtfChars( int length) /* The length of the string in bytes, or -1 * for strlen(string). */ { - Tcl_UniChar ch; + Tcl_UniChar ch = 0; register Tcl_UniChar *chPtr = &ch; register int i; @@ -548,7 +623,7 @@ Tcl_UtfFindFirst( int ch) /* The Tcl_UniChar to search for. */ { int len; - Tcl_UniChar find; + Tcl_UniChar find = 0; while (1) { len = TclUtfToUniChar(src, &find); @@ -587,7 +662,7 @@ Tcl_UtfFindLast( int ch) /* The Tcl_UniChar to search for. */ { int len; - Tcl_UniChar find; + Tcl_UniChar find = 0; const char *last; last = NULL; @@ -627,8 +702,7 @@ const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { - Tcl_UniChar ch; - + Tcl_UniChar ch = 0; return src + TclUtfToUniChar(src, &ch); } @@ -700,16 +774,25 @@ Tcl_UtfPrev( *--------------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharAtIndex( register const char *src, /* The UTF-8 string to dereference. */ register int index) /* The position of the desired character. */ { - Tcl_UniChar ch = 0; - - while (index >= 0) { - index--; - src += TclUtfToUniChar(src, &ch); + Tcl_UniChar unichar = 0; + int bytes; + int ch = 0; + + while (index-- >= 0) { + bytes = TclUtfToUniChar(src, &unichar); + ch = unichar; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &unichar); + /* Combine surrogates */ + ch = (((ch & 0x3ff) << 10) | (unichar & 0x3ff)) + 0x10000; + } + src += bytes; } return ch; } @@ -736,11 +819,16 @@ Tcl_UtfAtIndex( register const char *src, /* The UTF-8 string. */ register int index) /* The position of the desired character. */ { - Tcl_UniChar ch; + Tcl_UniChar ch = 0; + int len; while (index > 0) { - index--; - src += TclUtfToUniChar(src, &ch); + index--; + len = TclUtfToUniChar(src, &ch); + if (!len) { + len = TclUtfToUniChar(src, &ch); + } + src += len; } return src; } @@ -820,7 +908,8 @@ int Tcl_UtfToUpper( char *str) /* String to convert in place. */ { - Tcl_UniChar ch, upChar; + Tcl_UniChar ch = 0; + int upChar; char *src, *dst; int bytes; @@ -831,7 +920,14 @@ Tcl_UtfToUpper( src = dst = str; while (*src) { bytes = TclUtfToUniChar(src, &ch); - upChar = Tcl_UniCharToUpper(ch); + upChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + upChar = Tcl_UniCharToUpper(upChar); /* * To keep badly formed Utf strings from getting inflated by the @@ -873,7 +969,8 @@ int Tcl_UtfToLower( char *str) /* String to convert in place. */ { - Tcl_UniChar ch, lowChar; + Tcl_UniChar ch = 0; + int lowChar; char *src, *dst; int bytes; @@ -884,7 +981,14 @@ Tcl_UtfToLower( src = dst = str; while (*src) { bytes = TclUtfToUniChar(src, &ch); - lowChar = Tcl_UniCharToLower(ch); + lowChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + lowChar = Tcl_UniCharToLower(lowChar); /* * To keep badly formed Utf strings from getting inflated by the @@ -927,7 +1031,8 @@ int Tcl_UtfToTitle( char *str) /* String to convert in place. */ { - Tcl_UniChar ch, titleChar, lowChar; + Tcl_UniChar ch = 0; + int titleChar, lowChar; char *src, *dst; int bytes; @@ -940,7 +1045,14 @@ Tcl_UtfToTitle( if (*src) { bytes = TclUtfToUniChar(src, &ch); - titleChar = Tcl_UniCharToTitle(ch); + titleChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + titleChar = Tcl_UniCharToTitle(titleChar); if (bytes < UtfCount(titleChar)) { memcpy(dst, src, (size_t) bytes); @@ -952,7 +1064,14 @@ Tcl_UtfToTitle( } while (*src) { bytes = TclUtfToUniChar(src, &ch); - lowChar = Tcl_UniCharToLower(ch); + lowChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + lowChar = Tcl_UniCharToLower(lowChar); if (bytes < UtfCount(lowChar)) { memcpy(dst, src, (size_t) bytes); @@ -1036,7 +1155,7 @@ Tcl_UtfNcmp( const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { - Tcl_UniChar ch1, ch2; + Tcl_UniChar ch1 = 0, ch2 = 0; /* * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the @@ -1084,7 +1203,7 @@ Tcl_UtfNcasecmp( const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { - Tcl_UniChar ch1, ch2; + Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. @@ -1120,14 +1239,14 @@ Tcl_UtfNcasecmp( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharToUpper( int ch) /* Unicode character to convert. */ { - int info = GetUniCharInfo(ch); + int info = (ch < UNICODE_OUT_OF_RANGE) ? GetUniCharInfo(ch) : 0; if (GetCaseType(info) & 0x04) { - return (Tcl_UniChar) (ch - GetDelta(info)); + return ch - GetDelta(info); } else { return ch; } @@ -1149,14 +1268,14 @@ Tcl_UniCharToUpper( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharToLower( int ch) /* Unicode character to convert. */ { - int info = GetUniCharInfo(ch); + int info = (ch < UNICODE_OUT_OF_RANGE) ? GetUniCharInfo(ch) : 0; if (GetCaseType(info) & 0x02) { - return (Tcl_UniChar) (ch + GetDelta(info)); + return ch + GetDelta(info); } else { return ch; } @@ -1178,11 +1297,11 @@ Tcl_UniCharToLower( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharToTitle( int ch) /* Unicode character to convert. */ { - int info = GetUniCharInfo(ch); + int info = (ch < UNICODE_OUT_OF_RANGE) ? GetUniCharInfo(ch) : 0; int mode = GetCaseType(info); if (mode & 0x1) { @@ -1192,7 +1311,7 @@ Tcl_UniCharToTitle( return (Tcl_UniChar) (ch + ((mode & 0x4) ? -1 : 1)); } else if (mode == 0x4) { - return (Tcl_UniChar) (ch - GetDelta(info)); + return ch - GetDelta(info); } else { return ch; } @@ -1329,9 +1448,10 @@ int Tcl_UniCharIsAlnum( int ch) /* Unicode character to test. */ { - register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - - return (((ALPHA_BITS | DIGIT_BITS) >> category) & 1); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1); } /* @@ -1354,8 +1474,10 @@ int Tcl_UniCharIsAlpha( int ch) /* Unicode character to test. */ { - register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - return ((ALPHA_BITS >> category) & 1); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return ((ALPHA_BITS >> GetCategory(ch)) & 1); } /* @@ -1378,7 +1500,10 @@ int Tcl_UniCharIsControl( int ch) /* Unicode character to test. */ { - return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == CONTROL); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return (GetCategory(ch) == CONTROL); } /* @@ -1401,7 +1526,10 @@ int Tcl_UniCharIsDigit( int ch) /* Unicode character to test. */ { - return (GetUniCharInfo(ch)&UNICODE_CATEGORY_MASK) == DECIMAL_DIGIT_NUMBER; + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER); } /* @@ -1424,8 +1552,10 @@ int Tcl_UniCharIsGraph( int ch) /* Unicode character to test. */ { - register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - return (((PRINT_BITS >> category) & 1) && ((unsigned char) ch != ' ')); + if ((ch == ' ') || (ch > UNICODE_OUT_OF_RANGE)) { + return (ch >= 0xE0100u) && (ch <= 0xE01EFu); + } + return ((PRINT_BITS >> GetCategory(ch)) & 1); } /* @@ -1448,7 +1578,10 @@ int Tcl_UniCharIsLower( int ch) /* Unicode character to test. */ { - return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return (GetCategory(ch) == LOWERCASE_LETTER); } /* @@ -1471,8 +1604,10 @@ int Tcl_UniCharIsPrint( int ch) /* Unicode character to test. */ { - register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - return ((PRINT_BITS >> category) & 1); + if (ch > UNICODE_OUT_OF_RANGE) { + return (ch >= 0xE0100u) && (ch <= 0xE01EFu); + } + return ((PRINT_BITS >> GetCategory(ch)) & 1); } /* @@ -1495,8 +1630,10 @@ int Tcl_UniCharIsPunct( int ch) /* Unicode character to test. */ { - register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - return ((PUNCT_BITS >> category) & 1); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return ((PUNCT_BITS >> GetCategory(ch)) & 1); } /* @@ -1519,8 +1656,6 @@ int Tcl_UniCharIsSpace( int ch) /* Unicode character to test. */ { - register int category; - /* * If the character is within the first 127 characters, just use the * standard C function, otherwise consult the Unicode table. @@ -1528,9 +1663,10 @@ Tcl_UniCharIsSpace( if (ch < 0x80) { return TclIsSpaceProc((char)ch); + } else if (ch > UNICODE_OUT_OF_RANGE) { + return 0; } else { - category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - return ((SPACE_BITS >> category) & 1); + return ((SPACE_BITS >> GetCategory(ch)) & 1); } } @@ -1554,7 +1690,10 @@ int Tcl_UniCharIsUpper( int ch) /* Unicode character to test. */ { - return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return (GetCategory(ch) == UPPERCASE_LETTER); } /* @@ -1577,9 +1716,10 @@ int Tcl_UniCharIsWordChar( int ch) /* Unicode character to test. */ { - register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK); - - return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1); + if (ch > UNICODE_OUT_OF_RANGE) { + return 0; + } + return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> GetCategory(ch)) & 1); } /* @@ -1613,7 +1753,7 @@ Tcl_UniCharCaseMatch( * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { - Tcl_UniChar ch1, p; + Tcl_UniChar ch1 = 0, p; while (1) { p = *uniPattern; diff --git a/tests/encoding.test b/tests/encoding.test index a4f8449..d14d8f0 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -327,9 +327,14 @@ test encoding-16.1 {UnicodeToUtfProc} { set val [encoding convertfrom unicode NN] list $val [format %x [scan $val %c]] } "\u4e4e 4e4e" +test encoding-16.2 {UnicodeToUtfProc} -constraints utf16 -body { + set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"] + list $val [format %x [scan $val %c]] +} -result "\U460dc 460dc" -test encoding-17.1 {UtfToUnicodeProc} { -} {} +test encoding-17.1 {UtfToUnicodeProc} -constraints utf16 -body { + encoding convertto unicode "\U460dc" +} -result "\xd8\xd8\xdc\xdc" test encoding-18.1 {TableToUtfProc} { } {} diff --git a/tests/string.test b/tests/string.test index 1a62a66..73640bf 100644 --- a/tests/string.test +++ b/tests/string.test @@ -571,12 +571,12 @@ test string-6.85 {string is control} { } 0 test string-6.86 {string is graph} { ## graph is any print char, except space - list [string is gra -fail var "0123abc!@#\$\u0100 "] $var -} {0 12} + list [string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "] $var +} {0 14} test string-6.87 {string is print} { ## basically any printable char - list [string is print -fail var "0123abc!@#\$\u0100 \u0010"] $var -} {0 13} + list [string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"] $var +} {0 15} test string-6.88 {string is punct} { ## any graph char that isn't alnum list [string is punct -fail var "_!@#\u00beq0"] $var diff --git a/tests/utf.test b/tests/utf.test index 64b5cd4..04bf9f2 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -15,6 +15,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { catch {unset x} +# Some tests require support for utf16 + +testConstraint utf16 [expr {[format %c 0x010000] != [bytestring "\xef\xbf\xbd"]}] + test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} { set x \x01 } [bytestring "\x01"] @@ -27,10 +31,13 @@ test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} { test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} { set x "\u4e4e" } [bytestring "\xe4\xb9\x8e"] -test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} { +test utf-1.5 {Tcl_UniCharToUtf: 4 byte sequences} -constraints utf16 -body { + set x "\U014e4e" +} -result [bytestring "\xf0\x94\xb9\x8e"] +test utf-1.6 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} { format %c 0x110000 } [bytestring "\xef\xbf\xbd"] -test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} { +test utf-1.7 {Tcl_UniCharToUtf: negative Tcl_UniChar} { format %c -1 } [bytestring "\xef\xbf\xbd"] @@ -55,9 +62,21 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} { test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} { string length [bytestring "\xE4\xb9\x8e"] } {1} -test utf-2.8 {Tcl_UtfToUniChar: longer UTF sequences not supported} { - string length [bytestring "\xF4\xA2\xA2\xA2"] +test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints utf16 -body { + string length [bytestring "\xF0\x90\x80\x80"] +} -result {1} +test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints utf16 -body { + string length [bytestring "\xF4\x8F\xBF\xBF"] +} -result {1} +test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} { + string length [bytestring "\xF0\x8F\xBF\xBF"] } {4} +test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} { + string length [bytestring "\xF4\x90\x80\x80"] +} {4} +test utf-2.12 {Tcl_UtfToUniChar: longer UTF sequences not supported} { + string length [bytestring "\xF8\xA2\xA2\xA2\xA2"] +} {5} test utf-3.1 {Tcl_UtfCharComplete} { } {} @@ -190,8 +209,16 @@ bsCheck \Ua1 161 bsCheck \U4e21 20001 bsCheck \U004e21 20001 bsCheck \U00004e21 20001 -bsCheck \U00110000 65533 -bsCheck \Uffffffff 65533 +bsCheck \U0000004e21 78 +if {[testConstraint utf16]} { + bsCheck \U00110000 69632 + bsCheck \U01100000 69632 + bsCheck \U11000000 69632 + bsCheck \U0010FFFF 1114111 + bsCheck \U010FFFF0 1114111 + bsCheck \U10FFFF00 1114111 + bsCheck \UFFFFFFFF 1048575 +} test utf-11.1 {Tcl_UtfToUpper} { string toupper {} @@ -259,8 +286,8 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} { string tolower aA } aa test utf-16.2 {Tcl_UniCharToLower, positive delta} { - string tolower \u0178\u00ff\uA78D -} \u00ff\u00ff\u0265 + string tolower \u0178\u00ff\uA78D\U10400 +} \u00ff\u00ff\u0265\U10428 test utf-17.1 {Tcl_UniCharToLower, no delta} { string tolower ! diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl index 8576f9d..cce2138 100644 --- a/tools/uniParse.tcl +++ b/tools/uniParse.tcl @@ -44,17 +44,17 @@ proc uni::getValue {items index} { # Extract character info set category [lindex $items 2] - if {[scan [lindex $items 12] %4x toupper] == 1} { + if {[scan [lindex $items 12] %6x toupper] == 1} { set toupper [expr {$index - $toupper}] } else { set toupper {} } - if {[scan [lindex $items 13] %4x tolower] == 1} { + if {[scan [lindex $items 13] %6x tolower] == 1} { set tolower [expr {$tolower - $index}] } else { set tolower {} } - if {[scan [lindex $items 14] %4x totitle] == 1} { + if {[scan [lindex $items 14] %6x totitle] == 1} { set totitle [expr {$index - $totitle}] } else { set totitle {} @@ -101,25 +101,30 @@ proc uni::buildTables {data} { variable pMap {} variable pages {} variable groups {{0,,,}} + variable next 0 set info {} ;# temporary page info set mask [expr {(1 << $shift) - 1}] - set next 0 - foreach line [split $data \n] { if {$line eq ""} { - set line "FFFF;;Cn;0;ON;;;;;N;;;;;\n" + if {!($next & $mask)} { + # next character is already on page boundary + continue + } + # fill remaining page + set line [format %X [expr {($next-1)|$mask}]] + append line ";;Cn;0;ON;;;;;N;;;;;\n" } set items [split $line \;] scan [lindex $items 0] %x index - if {$index > 0xFFFF} then { - # Ignore non-BMP characters, as long as Tcl doesn't support them + if {$index >= 0xE0000} then { + # Ignore those characters, as they don't have case variants anyway continue } - set index [format 0x%0.4x $index] + set index [format %d $index] set gIndex [getGroup [getValue $items $index]] @@ -167,6 +172,7 @@ proc uni::main {} { variable groups variable shift variable titleCount + variable next if {$argc != 2} { puts stderr "\nusage: $argv0 \n" @@ -178,7 +184,7 @@ proc uni::main {} { buildTables $data puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]" - set size [expr {[llength $pMap] + [llength $pages]*(1<<$shift)}] + set size [expr {[llength $pMap]*2 + [llength $pages]*(1<<$shift)}] puts "shift = $shift, space = $size" puts "title case count = $titleCount" @@ -316,15 +322,17 @@ static const int groups\[\] = {" } } puts $f $line - puts $f "}; + puts -nonewline $f "}; /* * The following constants are used to determine the category of a * Unicode character. */ -#define UNICODE_CATEGORY_MASK 0X1F - +#define UNICODE_CATEGORY_MASK 0x1F +#define UNICODE_OUT_OF_RANGE " + puts $f [format 0x%Xu $next] + puts $f " enum { UNASSIGNED, UPPERCASE_LETTER, @@ -365,15 +373,15 @@ enum { */ #define GetCaseType(info) (((info) & 0xE0) >> 5) -#define GetCategory(info) ((info) & 0x1F) +#define GetCategory(ch) (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) #define GetDelta(info) (((info) > 0) ? ((info) >> 15) : (~(~((info)) >> 15))) /* * This macro extracts the information about a character from the - * Unicode character tables. + * Unicode character tables. It may only be used for (unsigned) ch < UNICODE_OUT_OF_RANGE */ -#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[(((int)(ch)) & 0xffff) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) +#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[((int)(ch)) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) " close $f -- cgit v0.12 From 39ad9eb8f353ef5355a28d18349f6319bf9fcc9c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Aug 2011 08:32:39 +0000 Subject: fix tests utf-2.8 and utf-2.9 --- generic/tclUtf.c | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 5819bcd..14061df 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -564,8 +564,7 @@ Tcl_NumUtfChars( * for strlen(string). */ { Tcl_UniChar ch = 0; - register Tcl_UniChar *chPtr = &ch; - register int i; + register int i, n; /* * The separate implementations are faster. @@ -577,18 +576,23 @@ Tcl_NumUtfChars( i = 0; if (length < 0) { while (*src != '\0') { - src += TclUtfToUniChar(src, chPtr); + n = TclUtfToUniChar(src, &ch); + if (!n) { + n = Tcl_UtfToUniChar(src, &ch); + } + src += n; i++; } } else { - register int n; - while (length > 0) { if (UCHAR(*src) < 0xC0) { length--; src++; } else { - n = Tcl_UtfToUniChar(src, chPtr); + n = Tcl_UtfToUniChar(src, &ch); + if (!n) { + n = Tcl_UtfToUniChar(src, &ch); + } length -= n; src += n; } @@ -823,7 +827,7 @@ Tcl_UtfAtIndex( int len; while (index > 0) { - index--; + index--; len = TclUtfToUniChar(src, &ch); if (!len) { len = TclUtfToUniChar(src, &ch); -- cgit v0.12 From ec9c29c80dd663668c326a4008a2f78696e76c93 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 18 Apr 2012 18:42:54 +0000 Subject: Experimental branch where the interp->result field and related are removed and all simplifications that makes possible are done. Seems this can at best be a Tcl 9 reform. --- generic/tcl.h | 16 +++++++++------- generic/tclBasic.c | 42 +++++++++++++++++++++++++++++++++++------- generic/tclHistory.c | 2 ++ generic/tclInt.h | 15 +++++++++++++++ generic/tclResult.c | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStubLib.c | 8 +++++++- generic/tclTest.c | 13 +++++++++++++ generic/tclUtil.c | 13 +++++++++++++ 8 files changed, 146 insertions(+), 15 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 729e521..46266d2 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -499,7 +499,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ - +#if 0 typedef struct Tcl_Interp { /* TIP #330: Strongly discourage extensions from using the string * result. */ @@ -529,6 +529,8 @@ typedef struct Tcl_Interp { int unused5 TCL_DEPRECATED_API("bad field access"); #endif } Tcl_Interp; +#endif +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -870,13 +872,13 @@ int Tcl_IsShared(Tcl_Obj *objPtr); */ typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; + char *unused1; + Tcl_FreeProc *unused2; Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[TCL_RESULT_SIZE+1]; + char *unused3; + int unused4; + int unused5; + char unused6[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e09ea1e..d55faeb 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -503,8 +503,10 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; +#if 0 iPtr->result = iPtr->resultSpace; iPtr->freeProc = NULL; +#endif iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); @@ -560,9 +562,11 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; +#if 0 iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; +#endif Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -591,7 +595,9 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); +#if 0 iPtr->resultSpace[0] = 0; +#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -1493,7 +1499,9 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); +#if 0 iPtr->result = NULL; +#endif Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1515,10 +1523,12 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } +#if 0 if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); iPtr->appendResult = NULL; } +#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2385,7 +2395,7 @@ TclInvokeStringCommand( * in the Command structure. * * Results: - * A standard Tcl string result value. + * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_CmdProc, @@ -2425,12 +2435,14 @@ TclInvokeObjectCommand( cmdPtr->objClientData, argc, objv); } +#if 0 /* * Move the interpreter's object result to the string result, then reset * the object result. */ (void) Tcl_GetStringResult(interp); +#endif /* * Decrement the ref counts for the argument objects created above, then @@ -3800,7 +3812,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -3812,8 +3824,8 @@ TclInterpReady( register Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -4333,10 +4345,11 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { - Interp *iPtr = (Interp *) interp; +/* Interp *iPtr = (Interp *) interp;*/ NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; +#if 0 /* * If the interpreter has a non-empty string result, the result object is * either empty or stale because some function set interp->result @@ -4350,6 +4363,7 @@ TclNRRunCallbacks( if (*(iPtr->result) != 0) { (void) Tcl_GetObjResult(interp); } +#endif while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); @@ -5828,6 +5842,7 @@ Tcl_Eval( * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { +#if 0 int code = Tcl_EvalEx(interp, script, -1, 0); /* @@ -5838,6 +5853,8 @@ Tcl_Eval( (void) Tcl_GetStringResult(interp); return code; +#endif + return Tcl_EvalEx(interp, script, -1, 0); } /* @@ -6335,9 +6352,11 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); +#if 0 if (result != TCL_OK) { (void) Tcl_GetStringResult(interp); } +#endif } return result; } @@ -6364,9 +6383,11 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ +#if 0 if (result != TCL_OK) { (void) Tcl_GetStringResult(interp); } +#endif } return result; } @@ -6392,6 +6413,7 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); +#if 0 if (result != TCL_OK) { /* * Move the interpreter's object result to the string result, then @@ -6400,6 +6422,7 @@ Tcl_ExprBoolean( (void) Tcl_GetStringResult(interp); } +#endif return result; } } @@ -6724,12 +6747,13 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - +#if 0 /* * Force the string rep of the interp result. */ (void) Tcl_GetStringResult(interp); +#endif return code; } @@ -6833,6 +6857,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { +#if 0 if (iPtr->result[0] != 0) { /* * The interp's string result is set, apparently by some extension @@ -6844,8 +6869,11 @@ Tcl_AddObjErrorInfo( iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); } else { +#endif iPtr->errorInfo = iPtr->objResultPtr; +#if 0 } +#endif Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -6923,7 +6951,7 @@ Tcl_VarEvalVA( * * Results: * A standard Tcl return result. An error message or other result may be - * left in interp->result. + * left in the interp. * * Side effects: * Depends on what was done by the command. diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b10d423..5448365 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -74,12 +74,14 @@ Tcl_RecordAndEval( Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); +#if 0 /* * Move the interpreter's object result to the string result, then * reset the object result. */ (void) Tcl_GetStringResult(interp); +#endif /* * Discard the Tcl object created to hold the command. diff --git a/generic/tclInt.h b/generic/tclInt.h index 08b3f70..0d541a8 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1811,6 +1811,7 @@ typedef struct Interp { * Tcl_GetStringResult. See the SetResult man page for details. */ +#if 0 char *result; /* If the last command returned a string * result, this points to it. Should not be * accessed directly; see comment above. */ @@ -1821,6 +1822,10 @@ typedef struct Interp { * address of procedure to invoke to free the * string result. Tcl_Eval must free it before * executing next command. */ +#else + char *unused3; + Tcl_FreeProc *unused4; +#endif int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ @@ -1878,6 +1883,7 @@ typedef struct Interp { * See Tcl_AppendResult code for details. */ +#if 0 char *appendResult; /* Storage space for results generated by * Tcl_AppendResult. Ckalloc-ed. NULL means * not yet allocated. */ @@ -1885,6 +1891,11 @@ typedef struct Interp { * partialResult. */ int appendUsed; /* Number of non-null bytes currently stored * at partialResult. */ +#else + char *unused5; + int unused6; + int unused7; +#endif /* * Information about packages. Used only in tclPkg.c. @@ -1946,8 +1957,12 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ +#if 0 char resultSpace[TCL_RESULT_SIZE+1]; /* Static space holding small results. */ +#else + char unused8[TCL_RESULT_SIZE+1]; +#endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ diff --git a/generic/tclResult.c b/generic/tclResult.c index 4443cc1..cbaefcb 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,7 +27,9 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); +#if 0 static void SetupAppendBuffer(Interp *iPtr, int newSpace); +#endif /* * This structure is used to take a snapshot of the interpreter state in @@ -247,6 +249,7 @@ Tcl_SaveResult( iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); +#if 0 /* * Save the string result. */ @@ -284,6 +287,7 @@ Tcl_SaveResult( iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; iPtr->freeProc = 0; +#endif } /* @@ -313,6 +317,7 @@ Tcl_RestoreResult( Tcl_ResetResult(interp); +#if 0 /* * Restore the string result. */ @@ -345,6 +350,7 @@ Tcl_RestoreResult( iPtr->result = statePtr->result; } +#endif /* * Restore the object result. @@ -378,6 +384,7 @@ Tcl_DiscardResult( { TclDecrRefCount(statePtr->objResultPtr); +#if 0 if (statePtr->result == statePtr->appendResult) { ckfree(statePtr->appendResult); } else if (statePtr->freeProc) { @@ -387,6 +394,7 @@ Tcl_DiscardResult( statePtr->freeProc(statePtr->result); } } +#endif } /* @@ -416,6 +424,7 @@ Tcl_SetResult( * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { +#if 0 Interp *iPtr = (Interp *) interp; register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; @@ -459,6 +468,17 @@ Tcl_SetResult( */ ResetObjResult(iPtr); +#else + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); + if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { + return; + } + if (freeProc == TCL_DYNAMIC) { + ckfree(result); + } else { + (*freeProc)(result); + } +#endif } /* @@ -482,6 +502,7 @@ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { +#if 0 /* * If the string result is empty, move the object result to the string * result, then reset the object result. @@ -494,6 +515,10 @@ Tcl_GetStringResult( TCL_VOLATILE); } return iPtr->result; +#else + Interp *iPtr = (Interp *)interp; + return Tcl_GetString(iPtr->objResultPtr); +#endif } /* @@ -535,6 +560,7 @@ Tcl_SetObjResult( TclDecrRefCount(oldObjResult); +#if 0 /* * Reset the string result since we just set the result object. */ @@ -549,6 +575,7 @@ Tcl_SetObjResult( } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; +#endif } /* @@ -577,6 +604,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; +#if 0 Tcl_Obj *objResultPtr; int length; @@ -603,6 +631,7 @@ Tcl_GetObjResult( iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; } +#endif return iPtr->objResultPtr; } @@ -721,6 +750,7 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; +#if 0 char *dst; int size; int flags; @@ -764,7 +794,24 @@ Tcl_AppendElement( flags |= TCL_DONT_QUOTE_HASH; } iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); +#else + Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); + Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); + int length; + const char *bytes; + + if (Tcl_IsShared(iPtr->objResultPtr)) { + Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); + } + bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length); + if (TclNeedSpace(bytes, bytes+length)) { + Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); + } + Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); + Tcl_DecrRefCount(listPtr); +#endif } +#if 0 /* *---------------------------------------------------------------------- @@ -845,6 +892,7 @@ SetupAppendBuffer( Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; } +#endif /* *---------------------------------------------------------------------- @@ -874,6 +922,7 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; +#if 0 if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); @@ -882,6 +931,7 @@ Tcl_FreeResult( } iPtr->freeProc = 0; } +#endif ResetObjResult(iPtr); } @@ -912,6 +962,7 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); +#if 0 if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); @@ -922,6 +973,7 @@ Tcl_ResetResult( } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; +#endif if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index f569820..71933a0 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -41,10 +41,16 @@ HasStubSupport( if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } - +#if 0 iPtr->result = (char *)"This interpreter does not support stubs-enabled extensions."; iPtr->freeProc = TCL_STATIC; +#else + Tcl_Obj errorMsg = {2, + "This interpreter does not support stubs-enabled extensions.", + 59, NULL, {0}}; + iPtr->objResultPtr = &errorMsg; +#endif return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 37ec751..1a189c7 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -120,12 +120,14 @@ typedef struct TclEncoding { char *fromUtfCmd; } TclEncoding; +#if 0 /* * The counter below is used to determine if the TestsaveresultFree routine * was called for a result. */ static int freeCount; +#endif /* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. @@ -5063,7 +5065,9 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { +#if 0 Interp* iPtr = (Interp*) interp; +#endif int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5114,7 +5118,9 @@ TestsaveresultCmd( break; } +#if 0 freeCount = 0; +#endif Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { @@ -5132,11 +5138,16 @@ TestsaveresultCmd( switch ((enum options) index) { case RESULT_DYNAMIC: { +#if 0 int present = iPtr->freeProc == TestsaveresultFree; int called = freeCount; Tcl_AppendElement(interp, called ? "called" : "notCalled"); Tcl_AppendElement(interp, present ? "present" : "missing"); +#else + Tcl_AppendElement(interp, discard ? "called" : "notCalled"); + Tcl_AppendElement(interp, !discard ? "present" : "missing"); +#endif break; } case RESULT_OBJECT: @@ -5169,7 +5180,9 @@ static void TestsaveresultFree( char *blockPtr) { +#if 0 freeCount++; +#endif } /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index a1c1996..32b1bfe 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2626,6 +2626,7 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { +#if 0 Interp *iPtr = (Interp *) interp; Tcl_ResetResult(interp); @@ -2637,8 +2638,11 @@ Tcl_DStringResult( iPtr->result = iPtr->resultSpace; memcpy(iPtr->result, dsPtr->string, dsPtr->length + 1); } else { +#endif Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE); +#if 0 } +#endif dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; @@ -2672,6 +2676,7 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { +#if 0 Interp *iPtr = (Interp *) interp; if (dsPtr->string != dsPtr->staticSpace) { @@ -2710,6 +2715,14 @@ Tcl_DStringGetResult( iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; +#else + int length; + char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); + + Tcl_DStringFree(dsPtr); + Tcl_DStringAppend(dsPtr, bytes, length); + Tcl_ResetResult(interp); +#endif } /* -- cgit v0.12 From ac3d0b69d31e29cb0c279560444cd995a032d2b7 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 19 Apr 2012 12:41:06 +0000 Subject: Clean version of changes; ifdef-free --- generic/tcl.h | 32 +---- generic/tclBasic.c | 105 +-------------- generic/tclHistory.c | 9 -- generic/tclInt.h | 43 +------ generic/tclResult.c | 358 +-------------------------------------------------- generic/tclStubLib.c | 14 +- generic/tclTest.c | 30 +---- generic/tclUtil.c | 59 +-------- 8 files changed, 22 insertions(+), 628 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 46266d2..a7d3917 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -499,37 +499,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ -#if 0 -typedef struct Tcl_Interp { - /* TIP #330: Strongly discourage extensions from using the string - * result. */ -#ifdef USE_INTERP_RESULT - char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); - /* If the last command returned a string - * result, this points to it. */ - void (*freeProc) (char *blockPtr) - TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); - /* Zero means the string result is statically - * allocated. TCL_DYNAMIC means it was - * allocated with ckalloc and should be freed - * with ckfree. Other values give the address - * of function to invoke to free the result. - * Tcl_Eval must free it before executing next - * command. */ -#else - char *unused3 TCL_DEPRECATED_API("bad field access"); - void (*unused4) (char *) TCL_DEPRECATED_API("bad field access"); -#endif -#ifdef USE_INTERP_ERRORLINE - int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine"); - /* When TCL_ERROR is returned, this gives the - * line number within the command where the - * error occurred (1 if first line). */ -#else - int unused5 TCL_DEPRECATED_API("bad field access"); -#endif -} Tcl_Interp; -#endif + typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d55faeb..a66b8b2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -503,10 +503,6 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; -#if 0 - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = NULL; -#endif iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); @@ -562,12 +558,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; -#if 0 - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; -#endif - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -595,9 +585,6 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); -#if 0 - iPtr->resultSpace[0] = 0; -#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -1499,9 +1486,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); -#if 0 - iPtr->result = NULL; -#endif Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1523,12 +1507,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } -#if 0 - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } -#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2435,15 +2413,6 @@ TclInvokeObjectCommand( cmdPtr->objClientData, argc, objv); } -#if 0 - /* - * Move the interpreter's object result to the string result, then reset - * the object result. - */ - - (void) Tcl_GetStringResult(interp); -#endif - /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. @@ -4345,26 +4314,9 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { -/* Interp *iPtr = (Interp *) interp;*/ NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; -#if 0 - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - * - * This only needs to be done for the first item in the list: all other - * are for NR function calls, and those are Tcl_Obj based. - */ - - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } -#endif - while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; @@ -5842,18 +5794,6 @@ Tcl_Eval( * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { -#if 0 - int code = Tcl_EvalEx(interp, script, -1, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; -#endif return Tcl_EvalEx(interp, script, -1, 0); } @@ -6352,11 +6292,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); -#if 0 - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } -#endif } return result; } @@ -6383,11 +6318,6 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ -#if 0 - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } -#endif } return result; } @@ -6413,16 +6343,6 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); -#if 0 - if (result != TCL_OK) { - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } -#endif return result; } } @@ -6747,13 +6667,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } -#if 0 - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); -#endif return code; } @@ -6857,23 +6770,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { -#if 0 - if (iPtr->result[0] != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * expect interp->result to continue to be set, so we'll take - * special pains to avoid clearing it, until we drop support for - * interp->result completely. - */ - - iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); - } else { -#endif - iPtr->errorInfo = iPtr->objResultPtr; -#if 0 - } -#endif + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 5448365..c44ba4c 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -74,15 +74,6 @@ Tcl_RecordAndEval( Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); -#if 0 - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); -#endif - /* * Discard the Tcl object created to hold the command. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 0d541a8..fa7c03c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1800,32 +1800,16 @@ typedef struct Interp { * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the * other. * - * The interpreter's result is held in both the string and the - * objResultPtr fields. These fields hold, respectively, the result's - * string or object value. The interpreter's result is always in the - * result field if that is non-empty, otherwise it is in objResultPtr. - * The two fields are kept consistent unless some C code sets - * interp->result directly. Programs should not access result and - * objResultPtr directly; instead, they should always get and set the - * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and - * Tcl_GetStringResult. See the SetResult man page for details. + * The interpreter's result is held in the objResultPtr field. This field + * holds the result's object value. The interpreter's result is always in + * objResultPtr. Programs should not access objResultPtr directly; + * instead, they should always get and set the result using procedures + * such as Tcl_SetObjResult, Tcl_GetObjResult, and Tcl_GetStringResult. + * See the SetResult man page for details. */ -#if 0 - char *result; /* If the last command returned a string - * result, this points to it. Should not be - * accessed directly; see comment above. */ - Tcl_FreeProc *freeProc; /* Zero means a string result is statically - * allocated. TCL_DYNAMIC means string result - * was allocated with ckalloc and should be - * freed with ckfree. Other values give - * address of procedure to invoke to free the - * string result. Tcl_Eval must free it before - * executing next command. */ -#else char *unused3; Tcl_FreeProc *unused4; -#endif int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ @@ -1883,19 +1867,9 @@ typedef struct Interp { * See Tcl_AppendResult code for details. */ -#if 0 - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ -#else char *unused5; int unused6; int unused7; -#endif /* * Information about packages. Used only in tclPkg.c. @@ -1957,12 +1931,7 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ -#if 0 - char resultSpace[TCL_RESULT_SIZE+1]; - /* Static space holding small results. */ -#else char unused8[TCL_RESULT_SIZE+1]; -#endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ diff --git a/generic/tclResult.c b/generic/tclResult.c index cbaefcb..693c650 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,9 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -#if 0 -static void SetupAppendBuffer(Interp *iPtr, int newSpace); -#endif /* * This structure is used to take a snapshot of the interpreter state in @@ -248,46 +245,6 @@ Tcl_SaveResult( statePtr->objResultPtr = iPtr->objResultPtr; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); - -#if 0 - /* - * Save the string result. - */ - - statePtr->freeProc = iPtr->freeProc; - if (iPtr->result == iPtr->resultSpace) { - /* - * Copy the static string data out of the interp buffer. - */ - - statePtr->result = statePtr->resultSpace; - strcpy(statePtr->result, iPtr->result); - statePtr->appendResult = NULL; - } else if (iPtr->result == iPtr->appendResult) { - /* - * Move the append buffer out of the interp. - */ - - statePtr->appendResult = iPtr->appendResult; - statePtr->appendAvl = iPtr->appendAvl; - statePtr->appendUsed = iPtr->appendUsed; - statePtr->result = statePtr->appendResult; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - } else { - /* - * Move the dynamic or static string out of the interpreter. - */ - - statePtr->result = iPtr->result; - statePtr->appendResult = NULL; - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - iPtr->freeProc = 0; -#endif } /* @@ -317,41 +274,6 @@ Tcl_RestoreResult( Tcl_ResetResult(interp); -#if 0 - /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } -#endif - /* * Restore the object result. */ @@ -383,18 +305,6 @@ Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { TclDecrRefCount(statePtr->objResultPtr); - -#if 0 - if (statePtr->result == statePtr->appendResult) { - ckfree(statePtr->appendResult); - } else if (statePtr->freeProc) { - if (statePtr->freeProc == TCL_DYNAMIC) { - ckfree(statePtr->result); - } else { - statePtr->freeProc(statePtr->result); - } - } -#endif } /* @@ -424,51 +334,6 @@ Tcl_SetResult( * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { -#if 0 - Interp *iPtr = (Interp *) interp; - register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; - char *oldResult = iPtr->result; - - if (result == NULL) { - iPtr->resultSpace[0] = 0; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } else if (freeProc == TCL_VOLATILE) { - int length = strlen(result); - - if (length > TCL_RESULT_SIZE) { - iPtr->result = ckalloc(length + 1); - iPtr->freeProc = TCL_DYNAMIC; - } else { - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } - memcpy(iPtr->result, result, (unsigned) length+1); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; - } - - /* - * If the old result was dynamically-allocated, free it up. Do it here, - * rather than at the beginning, in case the new result value was part of - * the old result value. - */ - - if (oldFreeProc != 0) { - if (oldFreeProc == TCL_DYNAMIC) { - ckfree(oldResult); - } else { - oldFreeProc(oldResult); - } - } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); -#else Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { return; @@ -478,7 +343,6 @@ Tcl_SetResult( } else { (*freeProc)(result); } -#endif } /* @@ -502,23 +366,9 @@ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { -#if 0 - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - Interp *iPtr = (Interp *) interp; - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; -#else - Interp *iPtr = (Interp *)interp; return Tcl_GetString(iPtr->objResultPtr); -#endif } /* @@ -559,23 +409,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - -#if 0 - /* - * Reset the string result since we just set the result object. - */ - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif } /* @@ -604,34 +437,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; -#if 0 - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - if (*(iPtr->result) != 0) { - ResetObjResult(iPtr); - - objResultPtr = iPtr->objResultPtr; - length = strlen(iPtr->result); - TclInitStringRep(objResultPtr, iPtr->result, length); - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - } -#endif return iPtr->objResultPtr; } @@ -750,51 +556,6 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; -#if 0 - char *dst; - int size; - int flags; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* - * See how much space is needed, and grow the append buffer if needed to - * accommodate the list element. - */ - - size = Tcl_ScanElement(element, &flags) + 1; - if ((iPtr->result != iPtr->appendResult) - || (iPtr->appendResult[iPtr->appendUsed] != 0) - || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { - SetupAppendBuffer(iPtr, size+iPtr->appendUsed); - } - - /* - * Convert the string into a list element and copy it to the buffer that's - * forming, with a space separator if needed. - */ - - dst = iPtr->appendResult + iPtr->appendUsed; - if (TclNeedSpace(iPtr->appendResult, dst)) { - iPtr->appendUsed++; - *dst = ' '; - dst++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; - } - iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); -#else Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); int length; @@ -809,90 +570,7 @@ Tcl_AppendElement( } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); -#endif -} -#if 0 - -/* - *---------------------------------------------------------------------- - * - * SetupAppendBuffer -- - * - * This function makes sure that there is an append buffer properly - * initialized, if necessary, from the interpreter's result, and that it - * has at least enough room to accommodate newSpace new bytes of - * information. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static void -SetupAppendBuffer( - Interp *iPtr, /* Interpreter whose result is being set up. */ - int newSpace) /* Make sure that at least this many bytes of - * new information may be added. */ -{ - int totalSpace; - - /* - * Make the append buffer larger, if that's necessary, then copy the - * result into the append buffer and make the append buffer the official - * Tcl result. - */ - - if (iPtr->result != iPtr->appendResult) { - /* - * If an oversized buffer was used recently, then free it up so we go - * back to a smaller buffer. This avoids tying up memory forever after - * a large operation. - */ - - if (iPtr->appendAvl > 500) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - } - iPtr->appendUsed = strlen(iPtr->result); - } else if (iPtr->result[iPtr->appendUsed] != 0) { - /* - * Most likely someone has modified a result created by - * Tcl_AppendResult et al. so that it has a different size. Just - * recompute the size. - */ - - iPtr->appendUsed = strlen(iPtr->result); - } - - totalSpace = newSpace + iPtr->appendUsed; - if (totalSpace >= iPtr->appendAvl) { - char *new; - - if (totalSpace < 100) { - totalSpace = 200; - } else { - totalSpace *= 2; - } - new = ckalloc(totalSpace); - strcpy(new, iPtr->result); - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - iPtr->appendResult = new; - iPtr->appendAvl = totalSpace; - } else if (iPtr->result != iPtr->appendResult) { - strcpy(iPtr->appendResult, iPtr->result); - } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; } -#endif /* *---------------------------------------------------------------------- @@ -900,18 +578,17 @@ SetupAppendBuffer( * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. + * result, resetting the interpreter's result object. Tcl_FreeResult is + * most commonly used when a function is about to replace one result + * value with another. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. + * Frees the memory associated with interp's result but does not change + * any part of the error dictionary (i.e., the errorinfo and errorcode + * remain the same). * *---------------------------------------------------------------------- */ @@ -922,17 +599,6 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; -#if 0 - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } -#endif - ResetObjResult(iPtr); } @@ -962,18 +628,6 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); -#if 0 - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 71933a0..b36627c 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -37,20 +37,16 @@ HasStubSupport( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; + static Tcl_Obj errorMsg = { + 2, /* Stop anything from trying to deallocate this memory! */ + "This interpreter does not support stubs-enabled extensions.", + 59, NULL, {0} + }; if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } -#if 0 - iPtr->result = - (char *)"This interpreter does not support stubs-enabled extensions."; - iPtr->freeProc = TCL_STATIC; -#else - Tcl_Obj errorMsg = {2, - "This interpreter does not support stubs-enabled extensions.", - 59, NULL, {0}}; iPtr->objResultPtr = &errorMsg; -#endif return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 1a189c7..b407f51 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -120,15 +120,6 @@ typedef struct TclEncoding { char *fromUtfCmd; } TclEncoding; -#if 0 -/* - * The counter below is used to determine if the TestsaveresultFree routine - * was called for a result. - */ - -static int freeCount; -#endif - /* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ @@ -5065,9 +5056,6 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { -#if 0 - Interp* iPtr = (Interp*) interp; -#endif int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5118,9 +5106,6 @@ TestsaveresultCmd( break; } -#if 0 - freeCount = 0; -#endif Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { @@ -5137,19 +5122,10 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { -#if 0 - int present = iPtr->freeProc == TestsaveresultFree; - int called = freeCount; - - Tcl_AppendElement(interp, called ? "called" : "notCalled"); - Tcl_AppendElement(interp, present ? "present" : "missing"); -#else + case RESULT_DYNAMIC: Tcl_AppendElement(interp, discard ? "called" : "notCalled"); Tcl_AppendElement(interp, !discard ? "present" : "missing"); -#endif break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); @@ -5180,9 +5156,7 @@ static void TestsaveresultFree( char *blockPtr) { -#if 0 - freeCount++; -#endif + /* empty... */ } /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 32b1bfe..f316dfb 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2626,23 +2626,7 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { -#if 0 - Interp *iPtr = (Interp *) interp; - - Tcl_ResetResult(interp); - - if (dsPtr->string != dsPtr->staticSpace) { - iPtr->result = dsPtr->string; - iPtr->freeProc = TCL_DYNAMIC; - } else if (dsPtr->length < TCL_RESULT_SIZE) { - iPtr->result = iPtr->resultSpace; - memcpy(iPtr->result, dsPtr->string, dsPtr->length + 1); - } else { -#endif - Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE); -#if 0 - } -#endif + Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE); dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; @@ -2676,53 +2660,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { -#if 0 - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#else int length; char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); Tcl_DStringFree(dsPtr); Tcl_DStringAppend(dsPtr, bytes, length); Tcl_ResetResult(interp); -#endif } /* -- cgit v0.12 From 68191ded75fa06a222a1c4b936d7d12f7f8d69eb Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 19 Apr 2012 12:57:45 +0000 Subject: To preserve the ability of [load] to bring in mistmatched stubs-enabled modules and react with an error rather than a crash, HasStubSupport() has to keep fiddling with the same fields as always. --- generic/tclStubLib.c | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index b36627c..9e9208d 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -37,16 +37,13 @@ HasStubSupport( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; - static Tcl_Obj errorMsg = { - 2, /* Stop anything from trying to deallocate this memory! */ - "This interpreter does not support stubs-enabled extensions.", - 59, NULL, {0} - }; if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } - iPtr->objResultPtr = &errorMsg; + iPtr->unused3 + = "This interpreter does not support stubs-enabled extensions."; + iPtr->unused4 = TCL_STATIC; return NULL; } -- cgit v0.12 From 1e58e8e42d522df38ef3a2299524fe31e204fa88 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 Apr 2012 21:03:58 +0000 Subject: Implement Tcl_DStringResult with call to TclDStringToObj. --- generic/tclUtil.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 8852a56..1e35165 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2626,12 +2626,7 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { - Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE); - - dsPtr->string = dsPtr->staticSpace; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - dsPtr->staticSpace[0] = '\0'; + Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); } /* -- cgit v0.12 From 0d4a963517b406df24acb3713a130366b1ce52a1 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 7 Jul 2012 12:34:39 +0000 Subject: Starting work on support code for cookies. This adds a configurable interface for plugging in a cookie manager (not enabled by default). --- library/http/http.tcl | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++ tests/http.test | 6 ++-- 2 files changed, 96 insertions(+), 3 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index b5ce82b..7b80524 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -24,6 +24,7 @@ namespace eval http { -proxyport {} -proxyfilter http::ProxyRequired -urlencoding utf-8 + -cookiejar {} } # We need a useragent string of this style or various servers will refuse to # send us compressed content even when we ask for it. This follows the @@ -86,6 +87,9 @@ namespace eval http { set defaultKeepalive 0 } + # Regular expression used to parse cookies + variable CookieRE {\s*([^][\u0000- ()<>@,;:\\""/?={}\u0100-\uffff]+)=([!\u0023-+\u002D-:<-\u005B\u005D-~]+)(?:\s*;\s*([^\u0000]+))?} + namespace export geturl config reset wait formatQuery register unregister # Useful, but not exported: data size status code } @@ -498,8 +502,12 @@ proc http::geturl {url args} { } return -code error "Illegal characters in URL path" } + if {![regexp {^[^?#]+} $srvurl state(path)]} { + set state(path) / + } } else { set srvurl / + set state(path) / } if {$proto eq ""} { set proto http @@ -719,6 +727,19 @@ proc http::geturl {url args} { seek $state(-querychannel) $start } + if {$http(-cookiejar) ne ""} { + set cookies "" + set separator "" + foreach {key value} [{*}$http(-cookiejar) \ + getCookies $proto $host $port $state(path)] { + append cookies $separator $key = $value + set separator "; " + } + if {$cookies ne ""} { + puts $sock "Cookie: $cookies" + } + } + # Flush the request header and set up the fileevent that will either # push the POST data or read the response. # @@ -955,6 +976,7 @@ proc http::Write {token} { # Read the socket and handle callbacks. proc http::Event {sock token} { + variable http variable $token upvar 0 $token state @@ -1058,6 +1080,11 @@ proc http::Event {sock token} { set state(connection) \ [string trim [string tolower $value]] } + set-cookie { + if {$http(-cookiejar) ne ""} { + ParseCookie $token $value + } + } } lappend state(meta) $key [string trim $value] } @@ -1147,6 +1174,72 @@ proc http::Event {sock token} { } } +proc http::ParseCookie {token value} { + variable http + variable CookieRE + variable $token + upvar 0 $token state + + if {![regexp $CookieRE $value -> name val opts]} { + # Bad cookie! No biscuit! + return + } + + # Convert the options into a list before feeding into the cookie store; + # ugly, but quite easy. + set realopts {persistent 0 hostonly 1} + foreach opt [split [regsub -all {;\s+} [string trimright $opts] {\u0000}] \u0000] { + switch -glob -- $opt { + Expires=* { + set opt [string range $opt 8 end] + if {[catch { + #Sun, 06 Nov 1994 08:49:37 GMT + dict set realopts expires \ + [clock scan $opt -format "%a, %d %b %Y %T %Z"] + dict set realopts persistent 1 + }] && [catch { + #Sunday, 06-Nov-94 08:49:37 GMT + dict set realopts expires \ + [clock scan $opt -format "%A, %d-%b-%y %T %Z"] + dict set realopts persistent 1 + }]} {catch { + #Sun Nov 6 08:49:37 1994 + dict set realopts expires \ + [clock scan $opt -gmt 1 -format "%a %b %d %T %Y"] + dict set realopts persistent 1 + }} + } + Max-Age=* { + # Normalize + set opt [string range $opt 8 end] + if {[string is integer -strict $opt]} { + dict set realopts expires [expr {[clock seconds] + $opt}] + dict set realopts persistent 1 + } + } + Domain=* { + set opt [string range $opt 7 end] + set opt [string trimleft $opt "."] + # TODO - Domain safety check! + if {$opt ne ""} { + dict set realopts domain $opt + } + } + Path=* { + set opt [string range $opt 5 end] + if {![string match /* $opt]} { + set opt $state(path) + } + dict set realopts path $opt + } + Secure - HttpOnly { + dict set realopts [string tolower $opt] 1 + } + } + } + {*}$http(-cookiejar) storeCookie $token $name $val $realopts +} + # http::getTextLine -- # # Get one line with the stream in blocking crlf mode diff --git a/tests/http.test b/tests/http.test index 37d4a05..daddf2c 100644 --- a/tests/http.test +++ b/tests/http.test @@ -79,7 +79,7 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { test http-1.1 {http::config} { http::config -useragent UserAgent http::config -} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"] +} [list -accept */* -cookiejar {} -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"] test http-1.2 {http::config} { http::config -proxyfilter } http::ProxyRequired @@ -94,10 +94,10 @@ test http-1.4 {http::config} { set x [http::config] http::config {*}$savedconf set x -} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} +} {-accept */* -cookiejar {} -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} test http-1.5 {http::config} -returnCodes error -body { http::config -proxyhost {} -junk 8080 -} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent} +} -result {Unknown option -junk, must be: -accept, -cookiejar, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent} test http-1.6 {http::config} -setup { set oldenc [http::config -urlencoding] } -body { -- cgit v0.12 From b9098ee927b24f571428a5bdbd0f73a14c902388 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 8 Jul 2012 11:15:45 +0000 Subject: Make the parsing work with Google. --- library/http/http.tcl | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 7b80524..181c29f 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -88,7 +88,7 @@ namespace eval http { } # Regular expression used to parse cookies - variable CookieRE {\s*([^][\u0000- ()<>@,;:\\""/?={}\u0100-\uffff]+)=([!\u0023-+\u002D-:<-\u005B\u005D-~]+)(?:\s*;\s*([^\u0000]+))?} + variable CookieRE {\s*([^][\u0000- ()<>@,;:\\""/?={}\u0100-\uffff]+)=([!\u0023-+\u002D-:<-\u005B\u005D-~]*)(?:\s*;\s*([^\u0000]+))?} namespace export geturl config reset wait formatQuery register unregister # Useful, but not exported: data size status code @@ -1082,7 +1082,7 @@ proc http::Event {sock token} { } set-cookie { if {$http(-cookiejar) ne ""} { - ParseCookie $token $value + ParseCookie $token [string trim $value] } } } @@ -1180,7 +1180,7 @@ proc http::ParseCookie {token value} { variable $token upvar 0 $token state - if {![regexp $CookieRE $value -> name val opts]} { + if {![regexp $CookieRE $value -> cookiename cookieval opts]} { # Bad cookie! No biscuit! return } @@ -1188,8 +1188,8 @@ proc http::ParseCookie {token value} { # Convert the options into a list before feeding into the cookie store; # ugly, but quite easy. set realopts {persistent 0 hostonly 1} - foreach opt [split [regsub -all {;\s+} [string trimright $opts] {\u0000}] \u0000] { - switch -glob -- $opt { + foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { + switch -glob -nocase -- $opt { Expires=* { set opt [string range $opt 8 end] if {[catch { @@ -1198,6 +1198,12 @@ proc http::ParseCookie {token value} { [clock scan $opt -format "%a, %d %b %Y %T %Z"] dict set realopts persistent 1 }] && [catch { + # Google does this one + #Mon, 01-Jan-1990 00:00:00 GMT + dict set realopts expires \ + [clock scan $opt -format "%a, %d-%b-%Y %T %Z"] + dict set realopts persistent 1 + }] && [catch { #Sunday, 06-Nov-94 08:49:37 GMT dict set realopts expires \ [clock scan $opt -format "%A, %d-%b-%y %T %Z"] @@ -1237,7 +1243,7 @@ proc http::ParseCookie {token value} { } } } - {*}$http(-cookiejar) storeCookie $token $name $val $realopts + {*}$http(-cookiejar) storeCookie $token $cookiename $cookieval $realopts } # http::getTextLine -- -- cgit v0.12 From 06cfc731c6abebb8f7d67a737dffb55561298d8e Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 11 Jul 2012 10:52:49 +0000 Subject: Start of implementation of cookiejar package. Not yet working/finished. --- library/http/cookiejar.tcl | 104 +++++++++++++++++++++++++++++++++++++++++++++ library/http/http.tcl | 10 +++-- 2 files changed, 110 insertions(+), 4 deletions(-) create mode 100644 library/http/cookiejar.tcl diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl new file mode 100644 index 0000000..eb3b67b --- /dev/null +++ b/library/http/cookiejar.tcl @@ -0,0 +1,104 @@ +package require Tcl 8.6 +package require sqlite3 +package provide cookiejar 0.1 + +::oo::class create cookiejar { + variable aid + constructor {{path ""}} { + if {$path eq ""} { + sqlite3 [namespace current]::db :memory: + } else { + sqlite3 [namespace current]::db $path + } + ## FIXME + db eval { + CREATE TABLE IF NOT EXISTS cookies ( + TEXT origin NOT NULL, + TEXT domain, + TEXT key NOT NULL, + TEXT value NOT NULL, + INTEGER expiry NOT NULL) + PRIMARY KEY (origin, key) + } + db eval { + CREATE TEMP TABLE IF NOT EXISTS sessionCookies ( + TEXT origin NOT NULL, + TEXT domain, + TEXT key NOT NULL, + TEXT value NOT NULL) + PRIMARY KEY (origin, key) + } + + set aid [after 60000 [namespace current]::my PurgeCookies] + } + + destructor { + after cancel $aid + db close + } + + method getCookies {proto host port path} { + upvar 1 state state + set result {} + ## TODO: How to handle prefix matches? + db eval { + SELECT key, value FROM cookies WHERE domain = :host + } cookie { + dict set result $key $value + } + db eval { + SELECT key, value FROM sessionCookies WHERE domain = :host + } cookie { + dict set result $key $value + } + db eval { + SELECT key, value FROM cookies WHERE origin = :host + } cookie { + dict set result $key $value + } + db eval { + SELECT key, value FROM sessionCookies WHERE origin = :host + } cookie { + dict set result $key $value + } + return $result + } + + method storeCookie {name val options} { + upvar 1 state state + set now [clock seconds] + dict with options {} + if {!$persistent} { + ### FIXME + db eval { + INSERT OR REPLACE sessionCookies ( + origin, domain, key, value + ) VALUES (:origin, :domain, :key, :value) + } + } elseif {$expires < $now} { + db eval { + DELETE FROM cookies + WHERE domain = :domain AND key = :name + } + db eval { + DELETE FROM sessionCookies + WHERE domain = :domain AND key = :name + } + } else { + ### FIXME + db eval { + INSERT OR REPLACE cookies ( + origin, domain, key, value, expiry + ) VALUES (:origin, :domain, :key, :value, :expiry) + } + } + } + + method PurgeCookies {} { + set aid [after 60000 [namespace current]::my PurgeCookies] + set now [clock seconds] + db eval {DELETE FROM cookies WHERE expiry < :now} + } + + forward Database db +} diff --git a/library/http/http.tcl b/library/http/http.tcl index afc3a0f..4fa39a4 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -673,8 +673,10 @@ proc http::geturl {url args} { puts $sock "$how $srvurl HTTP/$state(-protocol)" puts $sock "Accept: $http(-accept)" array set hdrs $state(-headers) + set state(host) $host if {[info exists hdrs(Host)]} { # Allow Host spoofing. [Bug 928154] + regexp {^[^:]+} $hdrs(Host) state(host) puts $sock "Host: $hdrs(Host)" } elseif {$port == $defport} { # Don't add port in this case, to handle broken servers. [Bug @@ -1191,6 +1193,7 @@ proc http::ParseCookie {token value} { # Convert the options into a list before feeding into the cookie store; # ugly, but quite easy. set realopts {persistent 0 hostonly 1} + dict set realopts origin $state(host) foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { switch -glob -nocase -- $opt { Expires=* { @@ -1227,10 +1230,9 @@ proc http::ParseCookie {token value} { } } Domain=* { - set opt [string range $opt 7 end] - set opt [string trimleft $opt "."] + set opt [string trimleft [string range $opt 7 end] "."] # TODO - Domain safety check! - if {$opt ne ""} { + if {$opt ne "" && ![string match *. $opt]} { dict set realopts domain $opt } } @@ -1246,7 +1248,7 @@ proc http::ParseCookie {token value} { } } } - {*}$http(-cookiejar) storeCookie $token $cookiename $cookieval $realopts + {*}$http(-cookiejar) storeCookie $cookiename $cookieval $realopts } # http::getTextLine -- -- cgit v0.12 From db9c41f45c92a3e57a36432431702960a76360d5 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 19 Jul 2012 16:28:50 +0000 Subject: First attempt at a "bad cookie domain" detector, a critical security check. --- library/http/cookiejar.tcl | 182 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 148 insertions(+), 34 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index eb3b67b..681c923 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -2,7 +2,13 @@ package require Tcl 8.6 package require sqlite3 package provide cookiejar 0.1 -::oo::class create cookiejar { +namespace eval ::http { + # TODO is this the _right_ list of domains to use? + variable CookiejarDomainList \ + http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 +} + +::oo::class create ::http::cookiejar { variable aid constructor {{path ""}} { if {$path eq ""} { @@ -11,25 +17,105 @@ package provide cookiejar 0.1 sqlite3 [namespace current]::db $path } ## FIXME + ## Model from Safari: + # * Creation instant + # * Domain + # * Expiration instant + # * Name + # * Path + # * Value + ## Model from Firefox: + # CREATE TABLE moz_cookies ( + # id INTEGER PRIMARY KEY, + # name TEXT, + # value TEXT, + # host TEXT, + # path TEXT, + # expiry INTEGER, + # lastAccessed INTEGER, + # isSecure INTEGER, + # isHttpOnly INTEGER, + # baseDomain TEXT, + # creationTime INTEGER) + # CREATE INDEX moz_basedomain ON moz_cookies (baseDomain) + # CREATE UNIQUE INDEX moz_uniqueid ON moz_cookies (name, host, path) db eval { CREATE TABLE IF NOT EXISTS cookies ( - TEXT origin NOT NULL, - TEXT domain, - TEXT key NOT NULL, - TEXT value NOT NULL, - INTEGER expiry NOT NULL) - PRIMARY KEY (origin, key) + id INTEGER PRIMARY KEY, + origin TEXT NOT NULL, + path TEXT NOT NULL, + domain TEXT, + key TEXT NOT NULL, + value TEXT NOT NULL, + expiry INTEGER NOT NULL); + CREATE UNIQUE INDEX IF NOT EXISTS cookieUnique + ON cookies (origin, path, key) } db eval { CREATE TEMP TABLE IF NOT EXISTS sessionCookies ( - TEXT origin NOT NULL, - TEXT domain, - TEXT key NOT NULL, - TEXT value NOT NULL) - PRIMARY KEY (origin, key) + origin TEXT NOT NULL, + path TEXT NOT NULL, + domain TEXT, + key TEXT NOT NULL, + value TEXT NOT NULL); + CREATE UNIQUE INDEX IF NOT EXISTS sessionUnique + ON sessionCookies (origin, path, key) } set aid [after 60000 [namespace current]::my PurgeCookies] + + if {$path ne ""} { + db transaction { + if {[catch { + db eval {SELECT * FROM forbidden LIMIT 1} + }]} { + my InitDomainList + } + } + } + } + + method InitDomainList {} { + db eval { + CREATE TABLE IF NOT EXISTS forbidden ( + domain TEXT PRIMARY KEY); + CREATE TABLE IF NOT EXISTS forbiddenSuper ( + domain TEXT PRIMARY KEY); + CREATE TABLE IF NOT EXISTS permitted ( + domain TEXT PRIMARY KEY); + } + set tok [http::geturl $::http::CookiejarDomainList] + try { + if {[http::ncode $tok] == 200} { + foreach line [split [http::data $tok] \n] { + if {[string trim $line] eq ""} continue + if {[string match //* $line]} continue + if {[string match !* $line]} { + set line [string range $line 1 end] + db eval { + INSERT INTO permitted (domain) + VALUES (:line) + } + } else { + if {[string match {\*.*} $line]} { + set line [string range $line 2 end] + db eval { + INSERT INTO forbiddenSuper (domain) + VALUES (:line) + } + } + db eval { + INSERT INTO forbidden (domain) + VALUES (:line) + } + } + } + } else { + http::Log "Warning: failed to fetch list of forbidden cookie domains" + } + } finally { + http::cleanup $tok + } } destructor { @@ -41,6 +127,8 @@ package provide cookiejar 0.1 upvar 1 state state set result {} ## TODO: How to handle prefix matches? +# From kbk +#LENGTH(theColumn) <= LENGTH(:queryStr) AND SUBSTR(theColumn, LENGTH(:queryStr)-LENGTH(theColumn)+1) = :queryStr db eval { SELECT key, value FROM cookies WHERE domain = :host } cookie { @@ -64,32 +152,56 @@ package provide cookiejar 0.1 return $result } + method BadDomain options { + if {![dict exists $options domain]} { + return 0 + } + set domain [dict get $options domain] + db eval { + SELECT domain FROM permitted WHERE domain == :domain + } x {return 0} + db eval { + SELECT domain FROM forbidden WHERE domain == :domain + } x {return 1} + if {![regexp {^[^.]+\.(.+)$} $domain -> super]} {return 1} + db eval { + SELECT domain FROM forbiddenSuper WHERE domain == :domain + } x {return 1} + return 0 + } + method storeCookie {name val options} { upvar 1 state state set now [clock seconds] - dict with options {} - if {!$persistent} { - ### FIXME - db eval { - INSERT OR REPLACE sessionCookies ( - origin, domain, key, value - ) VALUES (:origin, :domain, :key, :value) - } - } elseif {$expires < $now} { - db eval { - DELETE FROM cookies - WHERE domain = :domain AND key = :name + db transaction { + if {[my BadDomain $options]} { + http::Log "Warning: evil cookie detected" + return } - db eval { - DELETE FROM sessionCookies - WHERE domain = :domain AND key = :name - } - } else { - ### FIXME - db eval { - INSERT OR REPLACE cookies ( - origin, domain, key, value, expiry - ) VALUES (:origin, :domain, :key, :value, :expiry) + dict with options {} + if {!$persistent} { + ### FIXME + db eval { + INSERT OR REPLACE sessionCookies ( + origin, domain, key, value) + VALUES (:origin, :domain, :key, :value) + } + } elseif {$expires < $now} { + db eval { + DELETE FROM cookies + WHERE domain = :domain AND key = :name AND path = :path + } + db eval { + DELETE FROM sessionCookies + WHERE domain = :domain AND key = :name AND path = :path + } + } else { + ### FIXME + db eval { + INSERT OR REPLACE cookies ( + origin, domain, key, value, expiry) + VALUES (:origin, :domain, :key, :value, :expiry) + } } } } @@ -98,6 +210,8 @@ package provide cookiejar 0.1 set aid [after 60000 [namespace current]::my PurgeCookies] set now [clock seconds] db eval {DELETE FROM cookies WHERE expiry < :now} + ### TODO: Cap the total number of cookies and session cookies, + ### purging least frequently used } forward Database db -- cgit v0.12 From 99af655c4c86349d99454dd9c6879ec83e32f1f2 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 31 Jul 2012 10:52:29 +0000 Subject: some small tinkerings --- library/http/cookiejar.tcl | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index be446a1..e6c1e85 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -42,9 +42,9 @@ namespace eval ::http { db eval { CREATE TABLE IF NOT EXISTS cookies ( id INTEGER PRIMARY KEY, - origin TEXT NOT NULL, + origin TEXT NOT NULL COLLATE NOCASE, path TEXT NOT NULL, - domain TEXT, + domain TEXT COLLATE NOCASE, key TEXT NOT NULL, value TEXT NOT NULL, expiry INTEGER NOT NULL); @@ -53,9 +53,9 @@ namespace eval ::http { } db eval { CREATE TEMP TABLE IF NOT EXISTS sessionCookies ( - origin TEXT NOT NULL, + origin TEXT NOT NULL COLLATE NOCASE, path TEXT NOT NULL, - domain TEXT, + domain TEXT COLLATE NOCASE, key TEXT NOT NULL, value TEXT NOT NULL); CREATE UNIQUE INDEX IF NOT EXISTS sessionUnique @@ -66,9 +66,11 @@ namespace eval ::http { if {$path ne ""} { db transaction { - if {[catch { - db eval {SELECT * FROM forbidden LIMIT 1} - }]} { + db eval { + SELECT count(*) AS present FROM sqlite_master + WHERE type='table' AND name='forbidden' + } + if {!$present} { my InitDomainList } } -- cgit v0.12 From 9aa711e8e0c11bcdda23542d82c44a773e07251c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Aug 2012 06:49:25 +0000 Subject: remove unnecessary struct names, which only pollute the "struct" namespace for te compiler. --- generic/regc_locale.c | 2 +- generic/tcl.h | 2 +- generic/tclBasic.c | 2 +- generic/tclBinary.c | 2 +- generic/tclCkalloc.c | 2 +- generic/tclClock.c | 4 ++-- generic/tclCmdIL.c | 2 +- generic/tclCompExpr.c | 2 +- generic/tclCompile.h | 8 ++++---- generic/tclConfig.c | 2 +- generic/tclEncoding.c | 8 ++++---- generic/tclEvent.c | 2 +- generic/tclExecute.c | 2 +- generic/tclIO.c | 2 +- generic/tclIOCmd.c | 4 ++-- generic/tclIORChan.c | 8 ++++---- generic/tclIORTrans.c | 8 ++++---- generic/tclIOUtil.c | 4 ++-- generic/tclInterp.c | 16 ++++++++-------- generic/tclLink.c | 2 +- generic/tclMain.c | 2 +- generic/tclNamesp.c | 4 ++-- generic/tclObj.c | 2 +- generic/tclPathObj.c | 2 +- generic/tclPkg.c | 2 +- generic/tclPreserve.c | 2 +- generic/tclRegexp.c | 2 +- generic/tclResult.c | 2 +- generic/tclScan.c | 2 +- generic/tclStringObj.c | 2 +- generic/tclTest.c | 6 +++--- generic/tclTestObj.c | 2 +- generic/tclTestProcBodyObj.c | 2 +- generic/tclThreadAlloc.c | 2 +- generic/tclThreadStorage.c | 2 +- generic/tclThreadTest.c | 2 +- generic/tclTimer.c | 2 +- generic/tclTrace.c | 2 +- unix/tclUnixChan.c | 4 ++-- unix/tclUnixCompat.c | 2 +- unix/tclUnixInit.c | 8 ++++---- unix/tclUnixNotfy.c | 4 ++-- unix/tclUnixPipe.c | 2 +- unix/tclUnixTest.c | 2 +- unix/tclUnixThrd.c | 8 ++++---- unix/tclUnixTime.c | 2 +- win/tclWinChan.c | 4 ++-- win/tclWinConsole.c | 6 +++--- win/tclWinDde.c | 24 ++++++++++++------------ win/tclWinNotify.c | 2 +- win/tclWinPipe.c | 6 +++--- win/tclWinSerial.c | 4 ++-- win/tclWinSock.c | 4 ++-- win/tclWinThrd.c | 8 ++++---- win/tclWinTime.c | 4 ++-- 55 files changed, 110 insertions(+), 110 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 40791f4..d01888b 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -118,7 +118,7 @@ static const struct cname { * Unicode character-class tables. */ -typedef struct crange { +typedef struct { chr start; chr end; } crange; diff --git a/generic/tcl.h b/generic/tcl.h index 729e521..7a026ed 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -458,7 +458,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ #elif defined(__CYGWIN__) - typedef struct _stat32i64 { + typedef struct { dev_t st_dev; unsigned short st_ino; unsigned short st_mode; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index db365e3..d47d96f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -45,7 +45,7 @@ * registered with Tcl_CreateMathFunc */ -typedef struct OldMathFuncData { +typedef struct { Tcl_MathProc *proc; /* Handler function */ int numArgs; /* Number of args expected */ Tcl_ValueType *argTypes; /* Types of the args */ diff --git a/generic/tclBinary.c b/generic/tclBinary.c index a1e836e..5e1114d 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -167,7 +167,7 @@ const Tcl_ObjType tclByteArrayType = { * fewer mallocs. */ -typedef struct ByteArray { +typedef struct { int used; /* The number of bytes used in the byte * array. */ int allocated; /* The amount of space actually allocated diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index ab977cb..2268e45 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -33,7 +33,7 @@ * "memory tag" command is invoked, to hold the current tag. */ -typedef struct MemTag { +typedef struct { int refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as diff --git a/generic/tclClock.c b/generic/tclClock.c index 6d2976d..1257231 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -91,7 +91,7 @@ static const char *const literals[] = { * Structure containing the client data for [clock] */ -typedef struct ClockClientData { +typedef struct { int refCount; /* Number of live references. */ Tcl_Obj **literals; /* Pool of object literals. */ } ClockClientData; @@ -100,7 +100,7 @@ typedef struct ClockClientData { * Structure containing the fields used in [clock format] and [clock scan] */ -typedef struct TclDateFields { +typedef struct { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 14e0092..c0c1030 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); * The following structure is used to pass this information. */ -typedef struct SortInfo { +typedef struct { int isIncreasing; /* Nonzero means sort in increasing order. */ int sortMode; /* The sort mode. One of SORTMODE_* values * defined below. */ diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 890d518..c7aebba 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -22,7 +22,7 @@ * The tree is composed of OpNodes. */ -typedef struct OpNode { +typedef struct { int left; /* "Pointer" to the left operand. */ int right; /* "Pointer" to the right operand. */ union { diff --git a/generic/tclCompile.h b/generic/tclCompile.h index ba78c36..82a4218 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -80,7 +80,7 @@ typedef enum { * to a catch PC offset. */ } ExceptionRangeType; -typedef struct ExceptionRange { +typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range @@ -107,7 +107,7 @@ typedef struct ExceptionRange { * source offset is not monotonic. */ -typedef struct CmdLocation { +typedef struct { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ @@ -125,7 +125,7 @@ typedef struct CmdLocation { * frame and associated information, like the path of a sourced file. */ -typedef struct ECL { +typedef struct { int srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the @@ -135,7 +135,7 @@ typedef struct ECL { * lines. */ } ECL; -typedef struct ExtCmdLoc { +typedef struct { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in diff --git a/generic/tclConfig.c b/generic/tclConfig.c index a4ba71a..fe99bbb 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -31,7 +31,7 @@ * and the (Tcl_Interp *) in which it is stored. */ -typedef struct QCCD { +typedef struct { Tcl_Obj *pkg; Tcl_Interp *interp; } QCCD; diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 7a55724..8f30471 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src); * convert between various character sets and UTF-8. */ -typedef struct Encoding { +typedef struct { char *name; /* Name of encoding. Malloced because (1) hash * table entry that owns this encoding may be * freed prior to this encoding being freed, @@ -57,7 +57,7 @@ typedef struct Encoding { * encoding. */ -typedef struct TableEncodingData { +typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ @@ -91,7 +91,7 @@ typedef struct TableEncodingData { * for switching character sets. */ -typedef struct EscapeSubTable { +typedef struct { unsigned sequenceLen; /* Length of following string. */ char sequence[16]; /* Escape code that marks this encoding. */ char name[32]; /* Name for encoding. */ @@ -100,7 +100,7 @@ typedef struct EscapeSubTable { * yet. */ } EscapeSubTable; -typedef struct EscapeEncodingData { +typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 0b585b6..fb5e9c5 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -37,7 +37,7 @@ typedef struct BgError { * pending background errors for the interpreter. */ -typedef struct ErrAssocData { +typedef struct { Tcl_Interp *interp; /* Interpreter in which error occurred. */ Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */ BgError *firstBgPtr; /* First in list of all background errors diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3c0b472..8f66ef8 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -170,7 +170,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = { * Minimal data required to fully reconstruct the execution state. */ -typedef struct TEBCdata { +typedef struct { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ const unsigned char *pc; /* These fields are used on return TO this */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 4e24533..aae66d4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -24,7 +24,7 @@ * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { +typedef struct { NextChannelHandler *nestedHandlerPtr; /* This variable holds the list of nested * ChannelHandlerEventProc invocations. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 005713d..3d04f37 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -15,7 +15,7 @@ * Callback structure for accept callback in a TCP server. */ -typedef struct AcceptCallback { +typedef struct { char *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; @@ -25,7 +25,7 @@ typedef struct AcceptCallback { * It must be per-thread because of std channel limitations. */ -typedef struct ThreadSpecificData { +typedef struct { int initialized; /* Set to 1 when the module is initialized. */ Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */ } ThreadSpecificData; diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index cb0282a..4b61538 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -256,7 +256,7 @@ typedef enum { * sharing problems. */ -typedef struct ForwardParamBase { +typedef struct { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if @@ -331,7 +331,7 @@ typedef struct ForwardingResult ForwardingResult; * General event structure, with reference to operation specific data. */ -typedef struct ForwardingEvent { +typedef struct { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ @@ -368,7 +368,7 @@ struct ForwardingResult { * results. */ }; -typedef struct ThreadSpecificData { +typedef struct { /* * Table of all reflected channels owned by this thread. This is the * per-thread version of the per-interpreter map. @@ -774,7 +774,7 @@ TclChanCreateObjCmd( *---------------------------------------------------------------------- */ -typedef struct ReflectEvent { +typedef struct { Tcl_Event header; ReflectedChannel *rcPtr; int events; diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 2b9efb9..99ee2ec 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = { * layers upon reading from the channel, plus the functions to manage such. */ -typedef struct _ResultBuffer_ { +typedef struct { unsigned char *buf; /* Reference to the buffer area. */ int allocated; /* Allocated size of the buffer area. */ int used; /* Number of bytes in the buffer, @@ -252,7 +252,7 @@ typedef enum { * sharing problems. */ -typedef struct ForwardParamBase { +typedef struct { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if @@ -297,7 +297,7 @@ typedef struct ForwardingResult ForwardingResult; * General event structure, with reference to operation specific data. */ -typedef struct ForwardingEvent { +typedef struct { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ @@ -328,7 +328,7 @@ struct ForwardingResult { * results. */ }; -typedef struct ThreadSpecificData { +typedef struct { /* * Table of all reflected transformations owned by this thread. */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 2d6d898..c0fef56 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -54,7 +54,7 @@ typedef struct FilesystemRecord { * this information each time the corresponding epoch counter changes. */ -typedef struct ThreadSpecificData { +typedef struct { int initialized; int cwdPathEpoch; int filesystemEpoch; @@ -243,7 +243,7 @@ static Tcl_ThreadDataKey fsDataKey; * code. */ -typedef struct FsDivertLoad { +typedef struct { Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *divertedFile; diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0b0f652..b817b52 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL; struct Target; /* - * struct Alias: + * Alias: * * Stores information about an alias. Is stored in the slave interpreter and * used by the source command to find the target command in the master when * the source command is invoked. */ -typedef struct Alias { +typedef struct { Tcl_Obj *token; /* Token for the alias command in the slave * interp. This used to be the command name in * the slave when the alias was first @@ -73,7 +73,7 @@ typedef struct Alias { * slave interpreter, e.g. what aliases are defined in it. */ -typedef struct Slave { +typedef struct { Tcl_Interp *masterInterp; /* Master interpreter for this slave. */ Tcl_HashEntry *slaveEntryPtr; /* Hash entry in masters slave table for this @@ -84,7 +84,7 @@ typedef struct Slave { Tcl_Interp *slaveInterp; /* The slave interpreter. */ Tcl_Command interpCmd; /* Interpreter object command. */ Tcl_HashTable aliasTable; /* Table which maps from names of commands in - * slave interpreter to struct Alias defined + * slave interpreter to Alias defined * below. */ } Slave; @@ -127,7 +127,7 @@ typedef struct Target { * only load safe extensions. */ -typedef struct Master { +typedef struct { Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps * from command names to Slave records. */ Target *targetsPtr; /* The head of a doubly-linked list of all the @@ -144,7 +144,7 @@ typedef struct Master { * on a per-interp basis. */ -typedef struct InterpInfo { +typedef struct { Master master; /* Keeps track of all interps for which this * interp is the Master. */ Slave slave; /* Information necessary for this interp to @@ -158,7 +158,7 @@ typedef struct InterpInfo { * likely to work properly on 64-bit architectures. */ -typedef struct ScriptLimitCallback { +typedef struct { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the @@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback { * table. */ } ScriptLimitCallback; -typedef struct ScriptLimitCallbackKey { +typedef struct { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ diff --git a/generic/tclLink.c b/generic/tclLink.c index a3b42bd..b5e540b 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -21,7 +21,7 @@ * variable. */ -typedef struct Link { +typedef struct { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the diff --git a/generic/tclMain.c b/generic/tclMain.c index 14139ec..a2db09d 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -109,7 +109,7 @@ typedef enum { PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; -typedef struct InteractiveState { +typedef struct { Tcl_Channel input; /* The standard input channel from which lines * are read. */ int tty; /* Non-zero means standard input is a diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 3c93400..16d053e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -31,7 +31,7 @@ * limited to a single interpreter. */ -typedef struct ThreadSpecificData { +typedef struct { long numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be @@ -52,7 +52,7 @@ static Tcl_ThreadDataKey dataKey; * with some information that is used to check the cached pointer's validity. */ -typedef struct ResolvedNsName { +typedef struct { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ Namespace *refNsPtr; /* Points to the namespace context in which diff --git a/generic/tclObj.c b/generic/tclObj.c index 74cb29e..03141e4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -58,7 +58,7 @@ char *tclEmptyStringRep = &tclEmptyString; * for sanity checking purposes. */ -typedef struct ObjData { +typedef struct { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index db07c0e..14c61a9 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -71,7 +71,7 @@ static const Tcl_ObjType tclFsPathType = { * */ -typedef struct FsPath { +typedef struct { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this * is NULL, then this is a pure normalized, * absolute path object, in which the parent diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 9b6e942..2860949 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -39,7 +39,7 @@ typedef struct PkgAvail { * "Tk" (no version number). */ -typedef struct Package { +typedef struct { char *version; /* Version that has been supplied in this * interpreter via "package provide" * (malloc'ed). NULL means the package doesn't diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index 0bd8f93..62c8de4 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ * objects that we don't want to live any longer than necessary. */ -typedef struct HandleStruct { +typedef struct { void *ptr; /* Pointer to the memory block being tracked. * This field will become NULL when the memory * block is deleted. This field must be the diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 6c1dc08..4977934 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -64,7 +64,7 @@ #define NUM_REGEXPS 30 -typedef struct ThreadSpecificData { +typedef struct { int initialized; /* Set to 1 when the module is initialized. */ char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..a441d3d 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -35,7 +35,7 @@ static void SetupAppendBuffer(Interp *iPtr, int newSpace); * then back up to the result or the error that was previously in progress. */ -typedef struct InterpState { +typedef struct { int status; /* return code status */ int flags; /* Each remaining field saves the */ int returnLevel; /* corresponding field of the Interp */ diff --git a/generic/tclScan.c b/generic/tclScan.c index ef7eedf..c54395d 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -28,7 +28,7 @@ * character set. */ -typedef struct CharSet { +typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 04cf4ee..64c661b 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -104,7 +104,7 @@ const Tcl_ObjType tclStringType = { * tcl.h, but do not do that unless you are sure what you're doing! */ -typedef struct String { +typedef struct { int numChars; /* The number of chars in the string. -1 means * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or diff --git a/generic/tclTest.c b/generic/tclTest.c index 5dc95f9..050f065 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -98,7 +98,7 @@ static Tcl_Trace cmdTrace; * TestdelCmd: */ -typedef struct DelCmd { +typedef struct { Tcl_Interp *interp; /* Interpreter in which command exists. */ char *deleteCmd; /* Script to execute when command is deleted. * Malloc'ed. */ @@ -109,7 +109,7 @@ typedef struct DelCmd { * command. */ -typedef struct TclEncoding { +typedef struct { Tcl_Interp *interp; char *toUtfCmd; char *fromUtfCmd; @@ -132,7 +132,7 @@ static int exitMainLoop = 0; * Event structure used in testing the event queue management procedures. */ -typedef struct TestEvent { +typedef struct { Tcl_Event header; /* Header common to all events */ Tcl_Interp *interp; /* Interpreter that will handle the event */ Tcl_Obj *command; /* Command to evaluate when the event occurs */ diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 7494beb..c86eb9f 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -47,7 +47,7 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp, static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -typedef struct TestString { +typedef struct { int numChars; int allocated; int maxChars; diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index a3f89f6..3324b98 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -34,7 +34,7 @@ static const char procCommand[] = "proc"; * procs */ -typedef struct CmdTable { +typedef struct { const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index e4261d6..e57988b 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -82,7 +82,7 @@ typedef union Block { * and statistics information. */ -typedef struct Bucket { +typedef struct { Block *firstPtr; /* First block available */ long numFree; /* Number of blocks available */ diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index f24e334..36bf0a5 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -47,7 +47,7 @@ static struct TSDMaster { * The type of the data held per thread in a system TSD. */ -typedef struct TSDTable { +typedef struct { ClientData *tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 22b5995..aa9aaef 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -61,7 +61,7 @@ static ThreadSpecificData *threadList = NULL; * "thread create" Tcl command or the ThreadCreate() C function. */ -typedef struct ThreadCtrl { +typedef struct { const char *script; /* The Tcl command this thread should * execute */ int flags; /* Initial value of the "flags" field in the diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 6b17825..735c54a 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -91,7 +91,7 @@ typedef struct IdleHandler { * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { +typedef struct { TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ int lastTimerId; /* Timer identifier of most recently created * timer. */ diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 519f201..2dfd893 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -143,7 +143,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1, * trace procs */ -typedef struct StringTraceData { +typedef struct { ClientData clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 9ee37f1..023e082 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -99,7 +99,7 @@ * This structure describes per-instance state of a file based channel. */ -typedef struct FileState { +typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ int fd; /* File handle. */ int validMask; /* OR'ed combination of TCL_READABLE, @@ -126,7 +126,7 @@ typedef struct TtyState { * a platform-independant manner. */ -typedef struct TtyAttrs { +typedef struct { int baud; int parity; int data; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index e201018..5cb35d2 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -49,7 +49,7 @@ #ifdef TCL_THREADS -typedef struct ThreadSpecificData { +typedef struct { struct passwd pwd; #if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5) #define NEED_PW_CLEANER 1 diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index f07b123..39be160 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -42,12 +42,12 @@ static const char *const platforms[NUMPLATFORMS] = { }; #define NUMPROCESSORS 11 -static const char *const processors[NUMPROCESSORS] = { +static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" }; -typedef struct _SYSTEM_INFO { +typedef struct { union { DWORD dwOemId; struct { @@ -66,7 +66,7 @@ typedef struct _SYSTEM_INFO { int wProcessorRevision; } SYSTEM_INFO; -typedef struct _OSVERSIONINFOA { +typedef struct { DWORD dwOSVersionInfoSize; DWORD dwMajorVersion; DWORD dwMinorVersion; @@ -112,7 +112,7 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; * first list checked for a mapping from env encoding to Tcl encoding name. */ -typedef struct LocaleTable { +typedef struct { const char *lang; const char *encoding; } LocaleTable; diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index b87af1b..5c03b79 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -39,7 +39,7 @@ typedef struct FileHandler { * handlers are ready to fire. */ -typedef struct FileHandlerEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find @@ -54,7 +54,7 @@ typedef struct FileHandlerEvent { * writable, and exception conditions. */ -typedef struct SelectMasks { +typedef struct { fd_set readable; fd_set writable; fd_set exception; diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 654c9d8..e2a534e 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -30,7 +30,7 @@ * This structure describes per-instance state of a pipe based channel. */ -typedef struct PipeState { +typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ TclFile inFile; /* Output from pipe. */ TclFile outFile; /* Input to pipe. */ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 46fc972..8b3338a 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -37,7 +37,7 @@ * exercised by the "testfilehandler" command. */ -typedef struct Pipe { +typedef struct { TclFile readFile; /* File handle for reading from the pipe. NULL * means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 789dbb6..9a1efbe 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -15,7 +15,7 @@ #ifdef TCL_THREADS -typedef struct ThreadSpecificData { +typedef struct { char nabuf[16]; } ThreadSpecificData; @@ -683,7 +683,7 @@ TclpInetNtoa( static volatile int initialized = 0; static pthread_key_t key; -typedef struct allocMutex { +typedef struct { Tcl_Mutex tlock; pthread_mutex_t plock; } allocMutex; @@ -691,10 +691,10 @@ typedef struct allocMutex { Tcl_Mutex * TclpNewAllocMutex(void) { - struct allocMutex *lockPtr; + allocMutex *lockPtr; register pthread_mutex_t *plockPtr; - lockPtr = malloc(sizeof(struct allocMutex)); + lockPtr = malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index c7921fe..9497502 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -26,7 +26,7 @@ */ static Tcl_ThreadDataKey tmKey; -typedef struct ThreadSpecificData { +typedef struct { struct tm gmtime_buf; struct tm localtime_buf; } ThreadSpecificData; diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 52b9e32..e8f46ef 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -43,7 +43,7 @@ typedef struct FileInfo { * pending on the channel. */ } FileInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * List of all file channels currently open. */ @@ -58,7 +58,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct FileEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ FileInfo *infoPtr; /* Pointer to file info structure. Note that diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 5aab255..094a5e9 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -50,7 +50,7 @@ TCL_DECLARE_MUTEX(consoleMutex) * threads. */ -typedef struct ConsoleThreadInfo { +typedef struct { HANDLE thread; /* Handle to reader or writer thread. */ HANDLE readyEvent; /* Manual-reset event to signal _to_ the main * thread when the worker thread has finished @@ -113,7 +113,7 @@ typedef struct ConsoleInfo { /* Data consumed by reader thread. */ } ConsoleInfo; -typedef struct ThreadSpecificData { +typedef struct{ /* * The following pointer refers to the head of the list of consoles that * are being watched for file events. @@ -129,7 +129,7 @@ static Tcl_ThreadDataKey dataKey; * console events are generated. */ -typedef struct ConsoleEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 23b3a8e..bf8cc86 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -68,7 +68,7 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; -typedef struct DdeEnumServices { +typedef struct { Tcl_Interp *interp; int result; ATOM service; @@ -76,7 +76,7 @@ typedef struct DdeEnumServices { HWND hwnd; } DdeEnumServices; -typedef struct ThreadSpecificData { +typedef struct { Conversation *currentConversations; /* A list of conversations currently being * processed. */ @@ -113,7 +113,7 @@ TCL_DECLARE_MUTEX(ddeMutex) static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); -static int DdeCreateClient(struct DdeEnumServices *es); +static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); @@ -1038,7 +1038,7 @@ MakeDdeConnection( static int DdeCreateClient( - struct DdeEnumServices *es) + DdeEnumServices *es) { WNDCLASSEX wc; static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); @@ -1048,7 +1048,7 @@ DdeCreateClient( wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; - wc.cbWndExtra = sizeof(struct DdeEnumServices *); + wc.cbWndExtra = sizeof(DdeEnumServices *); /* * Register and create the callback window. @@ -1070,8 +1070,8 @@ DdeClientWindowProc( switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; - struct DdeEnumServices *es = - (struct DdeEnumServices *) lpcs->lpCreateParams; + DdeEnumServices *es = + (DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); @@ -1096,14 +1096,14 @@ DdeServicesOnAck( HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); - struct DdeEnumServices *es; + DdeEnumServices *es; TCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 - es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); + es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)0 || es->service == service) @@ -1154,7 +1154,7 @@ DdeEnumWindowsCallback( LPARAM lParam) { DWORD_PTR dwResult = 0; - struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; + DdeEnumServices *es = (DdeEnumServices *) lParam; SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, @@ -1168,7 +1168,7 @@ DdeGetServicesList( const TCHAR *serviceName, const TCHAR *topicName) { - struct DdeEnumServices es; + DdeEnumServices es; es.interp = interp; es.result = TCL_OK; diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 4543b02..aaa5878 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -27,7 +27,7 @@ * created for each thread that is using the notifier. */ -typedef struct ThreadSpecificData { +typedef struct { CRITICAL_SECTION crit; /* Monitor for this notifier. */ DWORD thread; /* Identifier for thread associated with this * notifier. */ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 36ae58a..3309858 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -52,7 +52,7 @@ TCL_DECLARE_MUTEX(pipeMutex) * used in a pipeline. */ -typedef struct WinFile { +typedef struct { int type; /* One of the file types defined above. */ HANDLE handle; /* Open file handle. */ } WinFile; @@ -144,7 +144,7 @@ typedef struct PipeInfo { * synchronized with the readable object. */ } PipeInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * The following pointer refers to the head of the list of pipes that are * being watched for file events. @@ -160,7 +160,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct PipeEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 9e9d1af..4c9a495 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -122,7 +122,7 @@ typedef struct SerialInfo { * [fconfigure -queue] */ } SerialInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * The following pointer refers to the head of the list of serials that * are being watched for file events. @@ -138,7 +138,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct SerialEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SerialInfo *infoPtr; /* Pointer to serial info structure. Note that diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 9f7caee..62b2f7f 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -163,7 +163,7 @@ struct SocketInfo { * socket event occurs. */ -typedef struct SocketEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SOCKET socket; /* Socket descriptor that is ready. Used to @@ -191,7 +191,7 @@ typedef struct SocketEvent { #define SOCKET_PENDING (1<<3) /* A message has been sent for this * socket */ -typedef struct ThreadSpecificData { +typedef struct { HWND hwnd; /* Handle to window for socket messages. */ HANDLE socketThread; /* Thread handling the window */ Tcl_ThreadId threadId; /* Parent thread. */ diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 102fd40..5d4a754 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -102,7 +102,7 @@ static Tcl_ThreadDataKey dataKey; * the queue. */ -typedef struct WinCondition { +typedef struct { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ @@ -117,7 +117,7 @@ typedef struct WinCondition { static int once; static DWORD tlsKey; -typedef struct allocMutex { +typedef struct { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; @@ -873,9 +873,9 @@ TclpFinalizeCondition( Tcl_Mutex * TclpNewAllocMutex(void) { - struct allocMutex *lockPtr; + allocMutex *lockPtr; - lockPtr = malloc(sizeof(struct allocMutex)); + lockPtr = malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index daa229d..80e51b6 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -35,7 +35,7 @@ static const int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; -typedef struct ThreadSpecificData { +typedef struct { char tzName[64]; /* Time zone name */ struct tm tm; /* time information */ } ThreadSpecificData; @@ -45,7 +45,7 @@ static Tcl_ThreadDataKey dataKey; * Data for managing high-resolution timers. */ -typedef struct TimeInfo { +typedef struct { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ -- cgit v0.12 From bdafa7afcb41f8ba37aea8338559c0673dc6688e Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 2 Sep 2012 07:28:02 +0000 Subject: Add package index entry. --- library/http/pkgIndex.tcl | 1 + 1 file changed, 1 insertion(+) diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index d51f8a8..5ce5c37 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,3 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} package ifneeded http 2.8.4 [list tclPkgSetup $dir http 2.8.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded cookiejar 0.1 [list tclPkgSetup $dir cookiejar 0.1 {{cookiejar.tcl source {::http::cookiejar}}}] -- cgit v0.12 From 51e67d70c40f25577a399ae06cfad0484bb58020 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 4 Sep 2012 21:24:43 +0000 Subject: Improving the cookie lookup code to actually handle paths&domains --- library/http/cookiejar.tcl | 85 +++++++++++++++++++++++++++------------------- 1 file changed, 50 insertions(+), 35 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index e6c1e85..4e67f95 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -78,6 +78,7 @@ namespace eval ::http { } method InitDomainList {} { + variable ::http::CookiejarDomainList db eval { CREATE TABLE IF NOT EXISTS forbidden ( domain TEXT PRIMARY KEY); @@ -86,7 +87,8 @@ namespace eval ::http { CREATE TABLE IF NOT EXISTS permitted ( domain TEXT PRIMARY KEY); } - set tok [http::geturl $::http::CookiejarDomainList] + http::Log "Loading domain list from $CookiejarDomainList" + set tok [http::geturl $CookiejarDomainList] try { if {[http::ncode $tok] == 200} { foreach line [split [http::data $tok] \n] { @@ -96,19 +98,19 @@ namespace eval ::http { set line [string range $line 1 end] db eval { INSERT INTO permitted (domain) - VALUES (:line) + VALUES ($line) } } else { if {[string match {\*.*} $line]} { set line [string range $line 2 end] db eval { INSERT INTO forbiddenSuper (domain) - VALUES (:line) + VALUES ($line) } } db eval { INSERT INTO forbidden (domain) - VALUES (:line) + VALUES ($line) } } } @@ -125,32 +127,44 @@ namespace eval ::http { db close } + method GetCookiesForHostAndPath {result host path} { + upvar 1 $result result + db eval { + SELECT key, value FROM cookies + WHERE domain = $host AND path = $path + } cookie { + dict set result $cookie(key) $cookie(value) + } + db eval { + SELECT key, value FROM sessionCookies + WHERE domain = $host AND path = $path + } cookie { + dict set result $cookie(key) $cookie(value) + } + } method getCookies {proto host port path} { upvar 1 state state set result {} - ## TODO: How to handle prefix matches? -# From kbk -#LENGTH(theColumn) <= LENGTH(:queryStr) AND SUBSTR(theColumn, LENGTH(:queryStr)-LENGTH(theColumn)+1) = :queryStr db transaction { - db eval { - SELECT key, value FROM cookies WHERE domain = :host - } cookie { - dict set result $key $value - } - db eval { - SELECT key, value FROM sessionCookies WHERE domain = :host - } cookie { - dict set result $key $value - } - db eval { - SELECT key, value FROM cookies WHERE origin = :host - } cookie { - dict set result $key $value - } - db eval { - SELECT key, value FROM sessionCookies WHERE origin = :host - } cookie { - dict set result $key $value + # Open question: how to move these manipulations into the + # database engine (if that's where they *should* be) + # Suggestion from kbk + #LENGTH(theColumn) <= LENGTH(:queryStr) AND SUBSTR(theColumn, LENGTH(:queryStr) LENGTH(theColumn)+1) = :queryStr + set pathbits [split [string trimleft $path "/"] "/"] + set hostbits [split $host "."] + if {[regexp {[^0-9.]} $host]} { + for {set i [llength $hostbits]} {[incr i -1] >= 0} {} { + set domain [join [lrange $hostbits $i end] "."] + for {set j -1} {$j < [llength $pathbits]} {incr j} { + set p /[join [lrange $pathbits 0 $j] "/"] + my GetCookiesForHostAndPath result $domain $p + } + } + } else { + for {set j -1} {$j < [llength $pathbits]} {incr j} { + set p /[join [lrange $pathbits 0 $j] "/"] + my GetCookiesForHostAndPath result $host $p + } } } return $result @@ -162,15 +176,16 @@ namespace eval ::http { } set domain [dict get $options domain] db eval { - SELECT domain FROM permitted WHERE domain == :domain + SELECT domain FROM permitted WHERE domain == $domain } x {return 0} db eval { - SELECT domain FROM forbidden WHERE domain == :domain - } x {return 1} - if {![regexp {^[^.]+\.(.+)$} $domain -> super]} {return 1} - db eval { - SELECT domain FROM forbiddenSuper WHERE domain == :domain + SELECT domain FROM forbidden WHERE domain == $domain } x {return 1} + if {[regexp {^[^.]+\.(.+)$} $domain -> super]} { + db eval { + SELECT domain FROM forbiddenSuper WHERE domain == $super + } x {return 1} + } return 0 } @@ -188,16 +203,16 @@ namespace eval ::http { db eval { INSERT OR REPLACE sessionCookies ( origin, domain, key, value) - VALUES (:origin, :domain, :key, :value) + VALUES ($origin, $domain, $key, $value) } } elseif {$expires < $now} { db eval { DELETE FROM cookies - WHERE domain = :domain AND key = :name AND path = :path + WHERE domain = $domain AND key = $name AND path = $path } db eval { DELETE FROM sessionCookies - WHERE domain = :domain AND key = :name AND path = :path + WHERE domain = $domain AND key = $name AND path = $path } } else { ### FIXME -- cgit v0.12 From fa56a98ba9b5e567d53181939645c71ccdfc6cfc Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Sep 2012 09:46:03 +0000 Subject: more realistic queries --- library/http/cookiejar.tcl | 92 ++++++++++++++++++++++++++++++---------------- library/http/http.tcl | 3 +- 2 files changed, 63 insertions(+), 32 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 4e67f95..054698f 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -9,13 +9,14 @@ namespace eval ::http { } ::oo::class create ::http::cookiejar { - variable aid + variable aid deletions constructor {{path ""}} { if {$path eq ""} { sqlite3 [namespace current]::db :memory: } else { sqlite3 [namespace current]::db $path } + set deletions 0 ## FIXME ## Model from Safari: # * Creation instant @@ -62,15 +63,21 @@ namespace eval ::http { ON sessionCookies (origin, path, key) } + db eval { + SELECT COUNT(*) AS cookieCount FROM cookies + } + if {$cookieCount} { + http::Log "loaded cookie store from $path with $cookieCount entries" + } + set aid [after 60000 [namespace current]::my PurgeCookies] if {$path ne ""} { db transaction { - db eval { - SELECT count(*) AS present FROM sqlite_master + if {![db exists { + SELECT 1 FROM sqlite_master WHERE type='table' AND name='forbidden' - } - if {!$present} { + }]} then { my InitDomainList } } @@ -149,7 +156,7 @@ namespace eval ::http { # Open question: how to move these manipulations into the # database engine (if that's where they *should* be) # Suggestion from kbk - #LENGTH(theColumn) <= LENGTH(:queryStr) AND SUBSTR(theColumn, LENGTH(:queryStr) LENGTH(theColumn)+1) = :queryStr + #LENGTH(theColumn) <= LENGTH($queryStr) AND SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr set pathbits [split [string trimleft $path "/"] "/"] set hostbits [split $host "."] if {[regexp {[^0-9.]} $host]} { @@ -174,21 +181,37 @@ namespace eval ::http { if {![dict exists $options domain]} { return 0 } - set domain [dict get $options domain] - db eval { - SELECT domain FROM permitted WHERE domain == $domain - } x {return 0} - db eval { - SELECT domain FROM forbidden WHERE domain == $domain - } x {return 1} + dict with options {} + if {$domain ne $origin} { + http::Log "cookie domain varies from origin ($domain, $origin)" + } + if {[db exists { + SELECT 1 FROM permitted WHERE domain = $domain + }]} {return 0} + if {[db exists { + SELECT 1 FROM forbidden WHERE domain = $domain + }]} {return 1} if {[regexp {^[^.]+\.(.+)$} $domain -> super]} { - db eval { - SELECT domain FROM forbiddenSuper WHERE domain == $super - } x {return 1} + if {[db exists { + SELECT 1 FROM forbiddenSuper WHERE domain = $super + }]} {return 1} } return 0 } + method DeleteCookie {domain path key} { + db eval { + DELETE FROM cookies + WHERE domain = $domain AND key = $name AND path = $path + } + incr deletions [db changes] + db eval { + DELETE FROM sessionCookies + WHERE domain = $domain AND key = $name AND path = $path + } + incr deletions [db changes] + http::Log "deleted cookies for $domain, $path, $path" + } method storeCookie {name val options} { upvar 1 state state set now [clock seconds] @@ -201,26 +224,21 @@ namespace eval ::http { if {!$persistent} { ### FIXME db eval { - INSERT OR REPLACE sessionCookies ( - origin, domain, key, value) - VALUES ($origin, $domain, $key, $value) + INSERT OR REPLACE INTO sessionCookies ( + origin, domain, path, key, value) + VALUES ($origin, $domain, $path, $key, $value) } + http::Log "defined session cookie for $domain, $path, $key" } elseif {$expires < $now} { - db eval { - DELETE FROM cookies - WHERE domain = $domain AND key = $name AND path = $path - } - db eval { - DELETE FROM sessionCookies - WHERE domain = $domain AND key = $name AND path = $path - } + my DeleteCookie $domain $path $key } else { ### FIXME db eval { - INSERT OR REPLACE cookies ( - origin, domain, key, value, expiry) - VALUES (:origin, :domain, :key, :value, :expiry) + INSERT OR REPLACE INTO cookies ( + origin, domain, path, key, value, expiry) + VALUES ($origin, $domain, $path, $key, $value, $expires) } + http::Log "defined persistent cookie for $domain, $path, $key expires at [clock format $expires]" } } } @@ -228,7 +246,19 @@ namespace eval ::http { method PurgeCookies {} { set aid [after 60000 [namespace current]::my PurgeCookies] set now [clock seconds] - db eval {DELETE FROM cookies WHERE expiry < :now} + http::Log "purging cookies that expired before [clock format $now]" + db transaction { + db eval { + DELETE FROM cookies WHERE expiry < $now + } + incr deletions [db changes] + if {$deletions > 100} { + set deletions 0 + db eval { + VACUUM + } + } + } ### TODO: Cap the total number of cookies and session cookies, ### purging least frequently used } diff --git a/library/http/http.tcl b/library/http/http.tcl index 4fa39a4..e434a45 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1192,8 +1192,9 @@ proc http::ParseCookie {token value} { # Convert the options into a list before feeding into the cookie store; # ugly, but quite easy. - set realopts {persistent 0 hostonly 1} + set realopts {persistent 0 hostonly 1 path /} dict set realopts origin $state(host) + dict set realopts domain $state(host) foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { switch -glob -nocase -- $opt { Expires=* { -- cgit v0.12 From 8d9808cb4d764dfccb1a35db84a1ad6a58b31f70 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Sep 2012 10:24:05 +0000 Subject: closer to working --- library/http/cookiejar.tcl | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 054698f..bd85b46 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -1,4 +1,5 @@ package require Tcl 8.6 +package require http 2.8.4 package require sqlite3 package provide cookiejar 0.1 @@ -66,7 +67,7 @@ namespace eval ::http { db eval { SELECT COUNT(*) AS cookieCount FROM cookies } - if {$cookieCount} { + if {[info exist cookieCount] && $cookieCount} { http::Log "loaded cookie store from $path with $cookieCount entries" } @@ -134,8 +135,8 @@ namespace eval ::http { db close } - method GetCookiesForHostAndPath {result host path} { - upvar 1 $result result + method GetCookiesForHostAndPath {*result host path} { + upvar 1 ${*result} result db eval { SELECT key, value FROM cookies WHERE domain = $host AND path = $path -- cgit v0.12 From a23ee46c675547eb49015e946884b841c71d8331 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 6 Sep 2012 09:49:52 +0000 Subject: improve logging, correct 'secure' property handling, correct domain handling, simplify http<->cookiejar interface --- library/http/cookiejar.tcl | 267 +++++++++++++++++++++++++++------------------ library/http/http.tcl | 14 ++- 2 files changed, 171 insertions(+), 110 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index bd85b46..30720f8 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -1,92 +1,96 @@ -package require Tcl 8.6 -package require http 2.8.4 +package require Tcl 8.5 +package require TclOO +package require http 2.7;#2.8.4 package require sqlite3 -package provide cookiejar 0.1 namespace eval ::http { - # TODO is this the _right_ list of domains to use? - variable CookiejarDomainList \ + # TODO: is this the _right_ list of domains to use? + variable cookiejar_domainlist \ http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 + variable cookiejar_version 0.1 + variable cookiejar_loglevel info } ::oo::class create ::http::cookiejar { + self { + method log {origin level msg} { + upvar 0 ::http::cookiejar_loglevel loglevel + set map {debug 0 info 1 warn 2 error 3} + if {[string map $map $level] >= [string map $map $loglevel]} { + ::http::Log [string toupper $level]:cookiejar($origin):${msg} + } + } + method loglevel {level} { + upvar 0 ::http::cookiejar_loglevel loglevel + if {$level in {debug info warn error}} { + set loglevel $level + } else { + return -code error "unknown log level \"$level\": must be debug, info, warn, or error" + } + } + } + variable aid deletions constructor {{path ""}} { if {$path eq ""} { sqlite3 [namespace current]::db :memory: } else { sqlite3 [namespace current]::db $path + db timeout 500 } + proc log {level msg} "::http::cookiejar log [list [self]] \$level \$msg" set deletions 0 - ## FIXME - ## Model from Safari: - # * Creation instant - # * Domain - # * Expiration instant - # * Name - # * Path - # * Value - ## Model from Firefox: - # CREATE TABLE moz_cookies ( - # id INTEGER PRIMARY KEY, - # name TEXT, - # value TEXT, - # host TEXT, - # path TEXT, - # expiry INTEGER, - # lastAccessed INTEGER, - # isSecure INTEGER, - # isHttpOnly INTEGER, - # baseDomain TEXT, - # creationTime INTEGER) - # CREATE INDEX moz_basedomain ON moz_cookies (baseDomain) - # CREATE UNIQUE INDEX moz_uniqueid ON moz_cookies (name, host, path) db eval { CREATE TABLE IF NOT EXISTS cookies ( id INTEGER PRIMARY KEY, - origin TEXT NOT NULL COLLATE NOCASE, + secure INTEGER NOT NULL, + domain TEXT NOT NULL COLLATE NOCASE, path TEXT NOT NULL, - domain TEXT COLLATE NOCASE, key TEXT NOT NULL, value TEXT NOT NULL, + originonly INTEGER NOT NULL, expiry INTEGER NOT NULL); CREATE UNIQUE INDEX IF NOT EXISTS cookieUnique - ON cookies (origin, path, key) + ON cookies (secure, domain, path, key) } db eval { - CREATE TEMP TABLE IF NOT EXISTS sessionCookies ( - origin TEXT NOT NULL COLLATE NOCASE, + CREATE TEMP TABLE sessionCookies ( + id INTEGER PRIMARY KEY, + secure INTEGER NOT NULL, + domain TEXT NOT NULL COLLATE NOCASE, path TEXT NOT NULL, - domain TEXT COLLATE NOCASE, key TEXT NOT NULL, + originonly INTEGER NOT NULL, value TEXT NOT NULL); - CREATE UNIQUE INDEX IF NOT EXISTS sessionUnique - ON sessionCookies (origin, path, key) + CREATE UNIQUE INDEX sessionUnique + ON sessionCookies (secure, domain, path, key) } db eval { SELECT COUNT(*) AS cookieCount FROM cookies } if {[info exist cookieCount] && $cookieCount} { - http::Log "loaded cookie store from $path with $cookieCount entries" + log info "loaded cookie store from $path with $cookieCount entries" } set aid [after 60000 [namespace current]::my PurgeCookies] + # TODO: domain list refresh policy if {$path ne ""} { - db transaction { - if {![db exists { - SELECT 1 FROM sqlite_master - WHERE type='table' AND name='forbidden' - }]} then { - my InitDomainList - } + if {![db exists { + SELECT 1 FROM sqlite_master + WHERE type='table' AND name='forbidden' + }] && ![db exists { + SELECT 1 FROM forbidden + }]} then { + my InitDomainList } } } - + method InitDomainList {} { - variable ::http::CookiejarDomainList + # TODO: Handle IDNs (but Tcl overall gets that wrong at the moment...) + variable ::http::cookiejar_domainlist db eval { CREATE TABLE IF NOT EXISTS forbidden ( domain TEXT PRIMARY KEY); @@ -95,35 +99,37 @@ namespace eval ::http { CREATE TABLE IF NOT EXISTS permitted ( domain TEXT PRIMARY KEY); } - http::Log "Loading domain list from $CookiejarDomainList" - set tok [http::geturl $CookiejarDomainList] + log debug "loading domain list from $cookiejar_domainlist" + set tok [http::geturl $cookiejar_domainlist] try { if {[http::ncode $tok] == 200} { - foreach line [split [http::data $tok] \n] { - if {[string trim $line] eq ""} continue - if {[string match //* $line]} continue - if {[string match !* $line]} { - set line [string range $line 1 end] - db eval { - INSERT INTO permitted (domain) - VALUES ($line) - } - } else { - if {[string match {\*.*} $line]} { - set line [string range $line 2 end] + db transaction { + foreach line [split [http::data $tok] \n] { + if {[string trim $line] eq ""} continue + if {[string match //* $line]} continue + if {[string match !* $line]} { + set line [string range $line 1 end] db eval { - INSERT INTO forbiddenSuper (domain) + INSERT INTO permitted (domain) + VALUES ($line) + } + } else { + if {[string match {\*.*} $line]} { + set line [string range $line 2 end] + db eval { + INSERT INTO forbiddenSuper (domain) VALUES ($line) + } } - } - db eval { - INSERT INTO forbidden (domain) + db eval { + INSERT INTO forbidden (domain) VALUES ($line) + } } } } } else { - http::Log "Warning: failed to fetch list of forbidden cookie domains" + log error "failed to fetch list of forbidden cookie domains from $cookiejar_domainlist" } } finally { http::cleanup $tok @@ -135,43 +141,71 @@ namespace eval ::http { db close } - method GetCookiesForHostAndPath {*result host path} { + method RenderLocation {secure domain path {key ""}} { + if {$key eq ""} { + format "%s://%s%s" [expr {$secure?"https":"http"}] $domain $path + } else { + format "%s://%s%s?%s" \ + [expr {$secure?"https":"http"}] $domain $path $key + } + } + + method GetCookiesForHostAndPath {*result secure host path fullhost} { upvar 1 ${*result} result + log debug "check for cookies for [my RenderLocation $secure $host $path]" db eval { SELECT key, value FROM cookies - WHERE domain = $host AND path = $path + WHERE secure <= $secure AND domain = $host AND path = $path + AND (NOT originonly OR domain = $fullhost) } cookie { - dict set result $cookie(key) $cookie(value) + lappend result $cookie(key) $cookie(value) } db eval { SELECT key, value FROM sessionCookies - WHERE domain = $host AND path = $path + WHERE secure <= $secure AND domain = $host AND path = $path + AND (NOT originonly OR domain = $fullhost) } cookie { - dict set result $cookie(key) $cookie(value) + lappend result $cookie(key) $cookie(value) + } + } + + method SplitDomain domain { + set pieces [split $domain "."] + for {set i [llength $pieces]} {[incr i -1] >= 0} {} { + lappend result [join [lrange $pieces $i end] "."] } + return $result } - method getCookies {proto host port path} { + method SplitPath path { + set pieces [split [string trimleft $path "/"] "/"] + for {set j -1} {$j < [llength $pieces]} {incr j} { + lappend result /[join [lrange $pieces 0 $j] "/"] + } + return $result + } + + method getCookies {proto host path} { upvar 1 state state set result {} - db transaction { - # Open question: how to move these manipulations into the - # database engine (if that's where they *should* be) - # Suggestion from kbk - #LENGTH(theColumn) <= LENGTH($queryStr) AND SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr - set pathbits [split [string trimleft $path "/"] "/"] - set hostbits [split $host "."] - if {[regexp {[^0-9.]} $host]} { - for {set i [llength $hostbits]} {[incr i -1] >= 0} {} { - set domain [join [lrange $hostbits $i end] "."] - for {set j -1} {$j < [llength $pathbits]} {incr j} { - set p /[join [lrange $pathbits 0 $j] "/"] - my GetCookiesForHostAndPath result $domain $p + set paths [my SplitPath $path] + set domains [my SplitDomain $host] + set secure [string equal -nocase $proto "https"] + # Open question: how to move these manipulations into the database + # engine (if that's where they *should* be) + # Suggestion from kbk: + #LENGTH(theColumn) <= LENGTH($queryStr) AND SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr + if {[regexp {[^0-9.]} $host]} { + db transaction { + foreach domain $domains { + foreach p $paths { + my GetCookiesForHostAndPath result $secure $domain $p $host } } - } else { - for {set j -1} {$j < [llength $pathbits]} {incr j} { - set p /[join [lrange $pathbits 0 $j] "/"] - my GetCookiesForHostAndPath result $host $p + } + } else { + db transaction { + foreach p $paths { + my GetCookiesForHostAndPath result $secure $host $p $host } } } @@ -184,41 +218,55 @@ namespace eval ::http { } dict with options {} if {$domain ne $origin} { - http::Log "cookie domain varies from origin ($domain, $origin)" + log debug "cookie domain varies from origin ($domain, $origin)" + } + if {![regexp {[^0-9.]} $domain]} { + if {$domain eq $origin} { + # May set for itself + return 0 + } + log warn "bad cookie: for a numeric address" + return 1 } if {[db exists { SELECT 1 FROM permitted WHERE domain = $domain }]} {return 0} if {[db exists { SELECT 1 FROM forbidden WHERE domain = $domain - }]} {return 1} + }]} { + log warn "bad cookie: for a forbidden address" + return 1 + } if {[regexp {^[^.]+\.(.+)$} $domain -> super]} { if {[db exists { SELECT 1 FROM forbiddenSuper WHERE domain = $super - }]} {return 1} + }]} { + log warn "bad cookie: for a forbidden address" + return 1 + } } return 0 } - method DeleteCookie {domain path key} { + method DeleteCookie {secure domain path key} { db eval { DELETE FROM cookies - WHERE domain = $domain AND key = $name AND path = $path + WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key } - incr deletions [db changes] + set del [db changes] db eval { DELETE FROM sessionCookies - WHERE domain = $domain AND key = $name AND path = $path + WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key } - incr deletions [db changes] - http::Log "deleted cookies for $domain, $path, $path" + incr deletions [incr del [db changes]] + log debug "deleted $del cookies for [my RenderLocation $secure $domain $path $key]" } + method storeCookie {name val options} { upvar 1 state state set now [clock seconds] db transaction { if {[my BadDomain $options]} { - http::Log "Warning: evil cookie detected" return } dict with options {} @@ -226,20 +274,24 @@ namespace eval ::http { ### FIXME db eval { INSERT OR REPLACE INTO sessionCookies ( - origin, domain, path, key, value) - VALUES ($origin, $domain, $path, $key, $value) + secure, domain, path, key, value, originonly) + VALUES ($secure, $domain, $path, $key, $value, $hostonly); + DELETE FROM cookies + WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key } - http::Log "defined session cookie for $domain, $path, $key" + log debug "defined session cookie for [my RenderLocation $secure $domain $path $key]" } elseif {$expires < $now} { - my DeleteCookie $domain $path $key + my DeleteCookie $secure $domain $path $key } else { ### FIXME db eval { INSERT OR REPLACE INTO cookies ( - origin, domain, path, key, value, expiry) - VALUES ($origin, $domain, $path, $key, $value, $expires) + secure, domain, path, key, value, originonly, expiry) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires); + DELETE FROM sessionCookies + WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key } - http::Log "defined persistent cookie for $domain, $path, $key expires at [clock format $expires]" + log debug "defined persistent cookie for [my RenderLocation $secure $host $path $key], expires at [clock format $expires]" } } } @@ -247,7 +299,7 @@ namespace eval ::http { method PurgeCookies {} { set aid [after 60000 [namespace current]::my PurgeCookies] set now [clock seconds] - http::Log "purging cookies that expired before [clock format $now]" + log debug "purging cookies that expired before [clock format $now]" db transaction { db eval { DELETE FROM cookies WHERE expiry < $now @@ -255,6 +307,7 @@ namespace eval ::http { incr deletions [db changes] if {$deletions > 100} { set deletions 0 + log debug "vacuuming cookie database" db eval { VACUUM } @@ -266,3 +319,5 @@ namespace eval ::http { forward Database db } + +package provide cookiejar $::http::cookiejar_version diff --git a/library/http/http.tcl b/library/http/http.tcl index e434a45..746603f 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -88,7 +88,7 @@ namespace eval http { } # Regular expression used to parse cookies - variable CookieRE {\s*([^][\u0000- ()<>@,;:\\""/?={}\u0100-\uffff]+)=([!\u0023-+\u002D-:<-\u005B\u005D-~]*)(?:\s*;\s*([^\u0000]+))?} + variable CookieRE {\s*([^][\u0000- ()<>@,;:\\""/?={}\u007f-\uffff]+)=([!\u0023-+\u002D-:<-\u005B\u005D-~]*)(?:\s*;\s*([^\u0000]+))?} namespace export geturl config reset wait formatQuery register unregister # Useful, but not exported: data size status code @@ -732,11 +732,14 @@ proc http::geturl {url args} { seek $state(-querychannel) $start } + # Note that we don't do Cookie2; that's much nastier and not normally + # observed in practice either. It also doesn't fix the multitude of + # bugs in the basic cookie spec. if {$http(-cookiejar) ne ""} { set cookies "" set separator "" foreach {key value} [{*}$http(-cookiejar) \ - getCookies $proto $host $port $state(path)] { + getCookies $proto $host $state(path)] { append cookies $separator $key = $value set separator "; " } @@ -1192,7 +1195,7 @@ proc http::ParseCookie {token value} { # Convert the options into a list before feeding into the cookie store; # ugly, but quite easy. - set realopts {persistent 0 hostonly 1 path /} + set realopts {persistent 0 hostonly 1 path / secure 0} dict set realopts origin $state(host) dict set realopts domain $state(host) foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { @@ -1211,6 +1214,9 @@ proc http::ParseCookie {token value} { [clock scan $opt -format "%a, %d-%b-%Y %T %Z"] dict set realopts persistent 1 }] && [catch { + # This is in the RFC, but it is also in the original + # Netscape cookie spec, now online at: + # #Sunday, 06-Nov-94 08:49:37 GMT dict set realopts expires \ [clock scan $opt -format "%A, %d-%b-%y %T %Z"] @@ -1232,9 +1238,9 @@ proc http::ParseCookie {token value} { } Domain=* { set opt [string trimleft [string range $opt 7 end] "."] - # TODO - Domain safety check! if {$opt ne "" && ![string match *. $opt]} { dict set realopts domain $opt + dict set realopts hostonly 0 } } Path=* { -- cgit v0.12 From ddb07346c093db91c8ac9cff07843d135067ac3d Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 6 Sep 2012 19:18:37 +0000 Subject: Tidy up, making code be of higher general quality. --- library/http/cookiejar.tcl | 27 +++++++++++++-------------- library/http/http.tcl | 2 +- 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 30720f8..9a02834 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -20,13 +20,14 @@ namespace eval ::http { ::http::Log [string toupper $level]:cookiejar($origin):${msg} } } - method loglevel {level} { + method loglevel {{level "\u0000\u0000"}} { upvar 0 ::http::cookiejar_loglevel loglevel if {$level in {debug info warn error}} { set loglevel $level - } else { + } elseif {$level ne "\u0000\u0000"} { return -code error "unknown log level \"$level\": must be debug, info, warn, or error" } + return $loglevel } } @@ -76,6 +77,14 @@ namespace eval ::http { set aid [after 60000 [namespace current]::my PurgeCookies] # TODO: domain list refresh policy + db eval { + CREATE TABLE IF NOT EXISTS forbidden ( + domain TEXT PRIMARY KEY); + CREATE TABLE IF NOT EXISTS forbiddenSuper ( + domain TEXT PRIMARY KEY); + CREATE TABLE IF NOT EXISTS permitted ( + domain TEXT PRIMARY KEY); + } if {$path ne ""} { if {![db exists { SELECT 1 FROM sqlite_master @@ -91,14 +100,6 @@ namespace eval ::http { method InitDomainList {} { # TODO: Handle IDNs (but Tcl overall gets that wrong at the moment...) variable ::http::cookiejar_domainlist - db eval { - CREATE TABLE IF NOT EXISTS forbidden ( - domain TEXT PRIMARY KEY); - CREATE TABLE IF NOT EXISTS forbiddenSuper ( - domain TEXT PRIMARY KEY); - CREATE TABLE IF NOT EXISTS permitted ( - domain TEXT PRIMARY KEY); - } log debug "loading domain list from $cookiejar_domainlist" set tok [http::geturl $cookiejar_domainlist] try { @@ -150,8 +151,8 @@ namespace eval ::http { } } - method GetCookiesForHostAndPath {*result secure host path fullhost} { - upvar 1 ${*result} result + method GetCookiesForHostAndPath {listVar secure host path fullhost} { + upvar 1 $listVar result log debug "check for cookies for [my RenderLocation $secure $host $path]" db eval { SELECT key, value FROM cookies @@ -185,7 +186,6 @@ namespace eval ::http { } method getCookies {proto host path} { - upvar 1 state state set result {} set paths [my SplitPath $path] set domains [my SplitDomain $host] @@ -263,7 +263,6 @@ namespace eval ::http { } method storeCookie {name val options} { - upvar 1 state state set now [clock seconds] db transaction { if {[my BadDomain $options]} { diff --git a/library/http/http.tcl b/library/http/http.tcl index 746603f..98ed71b 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1195,7 +1195,7 @@ proc http::ParseCookie {token value} { # Convert the options into a list before feeding into the cookie store; # ugly, but quite easy. - set realopts {persistent 0 hostonly 1 path / secure 0} + set realopts {persistent 0 hostonly 1 path / secure 0 httponly 0} dict set realopts origin $state(host) dict set realopts domain $state(host) foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { -- cgit v0.12 From 9e6f2e579a4491d2cbcb251d6b2f098210426be2 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 7 Sep 2012 07:13:44 +0000 Subject: improving the database, working towards a purging algorithm for session cookies --- library/http/cookiejar.tcl | 75 +++++++++++++++++++++++++++++----------------- 1 file changed, 48 insertions(+), 27 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 9a02834..20ed7a0 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -17,7 +17,11 @@ namespace eval ::http { upvar 0 ::http::cookiejar_loglevel loglevel set map {debug 0 info 1 warn 2 error 3} if {[string map $map $level] >= [string map $map $loglevel]} { - ::http::Log [string toupper $level]:cookiejar($origin):${msg} + set ms [clock milliseconds] + set ts [expr {$ms / 1000}] + set ms [format %03d [expr {$ms % 1000}]] + set t [clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1] + ::http::Log ${t}:[string toupper $level]:cookiejar($origin):${msg} } } method loglevel {{level "\u0000\u0000"}} { @@ -39,10 +43,11 @@ namespace eval ::http { sqlite3 [namespace current]::db $path db timeout 500 } - proc log {level msg} "::http::cookiejar log [list [self]] \$level \$msg" + proc log {level msg} \ + "::http::cookiejar log [list [self]] \$level \$msg" set deletions 0 db eval { - CREATE TABLE IF NOT EXISTS cookies ( + CREATE TABLE IF NOT EXISTS persistentCookies ( id INTEGER PRIMARY KEY, secure INTEGER NOT NULL, domain TEXT NOT NULL COLLATE NOCASE, @@ -50,10 +55,14 @@ namespace eval ::http { key TEXT NOT NULL, value TEXT NOT NULL, originonly INTEGER NOT NULL, - expiry INTEGER NOT NULL); - CREATE UNIQUE INDEX IF NOT EXISTS cookieUnique - ON cookies (secure, domain, path, key) + expiry INTEGER NOT NULL, + creation INTEGER NOT NULL); + CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique + ON persistentCookies (domain, path, key); + CREATE INDEX IF NOT EXISTS persistentLookup + ON persistentCookies (domain, path); } + ## TODO: Are there "TEMP INDEX"es? db eval { CREATE TEMP TABLE sessionCookies ( id INTEGER PRIMARY KEY, @@ -62,13 +71,17 @@ namespace eval ::http { path TEXT NOT NULL, key TEXT NOT NULL, originonly INTEGER NOT NULL, - value TEXT NOT NULL); + value TEXT NOT NULL, + lastuse INTEGER NOT NULL, + creation INTEGER NOT NULL); CREATE UNIQUE INDEX sessionUnique - ON sessionCookies (secure, domain, path, key) + ON sessionCookies (domain, path, key); + CREATE INDEX sessionLookup ON sessionCookies (domain, path); } + ## TODO: Consider creating a view db eval { - SELECT COUNT(*) AS cookieCount FROM cookies + SELECT COUNT(*) AS cookieCount FROM persistentCookies } if {[info exist cookieCount] && $cookieCount} { log info "loaded cookie store from $path with $cookieCount entries" @@ -155,18 +168,23 @@ namespace eval ::http { upvar 1 $listVar result log debug "check for cookies for [my RenderLocation $secure $host $path]" db eval { - SELECT key, value FROM cookies - WHERE secure <= $secure AND domain = $host AND path = $path + SELECT key, value FROM persistentCookies + WHERE domain = $host AND path = $path AND secure <= $secure AND (NOT originonly OR domain = $fullhost) - } cookie { - lappend result $cookie(key) $cookie(value) + } { + lappend result $key $value } + set now [clock seconds] db eval { - SELECT key, value FROM sessionCookies - WHERE secure <= $secure AND domain = $host AND path = $path + SELECT id, key, value FROM sessionCookies + WHERE domain = $host AND path = $path AND secure <= $secure AND (NOT originonly OR domain = $fullhost) - } cookie { - lappend result $cookie(key) $cookie(value) + } { + lappend result $key $value + ## FIXME: check syntax! + db eval { + UPDATE sessionCookies SET lastuse = $now WHERE id = $id + } } } @@ -250,13 +268,15 @@ namespace eval ::http { method DeleteCookie {secure domain path key} { db eval { - DELETE FROM cookies - WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key + DELETE FROM persistentCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure } set del [db changes] db eval { DELETE FROM sessionCookies - WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure } incr deletions [incr del [db changes]] log debug "deleted $del cookies for [my RenderLocation $secure $domain $path $key]" @@ -268,14 +288,15 @@ namespace eval ::http { if {[my BadDomain $options]} { return } + set now [clock seconds] dict with options {} if {!$persistent} { ### FIXME db eval { INSERT OR REPLACE INTO sessionCookies ( - secure, domain, path, key, value, originonly) - VALUES ($secure, $domain, $path, $key, $value, $hostonly); - DELETE FROM cookies + secure, domain, path, key, value, originonly, creation) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, $now); + DELETE FROM persistentCookies WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key } log debug "defined session cookie for [my RenderLocation $secure $domain $path $key]" @@ -284,9 +305,9 @@ namespace eval ::http { } else { ### FIXME db eval { - INSERT OR REPLACE INTO cookies ( - secure, domain, path, key, value, originonly, expiry) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires); + INSERT OR REPLACE INTO persistentCookies ( + secure, domain, path, key, value, originonly, expiry, creation) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires, $now); DELETE FROM sessionCookies WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key } @@ -301,7 +322,7 @@ namespace eval ::http { log debug "purging cookies that expired before [clock format $now]" db transaction { db eval { - DELETE FROM cookies WHERE expiry < $now + DELETE FROM persistentCookies WHERE expiry < $now } incr deletions [db changes] if {$deletions > 100} { -- cgit v0.12 From ee1f2a248415d2bef750da1b3622983c2432cc54 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 7 Sep 2012 10:35:14 +0000 Subject: More improvements --- library/http/cookiejar.tcl | 218 ++++++++++++++++++++++++++------------------- 1 file changed, 128 insertions(+), 90 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 20ed7a0..e11fce1 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -1,52 +1,97 @@ -package require Tcl 8.5 -package require TclOO -package require http 2.7;#2.8.4 +# Cookie Jar package. + +# Dependencies +package require Tcl 8.5;# FIXME: JUST DURING DEVELOPMENT +package require TclOO;# FIXME: JUST DURING DEVELOPMENT +package require http 2.7;# FIXME: JUST DURING DEVELOPMENT +#package require Tcl 8.6 +#package require http 2.8.4 package require sqlite3 +# Configuration for the cookiejar package namespace eval ::http { # TODO: is this the _right_ list of domains to use? variable cookiejar_domainlist \ http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 variable cookiejar_version 0.1 variable cookiejar_loglevel info -} + variable cookiejar_vacuumtrigger 200 + + # This is the class that we are creating + ::oo::class create cookiejar -::oo::class create ::http::cookiejar { - self { - method log {origin level msg} { + # Some support procedures, none particularly useful in general + namespace eval cookiejar_support { + namespace export * + proc locn {secure domain path {key ""}} { + if {$key eq ""} { + format "%s://%s%s" [expr {$secure?"https":"http"}] $domain $path + } else { + format "%s://%s%s?%s" \ + [expr {$secure?"https":"http"}] $domain $path $key + } + } + proc splitDomain domain { + set pieces [split $domain "."] + for {set i [llength $pieces]} {[incr i -1] >= 0} {} { + lappend result [join [lrange $pieces $i end] "."] + } + return $result + } + proc splitPath path { + set pieces [split [string trimleft $path "/"] "/"] + for {set j -1} {$j < [llength $pieces]} {incr j} { + lappend result /[join [lrange $pieces 0 $j] "/"] + } + return $result + } + proc isoNow {} { + set ms [clock milliseconds] + set ts [expr {$ms / 1000}] + set ms [format %03d [expr {$ms % 1000}]] + clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1 + } + proc log {level msg} { upvar 0 ::http::cookiejar_loglevel loglevel + set who [uplevel 1 self] set map {debug 0 info 1 warn 2 error 3} if {[string map $map $level] >= [string map $map $loglevel]} { - set ms [clock milliseconds] - set ts [expr {$ms / 1000}] - set ms [format %03d [expr {$ms % 1000}]] - set t [clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1] - ::http::Log ${t}:[string toupper $level]:cookiejar($origin):${msg} + ::http::Log "[isoNow] [string toupper $level] cookiejar($who) - ${msg}" } } - method loglevel {{level "\u0000\u0000"}} { - upvar 0 ::http::cookiejar_loglevel loglevel - if {$level in {debug info warn error}} { - set loglevel $level - } elseif {$level ne "\u0000\u0000"} { - return -code error "unknown log level \"$level\": must be debug, info, warn, or error" - } - return $loglevel + } +} + +# Now we have enough information to provide the package. +package provide cookiejar $::http::cookiejar_version + +# The implementation of the cookiejar package +::oo::define ::http::cookiejar { + self method loglevel {{level "\u0000\u0000"}} { + upvar 0 ::http::cookiejar_loglevel loglevel + if {$level in {debug info warn error}} { + set loglevel $level + } elseif {$level ne "\u0000\u0000"} { + return -code error "unknown log level \"$level\": must be debug, info, warn, or error" } + return $loglevel } variable aid deletions constructor {{path ""}} { + namespace import ::http::cookiejar_support::* + if {$path eq ""} { sqlite3 [namespace current]::db :memory: } else { sqlite3 [namespace current]::db $path db timeout 500 } - proc log {level msg} \ - "::http::cookiejar log [list [self]] \$level \$msg" + set deletions 0 db eval { + --;# Store the persistent cookies in this table. + --;# Deletion policy: once they expire, or if explicitly killed. CREATE TABLE IF NOT EXISTS persistentCookies ( id INTEGER PRIMARY KEY, secure INTEGER NOT NULL, @@ -58,12 +103,14 @@ namespace eval ::http { expiry INTEGER NOT NULL, creation INTEGER NOT NULL); CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique - ON persistentCookies (domain, path, key); + ON persistentCookies (domain, path, key); CREATE INDEX IF NOT EXISTS persistentLookup - ON persistentCookies (domain, path); - } - ## TODO: Are there "TEMP INDEX"es? - db eval { + ON persistentCookies (domain, path); + + --;# Store the session cookies in this table. + --;# Deletion policy: at cookiejar instance deletion, if + --;# explicitly killed, or if the number of session cookies is too + --;# large and the cookie has not been used recently. CREATE TEMP TABLE sessionCookies ( id INTEGER PRIMARY KEY, secure INTEGER NOT NULL, @@ -75,10 +122,19 @@ namespace eval ::http { lastuse INTEGER NOT NULL, creation INTEGER NOT NULL); CREATE UNIQUE INDEX sessionUnique - ON sessionCookies (domain, path, key); + ON sessionCookies (domain, path, key); CREATE INDEX sessionLookup ON sessionCookies (domain, path); + + --;# View to allow for simple looking up of a cookie. + CREATE TEMP VIEW cookies AS + SELECT id, domain, path, key, value, originonly, secure, + 1 AS persistent + FROM persistentCookies + UNION + SELECT id, domain, path, key, value, originonly, secure, + 0 AS persistent + FROM sessionCookies; } - ## TODO: Consider creating a view db eval { SELECT COUNT(*) AS cookieCount FROM persistentCookies @@ -91,10 +147,17 @@ namespace eval ::http { # TODO: domain list refresh policy db eval { + --;# Domains that may not have a cookie defined for them. CREATE TABLE IF NOT EXISTS forbidden ( domain TEXT PRIMARY KEY); + + --;# Domains that may not have a cookie defined for direct child + --;# domains of them. CREATE TABLE IF NOT EXISTS forbiddenSuper ( domain TEXT PRIMARY KEY); + + --;# Domains that *may* have a cookie defined for them, used to + --;# define exceptions for the forbiddenSuper table. CREATE TABLE IF NOT EXISTS permitted ( domain TEXT PRIMARY KEY); } @@ -155,18 +218,9 @@ namespace eval ::http { db close } - method RenderLocation {secure domain path {key ""}} { - if {$key eq ""} { - format "%s://%s%s" [expr {$secure?"https":"http"}] $domain $path - } else { - format "%s://%s%s?%s" \ - [expr {$secure?"https":"http"}] $domain $path $key - } - } - method GetCookiesForHostAndPath {listVar secure host path fullhost} { upvar 1 $listVar result - log debug "check for cookies for [my RenderLocation $secure $host $path]" + log debug "check for cookies for [locn $secure $host $path]" db eval { SELECT key, value FROM persistentCookies WHERE domain = $host AND path = $path AND secure <= $secure @@ -181,35 +235,19 @@ namespace eval ::http { AND (NOT originonly OR domain = $fullhost) } { lappend result $key $value - ## FIXME: check syntax! db eval { UPDATE sessionCookies SET lastuse = $now WHERE id = $id } } } - method SplitDomain domain { - set pieces [split $domain "."] - for {set i [llength $pieces]} {[incr i -1] >= 0} {} { - lappend result [join [lrange $pieces $i end] "."] - } - return $result - } - method SplitPath path { - set pieces [split [string trimleft $path "/"] "/"] - for {set j -1} {$j < [llength $pieces]} {incr j} { - lappend result /[join [lrange $pieces 0 $j] "/"] - } - return $result - } - method getCookies {proto host path} { set result {} - set paths [my SplitPath $path] - set domains [my SplitDomain $host] + set paths [splitPath $path] + set domains [splitDomain $host] set secure [string equal -nocase $proto "https"] # Open question: how to move these manipulations into the database - # engine (if that's where they *should* be) + # engine (if that's where they *should* be). # Suggestion from kbk: #LENGTH(theColumn) <= LENGTH($queryStr) AND SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr if {[regexp {[^0-9.]} $host]} { @@ -266,22 +304,6 @@ namespace eval ::http { return 0 } - method DeleteCookie {secure domain path key} { - db eval { - DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure - } - set del [db changes] - db eval { - DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure - } - incr deletions [incr del [db changes]] - log debug "deleted $del cookies for [my RenderLocation $secure $domain $path $key]" - } - method storeCookie {name val options} { set now [clock seconds] db transaction { @@ -291,32 +313,45 @@ namespace eval ::http { set now [clock seconds] dict with options {} if {!$persistent} { - ### FIXME db eval { INSERT OR REPLACE INTO sessionCookies ( - secure, domain, path, key, value, originonly, creation) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, $now); + secure, domain, path, key, value, originonly, creation, lastuse) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, $now, $now); DELETE FROM persistentCookies - WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key + WHERE domain = $domain AND path = $path AND key = $key AND secure <= $secure } - log debug "defined session cookie for [my RenderLocation $secure $domain $path $key]" + incr deletions [db changes] + log debug "defined session cookie for [locn $secure $domain $path $key]" } elseif {$expires < $now} { - my DeleteCookie $secure $domain $path $key + db eval { + DELETE FROM persistentCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure; + } + set del [db changes] + db eval { + DELETE FROM sessionCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure; + } + incr deletions [incr del [db changes]] + log debug "deleted $del cookies for [locn $secure $domain $path $key]" } else { - ### FIXME db eval { INSERT OR REPLACE INTO persistentCookies ( secure, domain, path, key, value, originonly, expiry, creation) VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires, $now); DELETE FROM sessionCookies - WHERE secure <= $secure AND domain = $domain AND path = $path AND key = $key + WHERE domain = $domain AND path = $path AND key = $key AND secure <= $secure } - log debug "defined persistent cookie for [my RenderLocation $secure $host $path $key], expires at [clock format $expires]" + incr deletions [db changes] + log debug "defined persistent cookie for [locn $secure $domain $path $key], expires at [clock format $expires]" } } } method PurgeCookies {} { + upvar 0 ::http::cookiejar_vacuumtrigger vacuumtrigger set aid [after 60000 [namespace current]::my PurgeCookies] set now [clock seconds] log debug "purging cookies that expired before [clock format $now]" @@ -325,19 +360,22 @@ namespace eval ::http { DELETE FROM persistentCookies WHERE expiry < $now } incr deletions [db changes] - if {$deletions > 100} { - set deletions 0 - log debug "vacuuming cookie database" + } + ### TODO: Cap the total number of cookies and session cookies, + ### purging least frequently used + + # Once we've deleted a fair bit, vacuum the database. Must be done + # outside a transaction. + if {$deletions > $vacuumtrigger} { + set deletions 0 + log debug "vacuuming cookie database" + catch { db eval { VACUUM } } } - ### TODO: Cap the total number of cookies and session cookies, - ### purging least frequently used } forward Database db } - -package provide cookiejar $::http::cookiejar_version -- cgit v0.12 From ef405dbe9cd32dfc4294ae138d66bbac63172a4b Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Sep 2012 12:02:38 +0000 Subject: working on handling punycoding of IDNAs --- library/http/cookiejar.tcl | 290 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 261 insertions(+), 29 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index e11fce1..605a621 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -13,6 +13,7 @@ namespace eval ::http { # TODO: is this the _right_ list of domains to use? variable cookiejar_domainlist \ http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 + # The list is directed to from http://publicsuffix.org/list/ variable cookiejar_version 0.1 variable cookiejar_loglevel info variable cookiejar_vacuumtrigger 200 @@ -59,6 +60,17 @@ namespace eval ::http { ::http::Log "[isoNow] [string toupper $level] cookiejar($who) - ${msg}" } } + proc IDNAencode str { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { + if {![string is ascii $part]} { + set part xn--[puny::encode $part] + } + lappend parts $part + } + return [join $parts .] + } } } @@ -147,26 +159,25 @@ package provide cookiejar $::http::cookiejar_version # TODO: domain list refresh policy db eval { - --;# Domains that may not have a cookie defined for them. - CREATE TABLE IF NOT EXISTS forbidden ( - domain TEXT PRIMARY KEY); + --;# Encoded domain permission policy; if forbidden is 1, no + --;# cookie may be ever set for the domain, and if forbidden is 0, + --;# cookies *may* be created for the domain (overriding the + --;# forbiddenSuper table). + CREATE TABLE IF NOT EXISTS domains ( + domain TEXT PRIMARY KEY NOT NULL, + forbidden INTEGER NOT NULL) --;# Domains that may not have a cookie defined for direct child --;# domains of them. CREATE TABLE IF NOT EXISTS forbiddenSuper ( domain TEXT PRIMARY KEY); - - --;# Domains that *may* have a cookie defined for them, used to - --;# define exceptions for the forbiddenSuper table. - CREATE TABLE IF NOT EXISTS permitted ( - domain TEXT PRIMARY KEY); } if {$path ne ""} { if {![db exists { SELECT 1 FROM sqlite_master - WHERE type='table' AND name='forbidden' + WHERE type='table' AND name='domains' }] && ![db exists { - SELECT 1 FROM forbidden + SELECT 1 FROM domains }]} then { my InitDomainList } @@ -186,21 +197,29 @@ package provide cookiejar $::http::cookiejar_version if {[string match //* $line]} continue if {[string match !* $line]} { set line [string range $line 1 end] + set idna [IDNAencode $line] db eval { - INSERT INTO permitted (domain) - VALUES ($line) + INSERT INTO domains (domain, forbidden) + VALUES ($line, 0); + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 0); } } else { if {[string match {\*.*} $line]} { set line [string range $line 2 end] db eval { INSERT INTO forbiddenSuper (domain) - VALUES ($line) + VALUES ($line); + INSERT OR REPLACE INTO forbiddenSuper (domain) + VALUES ($idna); } } + set idna [IDNAencode $line] db eval { - INSERT INTO forbidden (domain) - VALUES ($line) + INSERT INTO domains (domain, forbidden) + VALUES ($line, 1); + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 1); } } } @@ -284,22 +303,19 @@ package provide cookiejar $::http::cookiejar_version log warn "bad cookie: for a numeric address" return 1 } - if {[db exists { - SELECT 1 FROM permitted WHERE domain = $domain - }]} {return 0} - if {[db exists { - SELECT 1 FROM forbidden WHERE domain = $domain - }]} { - log warn "bad cookie: for a forbidden address" - return 1 - } - if {[regexp {^[^.]+\.(.+)$} $domain -> super]} { - if {[db exists { - SELECT 1 FROM forbiddenSuper WHERE domain = $super - }]} { + db eval { + SELECT forbidden FROM domains WHERE domain = $domain + } { + if {$forbidden} { log warn "bad cookie: for a forbidden address" - return 1 } + return $forbidden + } + if {[regexp {^[^.]+\.(.+)$} $domain -> super] && [db exists { + SELECT 1 FROM forbiddenSuper WHERE domain = $super + }]} then { + log warn "bad cookie: for a forbidden address" + return 1 } return 0 } @@ -379,3 +395,219 @@ package provide cookiejar $::http::cookiejar_version forward Database db } + +# The implementation of the puncode encoder. This is based on the code on +# http://wiki.tcl.tk/10501 but with extensive modifications to be faster when +# encoding. + +# TODO: This gets some strings wrong! + +namespace eval ::http::cookiejar_support::puny { + namespace export encode decode + + variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] + + # 3.2 Insertion unsort coding + proc insertionUnsort {splitstr extended} { + set oldchar 128 + set result {} + set oldindex -1 + foreach c $extended { + set index -1 + set pos -1 + set curlen 0 + foreach c2 $splitstr { + incr curlen [expr {$c2 < $c}] + } + scan $c "%c" char + set delta [expr {($curlen + 1) * ($char - $oldchar)}] + while true { + for {} {[incr pos] < [llength $splitstr]} {} { + set c2 [lindex $splitstr $pos] + if {$c2 eq $c} { + incr index + break + } elseif {$c2 < $c} { + incr index + } + } + if {$pos == [llength $splitstr]} { + set pos -1 + break + } + lappend result [expr {$delta + $index - $oldindex - 1}] + set oldindex $index + set delta 0 + } + set oldchar $char + } + return $result + } + + # Punycode parameters: tmin = 1, tmax = 26, base = 36 + proc T {j bias} { + return [expr {min(max(36 * ($j + 1) - $bias, 1), 26)}] + } + + # 3.3 Generalized variable-length integers + proc generateGeneralizedInteger {N bias} { + variable digits + set result {} + set j 0 + while true { + set t [T $j $bias] + if {$N < $t} { + return [lappend result [lindex $digits $N]] + } + lappend result [lindex $digits [expr {$t + (($N-$t) % (36-$t))}]] + set N [expr {int(($N-$t) / (36-$t))}] + incr j + } + } + + proc adapt {delta first numchars} { + if {$first} { + set delta [expr {int($delta / 700)}] + } else { + set delta [expr {int($delta / 2)}] + } + incr delta [expr {int($delta / $numchars)}] + set divisions 0 + while {$delta > 455} { + set delta [expr {int($delta / 35)}] + incr divisions 36 + } + return [expr {$divisions + int(36 * $delta / ($delta + 38))}] + } + + proc encode {text} { + set base {} + set extenders {} + set splitstr [split $text ""] + foreach c $splitstr { + if {$c < "\u0080"} { + append base $c + } else { + lappend extenders $c + } + } + set deltas [insertionUnsort $splitstr [lsort $extenders]] + + set result {} + set bias 72 + set points 0 + if {$base ne ""} { + set baselen [string length $base] + foreach delta $deltas { + lappend result {*}[generateGeneralizedInteger $delta $bias] + set bias [adapt $delta [expr {!$points}] \ + [expr {$baselen + [incr points]}]] + } + return $base-[join $result ""] + } else { + foreach delta $deltas { + lappend result {*}[generateGeneralizedInteger $delta $bias] + set bias [adapt $delta [expr {!$points}] [incr points]] + } + return [join $result ""] + } + } + + + # Decoding + proc toNums {text} { + set retval {} + foreach c [split $text ""] { + scan $c "%c" ch + lappend retval $ch + } + return $retval + } + + proc toChars {nums} { + set chars {} + foreach char $nums { + append chars [format "%c" $char] + } + return $chars + } + + # 3.3 Generalized variable-length integers + proc decodeGeneralizedNumber {extended extpos bias errors} { + set result 0 + set w 1 + set j 0 + while true { + set c [lindex $extended $extpos] + incr extpos + if {[string length $c] == 0} { + if {$errors eq "strict"} { + error "incomplete punicode string" + } + return [list $extpos -1] + } + if {[string match {[A-Z]} $c]} { + scan $c "%c" char + set digit [expr {$char - 65}] + } elseif {[string match {[0-9]} $c]} { + scan $c "%c" char + # 0x30-26 + set digit [expr {$char - 22}] + } elseif {$errors eq "strict"} { + set pos [lindex $extended $extpos] + error "Invalid extended code point '$pos'" + } else { + return [list $extpos -1] + } + set t [T $j $bias] + set result [expr {$result + $digit * $w}] + if {$digit < $t} { + return [list $extpos $result] + } + set w [expr {$w * (36 - $t)}] + incr j + } + } + + # 3.2 Insertion unsort coding + proc insertionSort {base extended errors} { + set char 128 + set pos -1 + set bias 72 + set extpos 0 + while {$extpos < [llength $extended]} { + lassign [decodeGeneralizedNumber $extended $extpos $bias $errors]\ + newpos delta + if {$delta < 0} { + # There was an error in decoding. We can't continue because + # synchronization is lost. + return $base + } + set pos [expr {$pos + $delta + 1}] + set char [expr {$char + int($pos / ([llength $base] + 1))}] + if {$char > 1114111} { + if {$errors eq "strict"} { + error [format "Invalid character U+%x" $char] + } + set char 63 ;# "?" + } + set pos [expr {$pos % ([llength $base] + 1)}] + set base [linsert $base $pos $char] + set bias [adapt $delta [expr {$extpos == 0}] [llength $base]] + set extpos $newpos + } + return $base + } + + proc decode {text {errors "lax"}} { + set base {} + set pos [string last "-" $text] + if {$pos == -1} { + set extended [split [string toupper $text] ""] + } else { + set base [toNums [string range $text 0 [expr {$pos-1}]]] + set extended [split [string toupper [string range $text [expr {$pos+1}] end]] ""] + } + return [toChars [insertionSort $base $extended $errors]] + } +} -- cgit v0.12 From 99359a48d9f24edccccf5deb2745b83fc6f278d9 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 10 Sep 2012 11:00:59 +0000 Subject: Now, a working punycode engine --- library/http/cookiejar.tcl | 255 ++++++++++++++++++++++++--------------------- 1 file changed, 137 insertions(+), 118 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 605a621..ad56e31 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -397,120 +397,132 @@ package provide cookiejar $::http::cookiejar_version } # The implementation of the puncode encoder. This is based on the code on -# http://wiki.tcl.tk/10501 but with extensive modifications to be faster when -# encoding. - -# TODO: This gets some strings wrong! +# http://tools.ietf.org/html/rfc3492 (encoder) and http://wiki.tcl.tk/10501 +# (decoder) but with extensive modifications. namespace eval ::http::cookiejar_support::puny { namespace export encode decode variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] + # Bootstring parameters for Punycode + variable base 36 + variable tmin 1 + variable tmax 26 + variable skew 38 + variable damp 700 + variable initial_bias 72 + variable initial_n 0x80 - # 3.2 Insertion unsort coding - proc insertionUnsort {splitstr extended} { - set oldchar 128 - set result {} - set oldindex -1 - foreach c $extended { - set index -1 - set pos -1 - set curlen 0 - foreach c2 $splitstr { - incr curlen [expr {$c2 < $c}] - } - scan $c "%c" char - set delta [expr {($curlen + 1) * ($char - $oldchar)}] - while true { - for {} {[incr pos] < [llength $splitstr]} {} { - set c2 [lindex $splitstr $pos] - if {$c2 eq $c} { - incr index - break - } elseif {$c2 < $c} { - incr index + proc adapt {delta first numchars} { + variable base + variable tmin + variable tmax + variable damp + variable skew + + set delta [expr {$delta / ($first ? $damp : 2)}] + incr delta [expr {$delta / $numchars}] + set k 0 + while {$delta > ($base - $tmin) * $tmax / 2} { + set delta [expr {$delta / ($base-$tmin)}] + incr k $base + } + return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}] + } + + # Main encode function + proc encode {input {case ""}} { + variable digits + variable tmin + variable tmax + variable base + variable initial_n + variable initial_bias + + set in [split $input ""] + set output {} + + # Initialize the state: + set n $initial_n + set delta 0 + set bias $initial_bias + + # Handle the basic code points: + foreach ch $in { + if {$ch < "\u0080"} { + if {$case ne ""} { + if {$case} { + append output [string toupper $ch] + } else { + append output [string tolower $ch] } + } else { + append output $ch } - if {$pos == [llength $splitstr]} { - set pos -1 - break - } - lappend result [expr {$delta + $index - $oldindex - 1}] - set oldindex $index - set delta 0 } - set oldchar $char } - return $result - } - # Punycode parameters: tmin = 1, tmax = 26, base = 36 - proc T {j bias} { - return [expr {min(max(36 * ($j + 1) - $bias, 1), 26)}] - } + set h [set b [string length $output]] - # 3.3 Generalized variable-length integers - proc generateGeneralizedInteger {N bias} { - variable digits - set result {} - set j 0 - while true { - set t [T $j $bias] - if {$N < $t} { - return [lappend result [lindex $digits $N]] - } - lappend result [lindex $digits [expr {$t + (($N-$t) % (36-$t))}]] - set N [expr {int(($N-$t) / (36-$t))}] - incr j - } - } + # h is the number of code points that have been handled, b is the + # number of basic code points. - proc adapt {delta first numchars} { - if {$first} { - set delta [expr {int($delta / 700)}] - } else { - set delta [expr {int($delta / 2)}] - } - incr delta [expr {int($delta / $numchars)}] - set divisions 0 - while {$delta > 455} { - set delta [expr {int($delta / 35)}] - incr divisions 36 + if {$b} { + append output "-" } - return [expr {$divisions + int(36 * $delta / ($delta + 38))}] - } - proc encode {text} { - set base {} - set extenders {} - set splitstr [split $text ""] - foreach c $splitstr { - if {$c < "\u0080"} { - append base $c - } else { - lappend extenders $c + # Main encoding loop: + + while {$h < [llength $in]} { + # All non-basic code points < n have been handled already. Find + # the next larger one: + + for {set m inf; set j 0} {$j < [llength $in]} {incr j} { + scan [lindex $in $j] "%c" ch + if {$ch >= $n && $ch < $m} { + set m $ch + } } - } - set deltas [insertionUnsort $splitstr [lsort $extenders]] - set result {} - set bias 72 - set points 0 - if {$base ne ""} { - set baselen [string length $base] - foreach delta $deltas { - lappend result {*}[generateGeneralizedInteger $delta $bias] - set bias [adapt $delta [expr {!$points}] \ - [expr {$baselen + [incr points]}]] + # Increase delta enough to advance the decoder's state to + # , but guard against overflow: + + if {$m-$n > (0xffffffff-$delta)/($h+1)} { + throw {PUNYCODE OVERFLOW} "overflow in delta computation" } - return $base-[join $result ""] - } else { - foreach delta $deltas { - lappend result {*}[generateGeneralizedInteger $delta $bias] - set bias [adapt $delta [expr {!$points}] [incr points]] + incr delta [expr {($m-$n) * ($h+1)}] + set n $m + + for {set j 0} {$j < [llength $in]} {incr j} { + scan [lindex $in $j] "%c" ch + if {$ch < $n && ([incr delta] & 0xffffffff) == 0} { + throw {PUNYCODE OVERFLOW} "overflow in delta computation" + } + + if {$ch == $n} { + # Represent delta as a generalized variable-length + # integer: + + for {set q $delta; set k $base} true {incr k $base} { + set t [expr {min(max($k-$bias,$tmin),$tmax)}] + if {$q < $t} break + append output \ + [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] + set q [expr {($q-$t) / ($base-$t)}] + } + + append output [lindex $digits $q] + set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] + set delta 0 + incr h + } } - return [join $result ""] + + incr delta + incr n } + + return $output } @@ -533,7 +545,11 @@ namespace eval ::http::cookiejar_support::puny { } # 3.3 Generalized variable-length integers - proc decodeGeneralizedNumber {extended extpos bias errors} { + proc decodeGeneralizedInteger {extended extpos bias errors} { + variable tmin + variable tmax + variable base + set result 0 set w 1 set j 0 @@ -546,68 +562,71 @@ namespace eval ::http::cookiejar_support::puny { } return [list $extpos -1] } + scan $c "%c" char if {[string match {[A-Z]} $c]} { - scan $c "%c" char - set digit [expr {$char - 65}] + set digit [expr {$char - 0x41}]; # A=0,Z=25 + } elseif {[string match {[a-z]} $c]} { + set digit [expr {$char - 0x61}]; # a=0,z=25 } elseif {[string match {[0-9]} $c]} { - scan $c "%c" char - # 0x30-26 - set digit [expr {$char - 22}] + set digit [expr {$char - 0x30 + 26}]; # 0=26,9=35 } elseif {$errors eq "strict"} { set pos [lindex $extended $extpos] error "Invalid extended code point '$pos'" } else { return [list $extpos -1] } - set t [T $j $bias] + set t [expr {min(max($base*($j + 1) - $bias, $tmin), $tmax)}] set result [expr {$result + $digit * $w}] if {$digit < $t} { return [list $extpos $result] } - set w [expr {$w * (36 - $t)}] + set w [expr {$w * ($base - $t)}] incr j } } # 3.2 Insertion unsort coding - proc insertionSort {base extended errors} { - set char 128 + proc insertionSort {buffer extended errors} { + variable initial_bias + variable initial_n + + set char $initial_n set pos -1 - set bias 72 + set bias $initial_bias set extpos 0 while {$extpos < [llength $extended]} { - lassign [decodeGeneralizedNumber $extended $extpos $bias $errors]\ + lassign [decodeGeneralizedInteger $extended $extpos $bias $errors]\ newpos delta if {$delta < 0} { # There was an error in decoding. We can't continue because # synchronization is lost. - return $base + return $buffer } - set pos [expr {$pos + $delta + 1}] - set char [expr {$char + int($pos / ([llength $base] + 1))}] + incr pos [expr {$delta + 1}] + set char [expr {$char + $pos / ([llength $buffer] + 1)}] if {$char > 1114111} { if {$errors eq "strict"} { error [format "Invalid character U+%x" $char] } set char 63 ;# "?" } - set pos [expr {$pos % ([llength $base] + 1)}] - set base [linsert $base $pos $char] - set bias [adapt $delta [expr {$extpos == 0}] [llength $base]] + set pos [expr {$pos % ([llength $buffer] + 1)}] + set buffer [linsert $buffer $pos $char] + set bias [adapt $delta [expr {$extpos == 0}] [llength $buffer]] set extpos $newpos } - return $base + return $buffer } proc decode {text {errors "lax"}} { - set base {} + set baseline {} set pos [string last "-" $text] if {$pos == -1} { - set extended [split [string toupper $text] ""] + set extended $text } else { - set base [toNums [string range $text 0 [expr {$pos-1}]]] - set extended [split [string toupper [string range $text [expr {$pos+1}] end]] ""] + set baseline [toNums [string range $text 0 [expr {$pos-1}]]] + set extended [string range $text [expr {$pos+1}] end] } - return [toChars [insertionSort $base $extended $errors]] + return [toChars [insertionSort $baseline [split $extended ""] $errors]] } } -- cgit v0.12 From 6f1a0f1c60d7c85d2e331d67a431a9306bab8c48 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 10 Sep 2012 21:24:34 +0000 Subject: loading of restricted domain list now believed to work --- library/http/cookiejar.tcl | 171 ++++++++++++++++++++------------ library/http/effective_tld_names.txt.gz | Bin 0 -> 32891 bytes 2 files changed, 110 insertions(+), 61 deletions(-) create mode 100644 library/http/effective_tld_names.txt.gz diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index ad56e31..be7b37f 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -7,16 +7,20 @@ package require http 2.7;# FIXME: JUST DURING DEVELOPMENT #package require Tcl 8.6 #package require http 2.8.4 package require sqlite3 +#package require zlib # Configuration for the cookiejar package namespace eval ::http { # TODO: is this the _right_ list of domains to use? variable cookiejar_domainlist \ http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 + variable cookiejar_domainfile \ + [file join [file dirname [info script]] effective_tld_names.txt] # The list is directed to from http://publicsuffix.org/list/ variable cookiejar_version 0.1 variable cookiejar_loglevel info variable cookiejar_vacuumtrigger 200 + variable cookiejar_offline false # This is the class that we are creating ::oo::class create cookiejar @@ -53,7 +57,7 @@ namespace eval ::http { clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1 } proc log {level msg} { - upvar 0 ::http::cookiejar_loglevel loglevel + namespace upvar ::http cookiejar_loglevel loglevel set who [uplevel 1 self] set map {debug 0 info 1 warn 2 error 3} if {[string map $map $level] >= [string map $map $loglevel]} { @@ -71,6 +75,17 @@ namespace eval ::http { } return [join $parts .] } + proc IDNAdecode str { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { + if {[string match "xn--*" $part]} { + set part [puny::decode [string range $part 4 end]] + } + lappend parts $part + } + return [join $parts .] + } } } @@ -80,7 +95,7 @@ package provide cookiejar $::http::cookiejar_version # The implementation of the cookiejar package ::oo::define ::http::cookiejar { self method loglevel {{level "\u0000\u0000"}} { - upvar 0 ::http::cookiejar_loglevel loglevel + namespace upvar ::http cookiejar_loglevel loglevel if {$level in {debug info warn error}} { set loglevel $level } elseif {$level ne "\u0000\u0000"} { @@ -165,70 +180,105 @@ package provide cookiejar $::http::cookiejar_version --;# forbiddenSuper table). CREATE TABLE IF NOT EXISTS domains ( domain TEXT PRIMARY KEY NOT NULL, - forbidden INTEGER NOT NULL) + forbidden INTEGER NOT NULL); --;# Domains that may not have a cookie defined for direct child --;# domains of them. CREATE TABLE IF NOT EXISTS forbiddenSuper ( domain TEXT PRIMARY KEY); } - if {$path ne ""} { - if {![db exists { - SELECT 1 FROM sqlite_master - WHERE type='table' AND name='domains' - }] && ![db exists { - SELECT 1 FROM domains - }]} then { - my InitDomainList - } + if {$path ne "" && ![db exists { + SELECT 1 FROM domains + }]} then { + my InitDomainList } } method InitDomainList {} { - # TODO: Handle IDNs (but Tcl overall gets that wrong at the moment...) - variable ::http::cookiejar_domainlist - log debug "loading domain list from $cookiejar_domainlist" - set tok [http::geturl $cookiejar_domainlist] + namespace upvar ::http \ + cookiejar_domainlist url \ + cookiejar_domainfile filename \ + cookiejar_offline offline + if {!$offline} { + log debug "loading domain list from $url" + set tok [::http::geturl $url] + try { + if {[::http::ncode $tok] == 200} { + my InstallDomainData [::http::data $tok] + return + } else { + log error "failed to fetch list of forbidden cookie domains from ${url}: [::http::error $tok]" + log warn "attempting to fall back to built in version" + } + } finally { + ::http::cleanup $tok + } + } + log debug "loading domain list from $filename" try { - if {[http::ncode $tok] == 200} { - db transaction { - foreach line [split [http::data $tok] \n] { - if {[string trim $line] eq ""} continue - if {[string match //* $line]} continue - if {[string match !* $line]} { - set line [string range $line 1 end] - set idna [IDNAencode $line] - db eval { - INSERT INTO domains (domain, forbidden) - VALUES ($line, 0); - INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($idna, 0); - } - } else { - if {[string match {\*.*} $line]} { - set line [string range $line 2 end] - db eval { - INSERT INTO forbiddenSuper (domain) - VALUES ($line); - INSERT OR REPLACE INTO forbiddenSuper (domain) - VALUES ($idna); - } - } - set idna [IDNAencode $line] - db eval { - INSERT INTO domains (domain, forbidden) - VALUES ($line, 1); - INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($idna, 1); - } + set f [open $filename] + try { + if {[string match *.gz $filename]} { + zlib push gunzip $f + } + fconfigure $f -encoding utf-8 + my InstallDomainData [read $f] + } finally { + close $f + } + } on error msg { + log error "failed to read list of forbidden cookie domains from ${filename}: $msg" + return -code error $msg + } + } + + method InstallDomainData {data} { + set n [db total_changes] + db transaction { + foreach line [split $data "\n"] { + if {[string trim $line] eq ""} continue + if {[string match //* $line]} continue + if {[string match !* $line]} { + set line [string range $line 1 end] + set idna [IDNAencode $line] + db eval { + INSERT INTO domains (domain, forbidden) + VALUES ($line, 0); + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 0); + } + } else { + if {[string match {\*.*} $line]} { + set line [string range $line 2 end] + db eval { + INSERT INTO forbiddenSuper (domain) + VALUES ($line); + INSERT OR REPLACE INTO forbiddenSuper (domain) + VALUES ($idna); } } + set idna [IDNAencode $line] + db eval { + INSERT INTO domains (domain, forbidden) + VALUES ($line, 1); + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 1); + } } - } else { - log error "failed to fetch list of forbidden cookie domains from $cookiejar_domainlist" } - } finally { - http::cleanup $tok + } + set n [expr {[db total_changes] - $n}] + log debug "processed $n inserts generated from domain list" + } + + # This forces the rebuild of the domain data, loading it from + method forceLoadDomainData {} { + db transaction { + db eval { + DELETE FROM domains; + DELETE FROM forbiddenSuper; + } + my InitDomainList } } @@ -367,7 +417,7 @@ package provide cookiejar $::http::cookiejar_version } method PurgeCookies {} { - upvar 0 ::http::cookiejar_vacuumtrigger vacuumtrigger + namespace upvar 0 ::http cookiejar_vacuumtrigger vacuumtrigger set aid [after 60000 [namespace current]::my PurgeCookies] set now [clock seconds] log debug "purging cookies that expired before [clock format $now]" @@ -488,7 +538,7 @@ namespace eval ::http::cookiejar_support::puny { # , but guard against overflow: if {$m-$n > (0xffffffff-$delta)/($h+1)} { - throw {PUNYCODE OVERFLOW} "overflow in delta computation" + error "overflow in delta computation" } incr delta [expr {($m-$n) * ($h+1)}] set n $m @@ -496,7 +546,7 @@ namespace eval ::http::cookiejar_support::puny { for {set j 0} {$j < [llength $in]} {incr j} { scan [lindex $in $j] "%c" ch if {$ch < $n && ([incr delta] & 0xffffffff) == 0} { - throw {PUNYCODE OVERFLOW} "overflow in delta computation" + error "overflow in delta computation" } if {$ch == $n} { @@ -525,7 +575,6 @@ namespace eval ::http::cookiejar_support::puny { return $output } - # Decoding proc toNums {text} { set retval {} @@ -590,7 +639,7 @@ namespace eval ::http::cookiejar_support::puny { variable initial_bias variable initial_n - set char $initial_n + set n $initial_n set pos -1 set bias $initial_bias set extpos 0 @@ -603,15 +652,15 @@ namespace eval ::http::cookiejar_support::puny { return $buffer } incr pos [expr {$delta + 1}] - set char [expr {$char + $pos / ([llength $buffer] + 1)}] - if {$char > 1114111} { + incr n [expr {$pos / ([llength $buffer] + 1)}] + if {$n > 1114111} { if {$errors eq "strict"} { - error [format "Invalid character U+%x" $char] + error [format "Invalid character U+%06x" $n] } - set char 63 ;# "?" + set n 63 ;# "?" } set pos [expr {$pos % ([llength $buffer] + 1)}] - set buffer [linsert $buffer $pos $char] + set buffer [linsert $buffer $pos $n] set bias [adapt $delta [expr {$extpos == 0}] [llength $buffer]] set extpos $newpos } diff --git a/library/http/effective_tld_names.txt.gz b/library/http/effective_tld_names.txt.gz new file mode 100644 index 0000000..a799d16 Binary files /dev/null and b/library/http/effective_tld_names.txt.gz differ -- cgit v0.12 From 52d39094e48a6c1b184d207d1e191266eaf1e0d0 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 11 Sep 2012 10:37:10 +0000 Subject: packing the code tighter, doing more explanatory comments --- library/http/cookiejar.tcl | 384 ++++++++++++++++++++++++++------------------- 1 file changed, 222 insertions(+), 162 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index be7b37f..c1e837c 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -1,5 +1,12 @@ -# Cookie Jar package. - +# cookiejar.tcl -- +# +# Implementation of an HTTP cookie storage engine using SQLite. The +# implementation is done as a TclOO class, and includes a punycode +# encoder and decoder (though only the encoder is currently used). +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + # Dependencies package require Tcl 8.5;# FIXME: JUST DURING DEVELOPMENT package require TclOO;# FIXME: JUST DURING DEVELOPMENT @@ -7,20 +14,26 @@ package require http 2.7;# FIXME: JUST DURING DEVELOPMENT #package require Tcl 8.6 #package require http 2.8.4 package require sqlite3 -#package require zlib + +# +# Configuration for the cookiejar package, plus basic support procedures. +# -# Configuration for the cookiejar package namespace eval ::http { + # Keep this in sync with pkgIndex.tcl and with the install directories in + # Makefiles + variable cookiejar_version 0.1 + # TODO: is this the _right_ list of domains to use? variable cookiejar_domainlist \ http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 variable cookiejar_domainfile \ [file join [file dirname [info script]] effective_tld_names.txt] # The list is directed to from http://publicsuffix.org/list/ - variable cookiejar_version 0.1 variable cookiejar_loglevel info variable cookiejar_vacuumtrigger 200 variable cookiejar_offline false + variable cookiejar_purgeinterval 60000 # This is the class that we are creating ::oo::class create cookiejar @@ -30,10 +43,12 @@ namespace eval ::http { namespace export * proc locn {secure domain path {key ""}} { if {$key eq ""} { - format "%s://%s%s" [expr {$secure?"https":"http"}] $domain $path + format "%s://%s%s" [expr {$secure?"https":"http"}] \ + [IDNAencode $domain] $path } else { format "%s://%s%s?%s" \ - [expr {$secure?"https":"http"}] $domain $path $key + [expr {$secure?"https":"http"}] [IDNAencode $domain] \ + $path $key } } proc splitDomain domain { @@ -107,6 +122,7 @@ package provide cookiejar $::http::cookiejar_version variable aid deletions constructor {{path ""}} { namespace import ::http::cookiejar_support::* + namespace upvar ::http cookiejar_purgeinterval purgeinterval if {$path eq ""} { sqlite3 [namespace current]::db :memory: @@ -161,32 +177,31 @@ package provide cookiejar $::http::cookiejar_version SELECT id, domain, path, key, value, originonly, secure, 0 AS persistent FROM sessionCookies; - } - - db eval { - SELECT COUNT(*) AS cookieCount FROM persistentCookies - } - if {[info exist cookieCount] && $cookieCount} { - log info "loaded cookie store from $path with $cookieCount entries" - } - set aid [after 60000 [namespace current]::my PurgeCookies] - - # TODO: domain list refresh policy - db eval { --;# Encoded domain permission policy; if forbidden is 1, no --;# cookie may be ever set for the domain, and if forbidden is 0, --;# cookies *may* be created for the domain (overriding the --;# forbiddenSuper table). + --;# Deletion policy: normally not modified. CREATE TABLE IF NOT EXISTS domains ( domain TEXT PRIMARY KEY NOT NULL, forbidden INTEGER NOT NULL); --;# Domains that may not have a cookie defined for direct child --;# domains of them. + --;# Deletion policy: normally not modified. CREATE TABLE IF NOT EXISTS forbiddenSuper ( domain TEXT PRIMARY KEY); } + + db eval { + SELECT COUNT(*) AS cookieCount FROM persistentCookies + } + log info "loaded cookie store from $path with $cookieCount entries" + + set aid [after $purgeinterval [namespace current]::my PurgeCookies] + + # TODO: domain list refresh policy if {$path ne "" && ![db exists { SELECT 1 FROM domains }]} then { @@ -236,35 +251,57 @@ package provide cookiejar $::http::cookiejar_version set n [db total_changes] db transaction { foreach line [split $data "\n"] { - if {[string trim $line] eq ""} continue - if {[string match //* $line]} continue - if {[string match !* $line]} { + if {[string trim $line] eq ""} { + continue + } elseif {[string match //* $line]} { + continue + } elseif {[string match !* $line]} { set line [string range $line 1 end] set idna [IDNAencode $line] + set utf [IDNAdecode $line] db eval { - INSERT INTO domains (domain, forbidden) - VALUES ($line, 0); INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($idna, 0); + VALUES ($utf, 0); + } + if {$idna ne $utf} { + db eval { + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 0); + } } } else { if {[string match {\*.*} $line]} { set line [string range $line 2 end] + set idna [IDNAencode $line] + set utf [IDNAdecode $line] db eval { - INSERT INTO forbiddenSuper (domain) - VALUES ($line); INSERT OR REPLACE INTO forbiddenSuper (domain) - VALUES ($idna); + VALUES ($utf); + } + if {$idna ne $utf} { + db eval { + INSERT OR REPLACE INTO forbiddenSuper (domain) + VALUES ($idna); + } } + } else { + set idna [IDNAencode $line] + set utf [IDNAdecode $line] } - set idna [IDNAencode $line] db eval { - INSERT INTO domains (domain, forbidden) - VALUES ($line, 1); INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($idna, 1); + VALUES ($utf, 1); + } + if {$idna ne $utf} { + db eval { + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 1); + } } } + if {$utf ne [IDNAdecode $idna]} { + log warn "mismatch in IDNA handling for $idna" + } } } set n [expr {[db total_changes] - $n}] @@ -313,13 +350,15 @@ package provide cookiejar $::http::cookiejar_version method getCookies {proto host path} { set result {} set paths [splitPath $path] - set domains [splitDomain $host] + set domains [splitDomain [IDNAencode $host]] set secure [string equal -nocase $proto "https"] # Open question: how to move these manipulations into the database # engine (if that's where they *should* be). # Suggestion from kbk: - #LENGTH(theColumn) <= LENGTH($queryStr) AND SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr + #LENGTH(theColumn) <= LENGTH($queryStr) AND + #SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr if {[regexp {[^0-9.]} $host]} { + # Ugh, it's a numeric domain! Restrict it... db transaction { foreach domain $domains { foreach p $paths { @@ -417,8 +456,10 @@ package provide cookiejar $::http::cookiejar_version } method PurgeCookies {} { - namespace upvar 0 ::http cookiejar_vacuumtrigger vacuumtrigger - set aid [after 60000 [namespace current]::my PurgeCookies] + namespace upvar ::http \ + cookiejar_vacuumtrigger trigger \ + cookiejar_purgeinterval interval + set aid [after $interval [namespace current]::my PurgeCookies] set now [clock seconds] log debug "purging cookies that expired before [clock format $now]" db transaction { @@ -432,7 +473,7 @@ package provide cookiejar $::http::cookiejar_version # Once we've deleted a fair bit, vacuum the database. Must be done # outside a transaction. - if {$deletions > $vacuumtrigger} { + if {$deletions > $trigger} { set deletions 0 log debug "vacuuming cookie database" catch { @@ -444,9 +485,44 @@ package provide cookiejar $::http::cookiejar_version } forward Database db + + method lookup {{host ""} {key ""}} { + set host [IDNAencode $host] + db transaction { + if {$host eq ""} { + set result {} + db eval { + SELECT DISTINCT domain FROM cookies + ORDER BY domain + } { + lappend result [IDNAdecode $domain] + } + return $result + } elseif {$key eq ""} { + set result {} + db eval { + SELECT DISTINCT key FROM cookies + WHERE domain = $host + ORDER BY key + } { + lappend result $key + } + return $result + } else { + db eval { + SELECT value FROM cookies + WHERE domain = $host AND key = $key + LIMIT 1 + } { + return $value + } + return -code error "no such key for that host" + } + } + } } -# The implementation of the puncode encoder. This is based on the code on +# The implementation of the punycode encoder. This is based on the code on # http://tools.ietf.org/html/rfc3492 (encoder) and http://wiki.tcl.tk/10501 # (decoder) but with extensive modifications. @@ -463,6 +539,10 @@ namespace eval ::http::cookiejar_support::puny { variable initial_bias 72 variable initial_n 0x80 + variable maxcodepoint 0xFFFF ;# 0x10FFFF would be correct, except Tcl + # can't handle non-BMP characters right now + # anyway. + proc adapt {delta first numchars} { variable base variable tmin @@ -489,7 +569,11 @@ namespace eval ::http::cookiejar_support::puny { variable initial_n variable initial_bias - set in [split $input ""] + set in {} + foreach char [set input [split $input ""]] { + scan $char "%c" ch + lappend in $ch + } set output {} # Initialize the state: @@ -498,37 +582,35 @@ namespace eval ::http::cookiejar_support::puny { set bias $initial_bias # Handle the basic code points: - foreach ch $in { + foreach ch $input { if {$ch < "\u0080"} { - if {$case ne ""} { - if {$case} { - append output [string toupper $ch] - } else { - append output [string tolower $ch] - } - } else { + if {$case eq ""} { append output $ch + } elseif {$case} { + append output [string toupper $ch] + } else { + append output [string tolower $ch] } } } - set h [set b [string length $output]] + set b [string length $output] # h is the number of code points that have been handled, b is the # number of basic code points. - if {$b} { + if {$b > 0} { append output "-" } # Main encoding loop: - while {$h < [llength $in]} { + for {set h $b} {$h < [llength $in]} {incr delta; incr n} { # All non-basic code points < n have been handled already. Find # the next larger one: - for {set m inf; set j 0} {$j < [llength $in]} {incr j} { - scan [lindex $in $j] "%c" ch + set m inf + foreach ch $in { if {$ch >= $n && $ch < $m} { set m $ch } @@ -538,144 +620,122 @@ namespace eval ::http::cookiejar_support::puny { # , but guard against overflow: if {$m-$n > (0xffffffff-$delta)/($h+1)} { - error "overflow in delta computation" + throw {PUNYCODE OVERFLOW} "overflow in delta computation" } incr delta [expr {($m-$n) * ($h+1)}] set n $m - for {set j 0} {$j < [llength $in]} {incr j} { - scan [lindex $in $j] "%c" ch + foreach ch $in { if {$ch < $n && ([incr delta] & 0xffffffff) == 0} { - error "overflow in delta computation" + throw {PUNYCODE OVERFLOW} "overflow in delta computation" + } + + if {$ch != $n} { + continue } - if {$ch == $n} { - # Represent delta as a generalized variable-length - # integer: + # Represent delta as a generalized variable-length integer: - for {set q $delta; set k $base} true {incr k $base} { - set t [expr {min(max($k-$bias,$tmin),$tmax)}] - if {$q < $t} break - append output \ - [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] - set q [expr {($q-$t) / ($base-$t)}] + for {set q $delta; set k $base} true {incr k $base} { + set t [expr {min(max($k-$bias, $tmin), $tmax)}] + if {$q < $t} { + break } - - append output [lindex $digits $q] - set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] - set delta 0 - incr h + append output \ + [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] + set q [expr {($q-$t) / ($base-$t)}] } - } - incr delta - incr n + append output [lindex $digits $q] + set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] + set delta 0 + incr h + } } return $output } - # Decoding - proc toNums {text} { - set retval {} - foreach c [split $text ""] { - scan $c "%c" ch - lappend retval $ch - } - return $retval - } + # Main decode function + proc decode {text {errors "lax"}} { + namespace upvar ::http::cookiejar_support::puny \ + tmin tmin tmax tmax base base initial_bias initial_bias \ + initial_n initial_n maxcodepoint maxcodepoint - proc toChars {nums} { - set chars {} - foreach char $nums { - append chars [format "%c" $char] - } - return $chars - } + set n $initial_n + set pos -1 + set bias $initial_bias + set buffer [set chars {}] + set pos [string last "-" $text] + if {$pos >= 0} { + set buffer [split [string range $text 0 [expr {$pos-1}]] ""] + set text [string range $text [expr {$pos+1}] end] + } + set points [split $text ""] + set first true + + for {set extpos 0} {$extpos < [llength $points]} {} { + # Extract the delta, which is the encoding of the character and + # where to insert it. + + set delta 0 + set w 1 + for {set j 1} true {incr j} { + scan [set c [lindex $points $extpos]] "%c" char + if {[string match {[A-Z]} $c]} { + set digit [expr {$char - 0x41}]; # A=0,Z=25 + } elseif {[string match {[a-z]} $c]} { + set digit [expr {$char - 0x61}]; # a=0,z=25 + } elseif {[string match {[0-9]} $c]} { + set digit [expr {$char - 0x30 + 26}]; # 0=26,9=35 + } else { + if {$errors eq "strict"} { + throw {PUNYCODE INVALID} \ + "invalid extended code point '$c'" + } + # There was an error in decoding. We can't continue + # because synchronization is lost. + return [join $buffer ""] + } - # 3.3 Generalized variable-length integers - proc decodeGeneralizedInteger {extended extpos bias errors} { - variable tmin - variable tmax - variable base + incr extpos + set t [expr {min(max($base*$j - $bias, $tmin), $tmax)}] + incr delta [expr {$digit * $w}] + if {$digit < $t} { + break + } + set w [expr {$w * ($base - $t)}] - set result 0 - set w 1 - set j 0 - while true { - set c [lindex $extended $extpos] - incr extpos - if {[string length $c] == 0} { - if {$errors eq "strict"} { - error "incomplete punicode string" + if {$extpos >= [llength $points]} { + if {$errors eq "strict"} { + throw {PUNYCODE PARTIAL} "incomplete punycode string" + } + # There was an error in decoding. We can't continue + # because synchronization is lost. + return [join $buffer ""] } - return [list $extpos -1] - } - scan $c "%c" char - if {[string match {[A-Z]} $c]} { - set digit [expr {$char - 0x41}]; # A=0,Z=25 - } elseif {[string match {[a-z]} $c]} { - set digit [expr {$char - 0x61}]; # a=0,z=25 - } elseif {[string match {[0-9]} $c]} { - set digit [expr {$char - 0x30 + 26}]; # 0=26,9=35 - } elseif {$errors eq "strict"} { - set pos [lindex $extended $extpos] - error "Invalid extended code point '$pos'" - } else { - return [list $extpos -1] - } - set t [expr {min(max($base*($j + 1) - $bias, $tmin), $tmax)}] - set result [expr {$result + $digit * $w}] - if {$digit < $t} { - return [list $extpos $result] } - set w [expr {$w * ($base - $t)}] - incr j - } - } - # 3.2 Insertion unsort coding - proc insertionSort {buffer extended errors} { - variable initial_bias - variable initial_n + # Now we've got the delta, we can generate the character and + # insert it. - set n $initial_n - set pos -1 - set bias $initial_bias - set extpos 0 - while {$extpos < [llength $extended]} { - lassign [decodeGeneralizedInteger $extended $extpos $bias $errors]\ - newpos delta - if {$delta < 0} { - # There was an error in decoding. We can't continue because - # synchronization is lost. - return $buffer - } - incr pos [expr {$delta + 1}] - incr n [expr {$pos / ([llength $buffer] + 1)}] - if {$n > 1114111} { + incr n [expr {[incr pos [expr {$delta+1}]]/([llength $buffer]+1)}] + if {$n > $maxcodepoint} { if {$errors eq "strict"} { - error [format "Invalid character U+%06x" $n] + if {$n < 0x10ffff} { + throw {PUNYCODE NON_BMP} \ + [format "unsupported character U+%06x" $n] + } + throw {PUNYCODE NON_UNICODE} "bad codepoint $n" } set n 63 ;# "?" + set extpos inf; # We're blowing up anyway... } set pos [expr {$pos % ([llength $buffer] + 1)}] - set buffer [linsert $buffer $pos $n] - set bias [adapt $delta [expr {$extpos == 0}] [llength $buffer]] - set extpos $newpos - } - return $buffer - } - - proc decode {text {errors "lax"}} { - set baseline {} - set pos [string last "-" $text] - if {$pos == -1} { - set extended $text - } else { - set baseline [toNums [string range $text 0 [expr {$pos-1}]]] - set extended [string range $text [expr {$pos+1}] end] + set buffer [linsert $buffer $pos [format "%c" $n]] + set bias [adapt $delta $first [llength $buffer]] + set first false } - return [toChars [insertionSort $baseline [split $extended ""] $errors]] + return [join $buffer ""] } } -- cgit v0.12 From 9bbbadaa5704ec79e853bc99a5ca3288810d4b26 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 17 Sep 2012 14:44:23 +0000 Subject: adapt to 8.6 environment properly; still some bugs... --- library/http/cookiejar.tcl | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index c1e837c..86df72b 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -8,11 +8,8 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Dependencies -package require Tcl 8.5;# FIXME: JUST DURING DEVELOPMENT -package require TclOO;# FIXME: JUST DURING DEVELOPMENT -package require http 2.7;# FIXME: JUST DURING DEVELOPMENT -#package require Tcl 8.6 -#package require http 2.8.4 +package require Tcl 8.6 +package require http 2.8.4 package require sqlite3 # @@ -40,6 +37,13 @@ namespace eval ::http { # Some support procedures, none particularly useful in general namespace eval cookiejar_support { + # Set up a logger if the http package isn't actually loaded yet. + if {![llength [info commands ::http::Log]]} { + proc ::http::Log args { + # Do nothing by default... + } + } + namespace export * proc locn {secure domain path {key ""}} { if {$key eq ""} { @@ -126,9 +130,11 @@ package provide cookiejar $::http::cookiejar_version if {$path eq ""} { sqlite3 [namespace current]::db :memory: + set storeorigin "constructed cookie store in memory" } else { sqlite3 [namespace current]::db $path db timeout 500 + set storeorigin "loaded cookie store from $path" } set deletions 0 @@ -194,10 +200,11 @@ package provide cookiejar $::http::cookiejar_version domain TEXT PRIMARY KEY); } + set cookieCount "no" db eval { SELECT COUNT(*) AS cookieCount FROM persistentCookies } - log info "loaded cookie store from $path with $cookieCount entries" + log info "$storeorigin with $cookieCount entries" set aid [after $purgeinterval [namespace current]::my PurgeCookies] @@ -300,7 +307,7 @@ package provide cookiejar $::http::cookiejar_version } } if {$utf ne [IDNAdecode $idna]} { - log warn "mismatch in IDNA handling for $idna" + log warn "mismatch in IDNA handling for $idna ($line, $utf, [IDNAdecode $idna])" } } } -- cgit v0.12 From ea1ff585006fc838c6cf0b75460da81cc60a806b Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Sep 2012 10:15:30 +0000 Subject: Fix the bugs in the punycode decoder --- library/http/cookiejar.tcl | 131 +++++++++++++++++++++++---------------------- library/http/pkgIndex.tcl | 2 +- 2 files changed, 68 insertions(+), 65 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 86df72b..4382176 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -21,11 +21,12 @@ namespace eval ::http { # Makefiles variable cookiejar_version 0.1 - # TODO: is this the _right_ list of domains to use? + # TODO: is this the _right_ list of domains to use? Or is there an alias + # for it that will persist longer? variable cookiejar_domainlist \ http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 variable cookiejar_domainfile \ - [file join [file dirname [info script]] effective_tld_names.txt] + [file join [file dirname [info script]] effective_tld_names.txt.gz] # The list is directed to from http://publicsuffix.org/list/ variable cookiejar_loglevel info variable cookiejar_vacuumtrigger 200 @@ -664,85 +665,87 @@ namespace eval ::http::cookiejar_support::puny { } # Main decode function - proc decode {text {errors "lax"}} { + proc decode {input} { namespace upvar ::http::cookiejar_support::puny \ tmin tmin tmax tmax base base initial_bias initial_bias \ initial_n initial_n maxcodepoint maxcodepoint + # Initialize the state: + set n $initial_n - set pos -1 + set i 0 + set first 1 set bias $initial_bias - set buffer [set chars {}] - set pos [string last "-" $text] - if {$pos >= 0} { - set buffer [split [string range $text 0 [expr {$pos-1}]] ""] - set text [string range $text [expr {$pos+1}] end] - } - set points [split $text ""] - set first true - - for {set extpos 0} {$extpos < [llength $points]} {} { - # Extract the delta, which is the encoding of the character and - # where to insert it. - - set delta 0 - set w 1 - for {set j 1} true {incr j} { - scan [set c [lindex $points $extpos]] "%c" char - if {[string match {[A-Z]} $c]} { - set digit [expr {$char - 0x41}]; # A=0,Z=25 - } elseif {[string match {[a-z]} $c]} { - set digit [expr {$char - 0x61}]; # a=0,z=25 - } elseif {[string match {[0-9]} $c]} { - set digit [expr {$char - 0x30 + 26}]; # 0=26,9=35 + + # Split the string into the "real" ASCII characters and the ones to + # feed into the main decoder. Note that we don't need to check the + # result of [regexp] because that RE will technically match any string + # at all. + + regexp {^(?:(.*)-)?([^-]*)$} $input input pre post + set output [split $pre ""] + set out [llength $output] + + # Main decoding loop: + + for {set in 0} {$in < [string length $post]} {incr in} { + # Decode a generalized variable-length integer into delta, which + # gets added to i. The overflow checking is easier if we increase + # i as we go, then subtract off its starting value at the end to + # obtain delta. + + for {set oldi $i; set w 1; set k $base} 1 {incr in} { + if {[set ch [string index $post $in]] eq ""} { + throw {PUNYCODE BAD_INPUT} "exceeded input data" + } + if {[string match -nocase {[a-z]} $ch]} { + scan [string toupper $ch] %c digit + incr digit -65 + } elseif {[string match {[0-9]} $ch]} { + set digit [expr {$ch + 26}] } else { - if {$errors eq "strict"} { - throw {PUNYCODE INVALID} \ - "invalid extended code point '$c'" - } - # There was an error in decoding. We can't continue - # because synchronization is lost. - return [join $buffer ""] + throw {PUNYCODE BAD_INPUT} "bad decode character \"$ch\"" } - - incr extpos - set t [expr {min(max($base*$j - $bias, $tmin), $tmax)}] - incr delta [expr {$digit * $w}] + incr i [expr {$digit * $w}] + set t [expr {min(max($tmin, $k-$bias), $tmax)}] if {$digit < $t} { + set bias [adapt [expr {$i-$oldi}] $first [incr out]] + set first 0 break } - set w [expr {$w * ($base - $t)}] - - if {$extpos >= [llength $points]} { - if {$errors eq "strict"} { - throw {PUNYCODE PARTIAL} "incomplete punycode string" - } - # There was an error in decoding. We can't continue - # because synchronization is lost. - return [join $buffer ""] + if {[set w [expr {$w * ($base - $t)}]] > 0x7fffffff} { + throw {PUNYCODE OVERFLOW} \ + "excessively large integer computed in digit decode" } + incr k $base } - # Now we've got the delta, we can generate the character and - # insert it. + # i was supposed to wrap around from out+1 to 0, incrementing n + # each time, so we'll fix that now: - incr n [expr {[incr pos [expr {$delta+1}]]/([llength $buffer]+1)}] - if {$n > $maxcodepoint} { - if {$errors eq "strict"} { - if {$n < 0x10ffff} { - throw {PUNYCODE NON_BMP} \ - [format "unsupported character U+%06x" $n] - } - throw {PUNYCODE NON_UNICODE} "bad codepoint $n" + if {[incr n [expr {$i / $out}]] > 0x7fffffff} { + throw {PUNYCODE OVERFLOW} \ + "excessively large integer computed in character choice" + } elseif {$n > $maxcodepoint} { + if {$n < 0x10ffff} { + throw {PUNYCODE NON_BMP} \ + [format "unsupported character U+%06x" $n] } - set n 63 ;# "?" - set extpos inf; # We're blowing up anyway... + throw {PUNYCODE NON_UNICODE} "bad codepoint $n" } - set pos [expr {$pos % ([llength $buffer] + 1)}] - set buffer [linsert $buffer $pos [format "%c" $n]] - set bias [adapt $delta $first [llength $buffer]] - set first false + set i [expr {$i % $out}] + + # Insert n at position i of the output: + + set output [linsert $output $i [format "%c" $n]] + incr i } - return [join $buffer ""] + + return [join $output ""] } } + +# Local variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 5ce5c37..142a52f 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,3 +1,3 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} package ifneeded http 2.8.4 [list tclPkgSetup $dir http 2.8.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] -package ifneeded cookiejar 0.1 [list tclPkgSetup $dir cookiejar 0.1 {{cookiejar.tcl source {::http::cookiejar}}}] +package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]] -- cgit v0.12 From 82abe83414b4ae3440752ac0fe18c1e21cb39ac7 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 10 Oct 2012 14:49:45 +0000 Subject: reorganize the code so that the IDNA procs live with the punycode procs; correct some misleading (and misleadingly-placed) comments --- library/http/cookiejar.tcl | 77 +++++++++++++++++++++++++++------------------- 1 file changed, 46 insertions(+), 31 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 4382176..a7691f5 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -84,28 +84,7 @@ namespace eval ::http { ::http::Log "[isoNow] [string toupper $level] cookiejar($who) - ${msg}" } } - proc IDNAencode str { - set parts {} - # Split term from RFC 3490, Sec 3.1 - foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { - if {![string is ascii $part]} { - set part xn--[puny::encode $part] - } - lappend parts $part - } - return [join $parts .] - } - proc IDNAdecode str { - set parts {} - # Split term from RFC 3490, Sec 3.1 - foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { - if {[string match "xn--*" $part]} { - set part [puny::decode [string range $part 4 end]] - } - lappend parts $part - } - return [join $parts .] - } + namespace import ::http::cookiejar_support::puny::IDNA* } } @@ -362,11 +341,15 @@ package provide cookiejar $::http::cookiejar_version set secure [string equal -nocase $proto "https"] # Open question: how to move these manipulations into the database # engine (if that's where they *should* be). + # # Suggestion from kbk: #LENGTH(theColumn) <= LENGTH($queryStr) AND #SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr + # + # However, we instead do most of the work in Tcl because that lets us + # do the splitting exactly right, and it's far easier to work with + # strings in Tcl than in SQL. if {[regexp {[^0-9.]} $host]} { - # Ugh, it's a numeric domain! Restrict it... db transaction { foreach domain $domains { foreach p $paths { @@ -375,6 +358,7 @@ package provide cookiejar $::http::cookiejar_version } } } else { + # Ugh, it's a numeric domain! Restrict it... db transaction { foreach p $paths { my GetCookiesForHostAndPath result $secure $host $p $host @@ -530,12 +514,43 @@ package provide cookiejar $::http::cookiejar_version } } -# The implementation of the punycode encoder. This is based on the code on -# http://tools.ietf.org/html/rfc3492 (encoder) and http://wiki.tcl.tk/10501 -# (decoder) but with extensive modifications. +# The implementation of the punycode encoder. This is based on the code in +# Appendix C of http://tools.ietf.org/html/rfc3492 but with substantial +# modifications so that it is Tcl code. namespace eval ::http::cookiejar_support::puny { - namespace export encode decode + namespace export IDNAencode punyencode IDNAdecode punydecode + + proc IDNAencode str { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { + if {[regexp {[^-A-Za-z0-9]} $part]} { + if {[regexp {[^-A-Za-z0-9\u0100-\uffff]} $part ch]} { + scan $ch %c c + if {$ch < "!" || $ch > "~"} { + set ch [format "\\u%04x" $c] + } + throw [list IDNA INVALID_NAME_CHARACTER $c] \ + "bad character \"$ch\" in DNS name" + } + set part xn--[punyencode $part] + } + lappend parts $part + } + return [join $parts .] + } + proc IDNAdecode str { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { + if {[string match "xn--*" $part]} { + set part [punydecode [string range $part 4 end]] + } + lappend parts $part + } + return [join $parts .] + } variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] # Bootstring parameters for Punycode @@ -568,8 +583,8 @@ namespace eval ::http::cookiejar_support::puny { return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}] } - # Main encode function - proc encode {input {case ""}} { + # Main punycode encoding function + proc punyencode {input {case ""}} { variable digits variable tmin variable tmax @@ -664,8 +679,8 @@ namespace eval ::http::cookiejar_support::puny { return $output } - # Main decode function - proc decode {input} { + # Main punycode decode function + proc punydecode {input} { namespace upvar ::http::cookiejar_support::puny \ tmin tmin tmax tmax base base initial_bias initial_bias \ initial_n initial_n maxcodepoint maxcodepoint -- cgit v0.12 From 2edb721609c87465b723338e7be4db853faf72be Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 12 Oct 2012 13:18:24 +0000 Subject: separating out the IDNA handling code --- library/http/cookiejar.tcl | 336 +++++++-------------------------------------- library/http/idna.tcl | 283 ++++++++++++++++++++++++++++++++++++++ library/http/pkgIndex.tcl | 1 + 3 files changed, 333 insertions(+), 287 deletions(-) create mode 100644 library/http/idna.tcl diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index a7691f5..5fa6eb2 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -11,6 +11,7 @@ package require Tcl 8.6 package require http 2.8.4 package require sqlite3 +package require tcl::idna 1.0 # # Configuration for the cookiejar package, plus basic support procedures. @@ -49,10 +50,10 @@ namespace eval ::http { proc locn {secure domain path {key ""}} { if {$key eq ""} { format "%s://%s%s" [expr {$secure?"https":"http"}] \ - [IDNAencode $domain] $path + [tcl::idna encode $domain] $path } else { format "%s://%s%s?%s" \ - [expr {$secure?"https":"http"}] [IDNAencode $domain] \ + [expr {$secure?"https":"http"}] [tcl::idna encode $domain] \ $path $key } } @@ -195,27 +196,24 @@ package provide cookiejar $::http::cookiejar_version my InitDomainList } } - - method InitDomainList {} { - namespace upvar ::http \ - cookiejar_domainlist url \ - cookiejar_domainfile filename \ - cookiejar_offline offline - if {!$offline} { - log debug "loading domain list from $url" - set tok [::http::geturl $url] - try { - if {[::http::ncode $tok] == 200} { - my InstallDomainData [::http::data $tok] - return - } else { - log error "failed to fetch list of forbidden cookie domains from ${url}: [::http::error $tok]" - log warn "attempting to fall back to built in version" - } - } finally { - ::http::cleanup $tok + + method GetDomainListOnline {} { + upvar 0 ::http::cookiejar_domainlist url + log debug "loading domain list from $url" + set tok [::http::geturl $url] + try { + if {[::http::ncode $tok] == 200} { + return [::http::data $tok] + } else { + log error "failed to fetch list of forbidden cookie domains from ${url}: [::http::error $tok]" + return {} } + } finally { + ::http::cleanup $tok } + } + method GetDomainListOffline {} { + upvar 0 ::http::cookiejar_domainfile filename log debug "loading domain list from $filename" try { set f [open $filename] @@ -224,15 +222,27 @@ package provide cookiejar $::http::cookiejar_version zlib push gunzip $f } fconfigure $f -encoding utf-8 - my InstallDomainData [read $f] + return [read $f] } finally { close $f } - } on error msg { + } on error {msg opt} { log error "failed to read list of forbidden cookie domains from ${filename}: $msg" - return -code error $msg + return -options $opt $msg } } + method InitDomainList {} { + upvar 0 ::http::cookiejar_offline offline + if {!$offline} { + set data [my GetDomainListOnline] + if {[string length $data]} { + my InstallDomainData $data + return + } + log warn "attempting to fall back to built in version" + } + my InstallDomainData [my GetDomainListOffline] + } method InstallDomainData {data} { set n [db total_changes] @@ -244,8 +254,8 @@ package provide cookiejar $::http::cookiejar_version continue } elseif {[string match !* $line]} { set line [string range $line 1 end] - set idna [IDNAencode $line] - set utf [IDNAdecode $line] + set idna [string tolower [tcl::idna encode $line]] + set utf [tcl::idna decode [string tolower $line]] db eval { INSERT OR REPLACE INTO domains (domain, forbidden) VALUES ($utf, 0); @@ -259,8 +269,8 @@ package provide cookiejar $::http::cookiejar_version } else { if {[string match {\*.*} $line]} { set line [string range $line 2 end] - set idna [IDNAencode $line] - set utf [IDNAdecode $line] + set idna [string tolower [tcl::idna encode $line]] + set utf [tcl::idna decode [string tolower $line]] db eval { INSERT OR REPLACE INTO forbiddenSuper (domain) VALUES ($utf); @@ -272,8 +282,8 @@ package provide cookiejar $::http::cookiejar_version } } } else { - set idna [IDNAencode $line] - set utf [IDNAdecode $line] + set idna [string tolower [tcl::idna encode $line]] + set utf [tcl::idna decode [string tolower $line]] } db eval { INSERT OR REPLACE INTO domains (domain, forbidden) @@ -286,8 +296,8 @@ package provide cookiejar $::http::cookiejar_version } } } - if {$utf ne [IDNAdecode $idna]} { - log warn "mismatch in IDNA handling for $idna ($line, $utf, [IDNAdecode $idna])" + if {$utf ne [tcl::idna decode [string tolower $idna]]} { + log warn "mismatch in IDNA handling for $idna ($line, $utf, [tcl::idna decode $idna])" } } } @@ -337,7 +347,7 @@ package provide cookiejar $::http::cookiejar_version method getCookies {proto host path} { set result {} set paths [splitPath $path] - set domains [splitDomain [IDNAencode $host]] + set domains [splitDomain [string tolower [tcl::idna encode $host]]] set secure [string equal -nocase $proto "https"] # Open question: how to move these manipulations into the database # engine (if that's where they *should* be). @@ -349,17 +359,15 @@ package provide cookiejar $::http::cookiejar_version # However, we instead do most of the work in Tcl because that lets us # do the splitting exactly right, and it's far easier to work with # strings in Tcl than in SQL. - if {[regexp {[^0-9.]} $host]} { - db transaction { + db transaction { + if {[regexp {[^0-9.]} $host]} { foreach domain $domains { foreach p $paths { my GetCookiesForHostAndPath result $secure $domain $p $host } } - } - } else { - # Ugh, it's a numeric domain! Restrict it... - db transaction { + } else { + # Ugh, it's a numeric domain! Restrict it... foreach p $paths { my GetCookiesForHostAndPath result $secure $host $p $host } @@ -479,7 +487,7 @@ package provide cookiejar $::http::cookiejar_version forward Database db method lookup {{host ""} {key ""}} { - set host [IDNAencode $host] + set host [string tolower [tcl::idna encode $host]] db transaction { if {$host eq ""} { set result {} @@ -487,7 +495,7 @@ package provide cookiejar $::http::cookiejar_version SELECT DISTINCT domain FROM cookies ORDER BY domain } { - lappend result [IDNAdecode $domain] + lappend result [tcl::idna decode [string tolower $domain]] } return $result } elseif {$key eq ""} { @@ -514,252 +522,6 @@ package provide cookiejar $::http::cookiejar_version } } -# The implementation of the punycode encoder. This is based on the code in -# Appendix C of http://tools.ietf.org/html/rfc3492 but with substantial -# modifications so that it is Tcl code. - -namespace eval ::http::cookiejar_support::puny { - namespace export IDNAencode punyencode IDNAdecode punydecode - - proc IDNAencode str { - set parts {} - # Split term from RFC 3490, Sec 3.1 - foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { - if {[regexp {[^-A-Za-z0-9]} $part]} { - if {[regexp {[^-A-Za-z0-9\u0100-\uffff]} $part ch]} { - scan $ch %c c - if {$ch < "!" || $ch > "~"} { - set ch [format "\\u%04x" $c] - } - throw [list IDNA INVALID_NAME_CHARACTER $c] \ - "bad character \"$ch\" in DNS name" - } - set part xn--[punyencode $part] - } - lappend parts $part - } - return [join $parts .] - } - proc IDNAdecode str { - set parts {} - # Split term from RFC 3490, Sec 3.1 - foreach part [split $str "\u002E\u3002\uFF0E\uFF61"] { - if {[string match "xn--*" $part]} { - set part [punydecode [string range $part 4 end]] - } - lappend parts $part - } - return [join $parts .] - } - - variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] - # Bootstring parameters for Punycode - variable base 36 - variable tmin 1 - variable tmax 26 - variable skew 38 - variable damp 700 - variable initial_bias 72 - variable initial_n 0x80 - - variable maxcodepoint 0xFFFF ;# 0x10FFFF would be correct, except Tcl - # can't handle non-BMP characters right now - # anyway. - - proc adapt {delta first numchars} { - variable base - variable tmin - variable tmax - variable damp - variable skew - - set delta [expr {$delta / ($first ? $damp : 2)}] - incr delta [expr {$delta / $numchars}] - set k 0 - while {$delta > ($base - $tmin) * $tmax / 2} { - set delta [expr {$delta / ($base-$tmin)}] - incr k $base - } - return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}] - } - - # Main punycode encoding function - proc punyencode {input {case ""}} { - variable digits - variable tmin - variable tmax - variable base - variable initial_n - variable initial_bias - - set in {} - foreach char [set input [split $input ""]] { - scan $char "%c" ch - lappend in $ch - } - set output {} - - # Initialize the state: - set n $initial_n - set delta 0 - set bias $initial_bias - - # Handle the basic code points: - foreach ch $input { - if {$ch < "\u0080"} { - if {$case eq ""} { - append output $ch - } elseif {$case} { - append output [string toupper $ch] - } else { - append output [string tolower $ch] - } - } - } - - set b [string length $output] - - # h is the number of code points that have been handled, b is the - # number of basic code points. - - if {$b > 0} { - append output "-" - } - - # Main encoding loop: - - for {set h $b} {$h < [llength $in]} {incr delta; incr n} { - # All non-basic code points < n have been handled already. Find - # the next larger one: - - set m inf - foreach ch $in { - if {$ch >= $n && $ch < $m} { - set m $ch - } - } - - # Increase delta enough to advance the decoder's state to - # , but guard against overflow: - - if {$m-$n > (0xffffffff-$delta)/($h+1)} { - throw {PUNYCODE OVERFLOW} "overflow in delta computation" - } - incr delta [expr {($m-$n) * ($h+1)}] - set n $m - - foreach ch $in { - if {$ch < $n && ([incr delta] & 0xffffffff) == 0} { - throw {PUNYCODE OVERFLOW} "overflow in delta computation" - } - - if {$ch != $n} { - continue - } - - # Represent delta as a generalized variable-length integer: - - for {set q $delta; set k $base} true {incr k $base} { - set t [expr {min(max($k-$bias, $tmin), $tmax)}] - if {$q < $t} { - break - } - append output \ - [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] - set q [expr {($q-$t) / ($base-$t)}] - } - - append output [lindex $digits $q] - set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] - set delta 0 - incr h - } - } - - return $output - } - - # Main punycode decode function - proc punydecode {input} { - namespace upvar ::http::cookiejar_support::puny \ - tmin tmin tmax tmax base base initial_bias initial_bias \ - initial_n initial_n maxcodepoint maxcodepoint - - # Initialize the state: - - set n $initial_n - set i 0 - set first 1 - set bias $initial_bias - - # Split the string into the "real" ASCII characters and the ones to - # feed into the main decoder. Note that we don't need to check the - # result of [regexp] because that RE will technically match any string - # at all. - - regexp {^(?:(.*)-)?([^-]*)$} $input input pre post - set output [split $pre ""] - set out [llength $output] - - # Main decoding loop: - - for {set in 0} {$in < [string length $post]} {incr in} { - # Decode a generalized variable-length integer into delta, which - # gets added to i. The overflow checking is easier if we increase - # i as we go, then subtract off its starting value at the end to - # obtain delta. - - for {set oldi $i; set w 1; set k $base} 1 {incr in} { - if {[set ch [string index $post $in]] eq ""} { - throw {PUNYCODE BAD_INPUT} "exceeded input data" - } - if {[string match -nocase {[a-z]} $ch]} { - scan [string toupper $ch] %c digit - incr digit -65 - } elseif {[string match {[0-9]} $ch]} { - set digit [expr {$ch + 26}] - } else { - throw {PUNYCODE BAD_INPUT} "bad decode character \"$ch\"" - } - incr i [expr {$digit * $w}] - set t [expr {min(max($tmin, $k-$bias), $tmax)}] - if {$digit < $t} { - set bias [adapt [expr {$i-$oldi}] $first [incr out]] - set first 0 - break - } - if {[set w [expr {$w * ($base - $t)}]] > 0x7fffffff} { - throw {PUNYCODE OVERFLOW} \ - "excessively large integer computed in digit decode" - } - incr k $base - } - - # i was supposed to wrap around from out+1 to 0, incrementing n - # each time, so we'll fix that now: - - if {[incr n [expr {$i / $out}]] > 0x7fffffff} { - throw {PUNYCODE OVERFLOW} \ - "excessively large integer computed in character choice" - } elseif {$n > $maxcodepoint} { - if {$n < 0x10ffff} { - throw {PUNYCODE NON_BMP} \ - [format "unsupported character U+%06x" $n] - } - throw {PUNYCODE NON_UNICODE} "bad codepoint $n" - } - set i [expr {$i % $out}] - - # Insert n at position i of the output: - - set output [linsert $output $i [format "%c" $n]] - incr i - } - - return [join $output ""] - } -} - # Local variables: # mode: tcl # fill-column: 78 diff --git a/library/http/idna.tcl b/library/http/idna.tcl new file mode 100644 index 0000000..7727e45 --- /dev/null +++ b/library/http/idna.tcl @@ -0,0 +1,283 @@ +# cookiejar.tcl -- +# +# Implementation of IDNA (Internationalized Domain Names for +# Applications) encoding/decoding system, built on a punycode engine +# developed directly from the code in RFC 3492, Appendix C (with +# substantial modifications). +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +namespace eval ::tcl::idna { + namespace ensemble create -command puny -map { + encode punyencode + decode punydecode + } + namespace ensemble create -command ::tcl::idna -map { + encode IDNAencode + decode IDNAdecode + puny puny + version {::package present idna} + } + + proc IDNAencode hostname { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { + if {[regexp {[^-A-Za-z0-9]} $part]} { + if {[regexp {[^-A-Za-z0-9\u0100-\uffff]} $part ch]} { + scan $ch %c c + if {$ch < "!" || $ch > "~"} { + set ch [format "\\u%04x" $c] + } + throw [list IDNA INVALID_NAME_CHARACTER $c] \ + "bad character \"$ch\" in DNS name" + } + set part xn--[punyencode $part] + } + lappend parts $part + } + return [join $parts .] + } + proc IDNAdecode hostname { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { + if {[string match "xn--*" $part]} { + set part [punydecode [string range $part 4 end]] + } + lappend parts $part + } + return [join $parts .] + } + + variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] + # Bootstring parameters for Punycode + variable base 36 + variable tmin 1 + variable tmax 26 + variable skew 38 + variable damp 700 + variable initial_bias 72 + variable initial_n 0x80 + + variable max_codepoint 0xFFFF ;# 0x10FFFF would be correct, except Tcl + # can't handle non-BMP characters right now + # anyway. + + proc adapt {delta first numchars} { + variable base + variable tmin + variable tmax + variable damp + variable skew + + set delta [expr {$delta / ($first ? $damp : 2)}] + incr delta [expr {$delta / $numchars}] + set k 0 + while {$delta > ($base - $tmin) * $tmax / 2} { + set delta [expr {$delta / ($base-$tmin)}] + incr k $base + } + return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}] + } + + # Main punycode encoding function + proc punyencode {string {case ""}} { + variable digits + variable tmin + variable tmax + variable base + variable initial_n + variable initial_bias + + if {![string is boolean $case]} { + return -code error "\"$case\" must be boolean" + } + + set in {} + foreach char [set string [split $string ""]] { + scan $char "%c" ch + lappend in $ch + } + set output {} + + # Initialize the state: + set n $initial_n + set delta 0 + set bias $initial_bias + + # Handle the basic code points: + foreach ch $string { + if {$ch < "\u0080"} { + if {$case eq ""} { + append output $ch + } elseif {[string is true $case]} { + append output [string toupper $ch] + } elseif {[string is false $case]} { + append output [string tolower $ch] + } + } + } + + set b [string length $output] + + # h is the number of code points that have been handled, b is the + # number of basic code points. + + if {$b > 0} { + append output "-" + } + + # Main encoding loop: + + for {set h $b} {$h < [llength $in]} {incr delta; incr n} { + # All non-basic code points < n have been handled already. Find + # the next larger one: + + set m inf + foreach ch $in { + if {$ch >= $n && $ch < $m} { + set m $ch + } + } + + # Increase delta enough to advance the decoder's state to + # , but guard against overflow: + + if {$m-$n > (0xffffffff-$delta)/($h+1)} { + throw {PUNYCODE OVERFLOW} "overflow in delta computation" + } + incr delta [expr {($m-$n) * ($h+1)}] + set n $m + + foreach ch $in { + if {$ch < $n && ([incr delta] & 0xffffffff) == 0} { + throw {PUNYCODE OVERFLOW} "overflow in delta computation" + } + + if {$ch != $n} { + continue + } + + # Represent delta as a generalized variable-length integer: + + for {set q $delta; set k $base} true {incr k $base} { + set t [expr {min(max($k-$bias, $tmin), $tmax)}] + if {$q < $t} { + break + } + append output \ + [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] + set q [expr {($q-$t) / ($base-$t)}] + } + + append output [lindex $digits $q] + set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] + set delta 0 + incr h + } + } + + return $output + } + + # Main punycode decode function + proc punydecode {string {case ""}} { + variable tmin + variable tmax + variable base + variable initial_n + variable initial_bias + variable max_codepoint + + if {![string is boolean $case]} { + return -code error "\"$case\" must be boolean" + } + + # Initialize the state: + + set n $initial_n + set i 0 + set first 1 + set bias $initial_bias + + # Split the string into the "real" ASCII characters and the ones to + # feed into the main decoder. Note that we don't need to check the + # result of [regexp] because that RE will technically match any string + # at all. + + regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post + if {[string is true -strict $case]} { + set pre [string toupper $pre] + } elseif {[string is false -strict $case]} { + set pre [string tolower $pre] + } + set output [split $pre ""] + set out [llength $output] + + # Main decoding loop: + + for {set in 0} {$in < [string length $post]} {incr in} { + # Decode a generalized variable-length integer into delta, which + # gets added to i. The overflow checking is easier if we increase + # i as we go, then subtract off its starting value at the end to + # obtain delta. + + for {set oldi $i; set w 1; set k $base} 1 {incr in} { + if {[set ch [string index $post $in]] eq ""} { + throw {PUNYCODE BAD_INPUT} "exceeded input data" + } + if {[string match -nocase {[a-z]} $ch]} { + scan [string toupper $ch] %c digit + incr digit -65 + } elseif {[string match {[0-9]} $ch]} { + set digit [expr {$ch + 26}] + } else { + throw {PUNYCODE BAD_INPUT} "bad decode character \"$ch\"" + } + incr i [expr {$digit * $w}] + set t [expr {min(max($tmin, $k-$bias), $tmax)}] + if {$digit < $t} { + set bias [adapt [expr {$i-$oldi}] $first [incr out]] + set first 0 + break + } + if {[set w [expr {$w * ($base - $t)}]] > 0x7fffffff} { + throw {PUNYCODE OVERFLOW} \ + "excessively large integer computed in digit decode" + } + incr k $base + } + + # i was supposed to wrap around from out+1 to 0, incrementing n + # each time, so we'll fix that now: + + if {[incr n [expr {$i / $out}]] > 0x7fffffff} { + throw {PUNYCODE OVERFLOW} \ + "excessively large integer computed in character choice" + } elseif {$n > $max_codepoint} { + if {$n < 0x10ffff} { + throw {PUNYCODE NON_BMP} \ + [format "unsupported character U+%06x" $n] + } + throw {PUNYCODE NON_UNICODE} "bad codepoint $n" + } + set i [expr {$i % $out}] + + # Insert n at position i of the output: + + set output [linsert $output $i [format "%c" $n]] + incr i + } + + return [join $output ""] + } +} + +package provide tcl::idna 1.0 + +# Local variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 142a52f..d20ed41 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,3 +1,4 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} package ifneeded http 2.8.4 [list tclPkgSetup $dir http 2.8.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]] +package ifndeeded tcl::idna 1.0 [list source [file join $dir idna.tcl]] -- cgit v0.12 From bff7817ec08bd66d55833181a0ed4850561e3d94 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 Nov 2012 04:09:25 +0000 Subject: Kill Octal; bump to 9.0a0; make test suite work again. --- README | 2 +- generic/tcl.h | 12 ++++++------ generic/tclStrToD.c | 2 +- generic/tclTest.c | 4 ++-- library/http/http.tcl | 2 +- library/http/pkgIndex.tcl | 2 +- library/init.tcl | 2 +- library/msgcat/msgcat.tcl | 2 +- library/msgcat/pkgIndex.tcl | 2 +- library/opt/optparse.tcl | 2 +- library/opt/pkgIndex.tcl | 2 +- library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 2 +- macosx/Tcl-Common.xcconfig | 2 +- tests/all.tcl | 2 +- tests/httpd11.tcl | 2 +- tests/main.test | 2 +- tests/msgcat.test | 2 +- tests/parseExpr.test | 5 ++--- tests/safe.test | 2 +- tests/tm.test | 2 +- tools/genStubs.tcl | 2 +- tools/man2html.tcl | 2 +- tools/man2html1.tcl | 2 +- tools/man2html2.tcl | 2 +- tools/tcl.hpj.in | 4 ++-- tools/tclZIC.tcl | 2 +- tools/tcltk-man2html.tcl | 2 +- unix/configure | 26 +++++++++++++------------- unix/configure.in | 10 +++++----- unix/tcl.spec | 2 +- win/README | 4 ++-- win/configure.in | 8 ++++---- win/makefile.bc | 4 ++-- win/tclAppInit.c | 2 +- 35 files changed, 64 insertions(+), 65 deletions(-) diff --git a/README b/README index 56f7e38..6207d76 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6b3 source distribution. + This is the Tcl 9.0a0 source distribution. http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. diff --git a/generic/tcl.h b/generic/tcl.h index 147672c..60b31d7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -53,13 +53,13 @@ extern "C" { * tools/tcl.hpj.in (not patchlevel, for windows installer) */ -#define TCL_MAJOR_VERSION 8 -#define TCL_MINOR_VERSION 6 -#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -#define TCL_RELEASE_SERIAL 3 +#define TCL_MAJOR_VERSION 9 +#define TCL_MINOR_VERSION 0 +#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE +#define TCL_RELEASE_SERIAL 0 -#define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6b3" +#define TCL_VERSION "9.0" +#define TCL_PATCH_LEVEL "9.0a0" /* *---------------------------------------------------------------------------- diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 2d534a68..1a47304 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -22,7 +22,7 @@ * as octal. (Ceterum censeo: numeros octonarios delendos esse.) */ -#undef KILL_OCTAL +#define KILL_OCTAL /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 diff --git a/generic/tclTest.c b/generic/tclTest.c index 1734968..22e3747 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -533,10 +533,10 @@ Tcltest_Init( "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) { + if (Tcl_TomMath_InitStubs(interp, TCL_VERSION) == NULL) { return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { diff --git a/library/http/http.tcl b/library/http/http.tcl index d57e3ce..c3290c9 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.5 diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 303d3bd..828c860 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.6]} {return} +if {![package vsatisfies [package provide Tcl] 8.6-]} {return} package ifneeded http 2.8.5 [list tclPkgSetup $dir http 2.8.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index 3ec78af..7eeb53b 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6b3 +package require -exact Tcl 9.0a0 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 112507a..5f8e1e9 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 +package require Tcl 8.5- # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.5.0 diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 832bf81..a5b6499 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]] diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl index fc77fa1..163bc7d 100644 --- a/library/opt/optparse.tcl +++ b/library/opt/optparse.tcl @@ -8,7 +8,7 @@ # on it. If your code does rely on this package you # may directly incorporate this code into your application. -package require Tcl 8.2 +package require Tcl 8.2- # When this version number changes, update the pkgIndex.tcl file # and the install directory in the Makefiles. package provide opt 0.4.6 diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl index 107d4c6..d96af94 100644 --- a/library/opt/pkgIndex.tcl +++ b/library/opt/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.2]} {return} +if {![package vsatisfies [package provide Tcl] 8.2-]} {return} package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 0e4568d..3769155 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded tcltest 2.3.4 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 02da62f..12692bb 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -package require Tcl 8.5 ;# -verbose line uses [info frame] +package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig index 9c47547..6ee8d58 100644 --- a/macosx/Tcl-Common.xcconfig +++ b/macosx/Tcl-Common.xcconfig @@ -34,4 +34,4 @@ TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H -VERSION = 8.6 +VERSION = 9.0 diff --git a/tests/all.tcl b/tests/all.tcl index 05d3024..5fd21ce 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest -package require Tcl 8.5 +package require Tcl 8.5- package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 9c543dc..9d0650e 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- proc ::tcl::dict::get? {dict key} { if {[dict exists $dict $key]} { diff --git a/tests/main.test b/tests/main.test index f1dc7fd..7fd9d73 100644 --- a/tests/main.test +++ b/tests/main.test @@ -16,7 +16,7 @@ namespace eval ::tcl::test::main { # - tests use testing commands introduced in Tcltest 8.4 testConstraint Tcltest [expr { [llength [package provide Tcltest]] - && [package vsatisfies [package provide Tcltest] 8.4]}] + && [package vsatisfies [package provide Tcltest] 8.4-]}] # Procedure to simulate interactive typing of commands, line by line proc type {chan script} { diff --git a/tests/msgcat.test b/tests/msgcat.test index 1522354..9fb565b 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,7 +12,7 @@ # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. -package require Tcl 8.2 +package require Tcl 8.2- if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 7910974..d667bf2 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -1045,9 +1045,8 @@ test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body { } -result {- {} 0 subexpr naner() 1 operator naner 0 {}} test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body { - catch {testexprparser 08 -1} m o - dict get $o -errorcode -} -result {TCL PARSE EXPR BADNUMBER OCTAL} + testexprparser 08 -1 +} -result {- {} 0 subexpr 08 1 text 08 0 {}} test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0o8 -1} m o dict get $o -errorcode diff --git a/tests/safe.test b/tests/safe.test index 4a2792e..423e10e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 +package require Tcl 8.5- if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/tm.test b/tests/tm.test index 149a65d..73e8261 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -6,7 +6,7 @@ # Copyright (c) 2004 by Donal K. Fellows. # All rights reserved. -package require Tcl 8.5 +package require Tcl 8.5- if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index dea63e6..fdee5db 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.4 +package require Tcl 8.4- namespace eval genStubs { # libraryName -- diff --git a/tools/man2html.tcl b/tools/man2html.tcl index fa57b03..124f631 100644 --- a/tools/man2html.tcl +++ b/tools/man2html.tcl @@ -2,7 +2,7 @@ # \ exec tclsh "$0" ${1+"$@"} -package require Tcl 8.4 +package require Tcl 8.4- # man2html.tcl -- # diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl index f2b2e43..23a9e58 100644 --- a/tools/man2html1.tcl +++ b/tools/man2html1.tcl @@ -5,7 +5,7 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. -package require Tcl 8.4 +package require Tcl 8.4- # Global variables used by these scripts: # diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl index 163196e..753fde4 100644 --- a/tools/man2html2.tcl +++ b/tools/man2html2.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. -package require Tcl 8.4 +package require Tcl 8.4- # Global variables used by these scripts: # diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 3bdccbe..4641165 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl86.cnt +CNT=tcl90.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl86.hlp +HLP=tcl90.hlp [FILES] tcl.rtf diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index 005919a..d025d72 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -30,7 +30,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- -package require Tcl 8.5 +package require Tcl 8.5- # Define the names of the Olson files that we need to load. # We avoid the solar time files and the leap seconds. diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 665a1d4..b4c0f6c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,6 +1,6 @@ #!/usr/bin/env tclsh -package require Tcl 8.6 +package require Tcl 8.6- # Convert Ousterhout format man pages into highly crosslinked hypertext. # diff --git a/unix/configure b/unix/configure index cbb10b4..82ca9df 100755 --- a/unix/configure +++ b/unix/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59 for tcl 8.6. +# Generated by GNU Autoconf 2.59 for tcl 9.0. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation @@ -267,8 +267,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.6' -PACKAGE_STRING='tcl 8.6' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. @@ -777,7 +777,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.6 to adapt to many kinds of systems. +\`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -834,7 +834,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.6:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -978,7 +978,7 @@ fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.6 +tcl configure 9.0 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. @@ -992,7 +992,7 @@ cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.6, which was +It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ @@ -1332,10 +1332,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -19958,7 +19958,7 @@ _ASBOX } >&5 cat >&5 <<_CSEOF -This file was extended by tcl $as_me 8.6, which was +This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -20016,7 +20016,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -tcl config.status 8.6 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" diff --git a/unix/configure.in b/unix/configure.in index f4b695d..4ebf1af 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -AC_INIT([tcl],[8.6]) +AC_INIT([tcl],[9.0]) AC_PREREQ(2.59) dnl This is only used when included from macosx/configure.ac @@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index 0c42aa4..f4839ce 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6b3 +Version: 9.0a0 Release: 2 License: BSD Group: Development/Languages diff --git a/win/README b/win/README index 8b257b1..4ecd9b3 100644 --- a/win/README +++ b/win/README @@ -1,4 +1,4 @@ -Tcl 8.6 for Windows +Tcl 9.0 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.6 Source Distribution (plus any patches) + Tcl 9.0 Source Distribution (plus any patches) and diff --git a/win/configure.in b/win/configure.in index 0426bb1..e74a745 100644 --- a/win/configure.in +++ b/win/configure.in @@ -11,10 +11,10 @@ AC_PREREQ(2.59) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/makefile.bc b/win/makefile.bc index 18bfa28..bd71169 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -123,8 +123,8 @@ CFG_ENCODING = \"cp1252\" NAMEPREFIX = tcl STUBPREFIX = $(NAMEPREFIX)stub -DOTVERSION = 8.6 -VERSION = 86 +DOTVERSION = 9.0 +VERSION = 90 DDEVERSION = 14 DDEDOTVERSION = 1.4 diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 56f45a0..299f42b 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -1,4 +1,4 @@ -/* + * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit -- cgit v0.12 From 05b1764f74b5b1eb40ac16bdb0349de9f47587a5 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 Nov 2012 05:12:38 +0000 Subject: Octal death documentation impacts. --- doc/GetInt.3 | 12 ++++++++---- doc/expr.n | 5 +---- doc/scan.n | 6 ++---- 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/doc/GetInt.3 b/doc/GetInt.3 index f77d337..795a5b1 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -55,11 +55,15 @@ of integer digits, optionally signed and optionally preceded by white space. If the first two characters of \fIsrc\fR after the optional white space and sign are .QW 0x -then \fIsrc\fR is expected to be in hexadecimal form; otherwise, -if the first such character is -.QW 0 +then \fIsrc\fR is expected to be in hexadecimal form. +If the first two such characters are +.QW 0o then \fIsrc\fR -is expected to be in octal form; otherwise, \fIsrc\fR is +is expected to be in octal form. +If the first two such characters are +.QW 0b +then \fIsrc\fR +is expected to be in binary form; otherwise, \fIsrc\fR is expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point diff --git a/doc/expr.n b/doc/expr.n index 6d965fb..6b6e944 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -46,10 +46,7 @@ Where possible, operands are interpreted as integer values. Integer values may be specified in decimal (the normal case), in binary (if the first two characters of the operand are \fB0b\fR), in octal (if the first two characters of the operand are \fB0o\fR), or in hexadecimal -(if the first two characters of the operand are \fB0x\fR). For -compatibility with older Tcl releases, an octal integer value is also -indicated simply when the first character of the operand is \fB0\fR, -whether or not the second character is also \fBo\fR. +(if the first two characters of the operand are \fB0x\fR). If an operand does not have one of the integer formats given above, then it is treated as a floating-point number if that is possible. Floating-point numbers may be specified in any of several diff --git a/doc/scan.n b/doc/scan.n index cc5ed79..3cb0320 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -226,12 +226,10 @@ set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP -Parse a \fIHH:MM\fR time string, noting that this avoids problems with -octal numbers by forcing interpretation as decimals (if we did not -care, we would use the \fB%i\fR conversion instead): +Parse a \fIHH:MM\fR time string: .PP .CS -set string "08:08" ;# *Not* octal! +set string "08:08" if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} { error "not a valid time string" } -- cgit v0.12 From 9423df24912ab6668070d2aae7bd91107027eb6d Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 Nov 2012 21:04:23 +0000 Subject: Goodbye to [case]. --- doc/case.n | 60 ----------------------- generic/tclBasic.c | 3 -- generic/tclCmdAH.c | 137 ----------------------------------------------------- generic/tclInt.h | 3 -- tests/case.test | 89 ---------------------------------- tests/cmdAH.test | 2 - 6 files changed, 294 deletions(-) delete mode 100644 doc/case.n delete mode 100644 tests/case.test diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index 0155a61..0000000 --- a/doc/case.n +++ /dev/null @@ -1,60 +0,0 @@ -'\" -'\" Copyright (c) 1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.so man.macros -.TH case n 7.0 Tcl "Tcl Built-In Commands" -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -case \- Evaluate one of several scripts, depending on a given value -.SH SYNOPSIS -\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...? -.sp -\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?} -.BE - -.SH DESCRIPTION -.PP -\fINote: the \fBcase\fI command is obsolete and is supported only -for backward compatibility. At some point in the future it may be -removed entirely. You should use the \fBswitch\fI command instead.\fR -.PP -The \fBcase\fR command matches \fIstring\fR against each of -the \fIpatList\fR arguments in order. -Each \fIpatList\fR argument is a list of one or -more patterns. If any of these patterns matches \fIstring\fR then -\fBcase\fR evaluates the following \fIbody\fR argument -by passing it recursively to the Tcl interpreter and returns the result -of that evaluation. -Each \fIpatList\fR argument consists of a single -pattern or list of patterns. Each pattern may contain any of the wild-cards -described under \fBstring match\fR. If a \fIpatList\fR -argument is \fBdefault\fR, the corresponding body will be evaluated -if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument -matches \fIstring\fR and no default is given, then the \fBcase\fR -command returns an empty string. -.PP -Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments. -The first uses a separate argument for each of the patterns and commands; -this form is convenient if substitutions are desired on some of the -patterns or commands. -The second form places all of the patterns and commands together into -a single argument; the argument must have proper list structure, with -the elements of the list being the patterns and commands. -The second form makes it easy to construct multi-line case commands, -since the braces around the whole list make it unnecessary to include a -backslash at the end of each line. -Since the \fIpatList\fR arguments are in braces in the second form, -no command or variable substitutions are performed on them; this makes -the behavior of the second form different than the first form in some -cases. - -.SH "SEE ALSO" -switch(n) - -.SH KEYWORDS -case, match, regular expression diff --git a/generic/tclBasic.c b/generic/tclBasic.c index bce6479..1ee514e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -205,9 +205,6 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, 1}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, 1}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, 1}, -#ifndef EXCLUDE_OBSOLETE_COMMANDS - {"case", Tcl_CaseObjCmd, NULL, NULL, 1}, -#endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, 1}, {"concat", Tcl_ConcatObjCmd, NULL, NULL, 1}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1}, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 14951e4..ee1f97a 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -132,143 +132,6 @@ Tcl_BreakObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_CaseObjCmd -- - * - * This procedure is invoked to process the "case" Tcl command. See the - * user documentation for details on what it does. THIS COMMAND IS - * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0. - * - * Results: - * A standard Tcl object result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -int -Tcl_CaseObjCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - register int i; - int body, result, caseObjc; - const char *stringPtr, *arg; - Tcl_Obj *const *caseObjv; - Tcl_Obj *armPtr; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, - "string ?in? ?pattern body ...? ?default body?"); - return TCL_ERROR; - } - - stringPtr = TclGetString(objv[1]); - body = -1; - - arg = TclGetString(objv[2]); - if (strcmp(arg, "in") == 0) { - i = 3; - } else { - i = 2; - } - caseObjc = objc - i; - caseObjv = objv + i; - - /* - * If all of the pattern/command pairs are lumped into a single argument, - * split them out again. - */ - - if (caseObjc == 1) { - Tcl_Obj **newObjv; - - TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv); - caseObjv = newObjv; - } - - for (i = 0; i < caseObjc; i += 2) { - int patObjc, j; - const char **patObjv; - const char *pat; - unsigned char *p; - - if (i == caseObjc-1) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra case pattern with no body", -1)); - return TCL_ERROR; - } - - /* - * Check for special case of single pattern (no list) with no - * backslash sequences. - */ - - pat = TclGetString(caseObjv[i]); - for (p = (unsigned char *) pat; *p != '\0'; p++) { - if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */ - break; - } - } - if (*p == '\0') { - if ((*pat == 'd') && (strcmp(pat, "default") == 0)) { - body = i + 1; - } - if (Tcl_StringMatch(stringPtr, pat)) { - body = i + 1; - goto match; - } - continue; - } - - /* - * Break up pattern lists, then check each of the patterns in the - * list. - */ - - result = Tcl_SplitList(interp, pat, &patObjc, &patObjv); - if (result != TCL_OK) { - return result; - } - for (j = 0; j < patObjc; j++) { - if (Tcl_StringMatch(stringPtr, patObjv[j])) { - body = i + 1; - break; - } - } - ckfree(patObjv); - if (j < patObjc) { - break; - } - } - - match: - if (body != -1) { - armPtr = caseObjv[body - 1]; - result = Tcl_EvalObjEx(interp, caseObjv[body], 0); - if (result == TCL_ERROR) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"%.50s\" arm line %d)", - TclGetString(armPtr), Tcl_GetErrorLine(interp))); - } - return result; - } - - /* - * Nothing matched: return nothing. - */ - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl diff --git a/generic/tclInt.h b/generic/tclInt.h index 1d04c82..21aa884 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3208,9 +3208,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index 6d63cea..0000000 --- a/tests/case.test +++ /dev/null @@ -1,89 +0,0 @@ -# Commands covered: case -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} - -test case-1.1 {simple pattern} { - case a in a {format 1} b {format 2} c {format 3} default {format 4} -} 1 -test case-1.2 {simple pattern} { - case b a {format 1} b {format 2} c {format 3} default {format 4} -} 2 -test case-1.3 {simple pattern} { - case x in a {format 1} b {format 2} c {format 3} default {format 4} -} 4 -test case-1.4 {simple pattern} { - case x a {format 1} b {format 2} c {format 3} -} {} -test case-1.5 {simple pattern matches many times} { - case b a {format 1} b {format 2} b {format 3} b {format 4} -} 2 -test case-1.6 {fancier pattern} { - case cx a {format 1} *c {format 2} *x {format 3} default {format 4} -} 3 -test case-1.7 {list of patterns} { - case abc in {a b c} {format 1} {def abc ghi} {format 2} -} 2 - -test case-2.1 {error in executed command} { - list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ - $msg $::errorInfo -} {1 {Just a test} {Just a test - while executing -"error "Just a test"" - ("a" arm line 1) - invoked from within -"case a in a {error "Just a test"} default {format 1}"}} -test case-2.2 {error: not enough args} { - list [catch {case} msg] $msg -} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} -test case-2.3 {error: pattern with no body} { - list [catch {case a b} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.4 {error: pattern with no body} { - list [catch {case a in b {format 1} c} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.5 {error in default command} { - list [catch {case foo in a {error case1} default {error case2} \ - b {error case 3}} msg] $msg $::errorInfo -} {1 case2 {case2 - while executing -"error case2" - ("default" arm line 1) - invoked from within -"case foo in a {error case1} default {error case2} b {error case 3}"}} - -test case-3.1 {single-argument form for pattern/command pairs} { - case b in { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.2 {single-argument form for pattern/command pairs} { - case b { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.3 {single-argument form for pattern/command pairs} { - list [catch {case z in {a 2 b}} msg] $msg -} {1 {extra case pattern with no body}} - -# cleanup -::tcltest::cleanupTests -return diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 2ecf626..3011597 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -59,8 +59,6 @@ test cmdAH-0.2 {Tcl_BreakObjCmd, success} { list [catch {break} msg] $msg } {3 {}} -# Tcl_CaseObjCmd is tested in case.test - test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body { catch } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} -- cgit v0.12 From e702454abe798d9bd3b220429d0e0aadd0772fe9 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 Nov 2012 22:17:24 +0000 Subject: Abandon support for pre-8.5 bytecode. --- generic/tclExecute.c | 134 +-------------------------------------------------- 1 file changed, 1 insertion(+), 133 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index cf8f9e7..36f87c0 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -107,63 +107,6 @@ long tclObjsFreed = 0; long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ -/* - * Support pre-8.5 bytecodes unless specifically requested otherwise. - */ - -#ifndef TCL_SUPPORT_84_BYTECODE -#define TCL_SUPPORT_84_BYTECODE 1 -#endif - -#if TCL_SUPPORT_84_BYTECODE -/* - * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 - * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. - */ - -typedef struct { - const char *name; /* Name of function. */ - int numArgs; /* Number of arguments for function. */ -} BuiltinFunc; - -/* - * Table describing the built-in math functions. Entries in this table are - * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's - * operand byte. - */ - -static BuiltinFunc const tclBuiltinFuncTable[] = { - {"acos", 1}, - {"asin", 1}, - {"atan", 1}, - {"atan2", 2}, - {"ceil", 1}, - {"cos", 1}, - {"cosh", 1}, - {"exp", 1}, - {"floor", 1}, - {"fmod", 2}, - {"hypot", 2}, - {"log", 1}, - {"log10", 1}, - {"pow", 2}, - {"sin", 1}, - {"sinh", 1}, - {"sqrt", 1}, - {"tan", 1}, - {"tanh", 1}, - {"abs", 1}, - {"double", 1}, - {"int", 1}, - {"rand", 0}, - {"round", 1}, - {"srand", 1}, - {"wide", 1}, - {NULL, 0}, -}; - -#define LAST_BUILTIN_FUNC 25 -#endif /* * NR_TEBC @@ -2887,90 +2830,15 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else /* * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. + * changes to add a ::tcl::mathfunc namespace in 8.5. */ case INST_CALL_BUILTIN_FUNC1: Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); case INST_CALL_FUNC1: Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); -#endif /* * ----------------------------------------------------------------- -- cgit v0.12 From 8e5dbc8a2739f6cd0dd5380c7a8998e07a9aa78f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 Nov 2012 17:52:55 +0000 Subject: Remove pre-8.5 interface for custom expr functions. --- doc/CrtMathFnc.3 | 162 --------------------- doc/mathfunc.n | 5 +- generic/tcl.decls | 26 ++-- generic/tcl.h | 18 --- generic/tclBasic.c | 368 ------------------------------------------------ generic/tclDecls.h | 32 ++--- generic/tclStubInit.c | 6 +- generic/tclTest.c | 153 +------------------- tests/compExpr-old.test | 22 --- tests/compExpr.test | 13 -- tests/expr-old.test | 16 --- tests/expr.test | 40 ------ 12 files changed, 27 insertions(+), 834 deletions(-) delete mode 100644 doc/CrtMathFnc.3 diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 deleted file mode 100644 index cdde20b..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -1,162 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.so man.macros -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.BS -.SH NAME -Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions -.SH "NOTICE OF EVENTUAL DEPRECATION" -.PP -The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions -are rendered somewhat obsolete by the ability to create functions for -expressions by placing commands in the \fBtcl::mathfunc\fR namespace, -as described in the \fBmathfunc\fR manual page; the API described on -this page is not expected to be maintained indefinitely. -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -void -\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) -.sp -int -\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, - clientDataPtr\fR) -.sp -Tcl_Obj * -\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) -.SH ARGUMENTS -.AS Tcl_ValueType *clientDataPtr out -.AP Tcl_Interp *interp in -Interpreter in which new function will be defined. -.AP "const char" *name in -Name for new function. -.AP int numArgs in -Number of arguments to new function; also gives size of \fIargTypes\fR array. -.AP Tcl_ValueType *argTypes in -Points to an array giving the permissible types for each argument to -function. -.AP Tcl_MathProc *proc in -Procedure that implements the function. -.AP ClientData clientData in -Arbitrary one-word value to pass to \fIproc\fR when it is invoked. -.AP int *numArgsPtr out -Points to a variable that will be set to contain the number of -arguments to the function. -.AP Tcl_ValueType **argTypesPtr out -Points to a variable that will be set to contain a pointer to an array -giving the permissible types for each argument to the function which -will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc **procPtr out -Points to a variable that will be set to contain a pointer to the -implementation code for the function (or NULL if the function is -implemented directly in bytecode). -.AP ClientData *clientDataPtr out -Points to a variable that will be set to contain the clientData -argument passed to \fITcl_CreateMathFunc\fR when the function was -created if the function is not implemented directly in bytecode. -.AP "const char" *pattern in -Pattern to match against function names so as to filter them (by -passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. -.BE -.SH DESCRIPTION -.PP -Tcl allows a number of mathematical functions to be used in -expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. -These functions are represented by commands in the namespace, -\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is -an obsolete way for applications to add additional functions -to those already provided by Tcl or to replace existing functions. -It should not be used by new applications, which should create -math functions using \fBTcl_CreateObjCommand\fR to create a command -in the \fBtcl::mathfunc\fR namespace. -.PP -In the \fBTcl_CreateMathFunc\fR interface, -\fIName\fR is the name of the function as it will appear in expressions. -If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR -namespace, then a new command is created in that namespace. -If \fIname\fR does exist, then the existing function is replaced. -\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. -Each entry in the \fIargTypes\fR array must be -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, -or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an -integer, a double-precision floating value, a wide (64-bit) integer, -or any, respectively. -.PP -Whenever the function is invoked in an expression Tcl will invoke -\fIproc\fR. \fIProc\fR should have arguments and result that match -the type \fBTcl_MathProc\fR: -.PP -.CS -typedef int \fBTcl_MathProc\fR( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tcl_Value *\fIargs\fR, - Tcl_Value *\fIresultPtr\fR); -.CE -.PP -When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR -arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. -\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, -which describe the actual arguments to the function: -.PP -.CS -typedef struct Tcl_Value { - Tcl_ValueType \fItype\fR; - long \fIintValue\fR; - double \fIdoubleValue\fR; - Tcl_WideInt \fIwideValue\fR; -} \fBTcl_Value\fR; -.CE -.PP -The \fItype\fR field indicates the type of the argument and is -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. -It will match the \fIargTypes\fR value specified for the function unless -the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts -the argument supplied in the expression to the type requested in -\fIargTypes\fR, if that is necessary. -Depending on the value of the \fItype\fR field, the \fIintValue\fR, -\fIdoubleValue\fR or \fIwideValue\fR -field will contain the actual value of the argument. -.PP -\fIProc\fR should compute its result and store it either as an integer -in \fIresultPtr->intValue\fR or as a floating value in -\fIresultPtr->doubleValue\fR. -It should set also \fIresultPtr->type\fR to one of -\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR -to indicate which value was set. -Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. -If an error occurs while executing the function, \fIproc\fR should -return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. -.PP -\fBTcl_GetMathFuncInfo\fR retrieves the values associated with -function \fIname\fR that were passed to a preceding -\fBTcl_CreateMathFunc\fR call. Normally, the return code is -\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR -is returned and an error message is placed in the interpreter's -result. -.PP -If an error did not occur, the array reference placed in the variable -pointed to by \fIargTypesPtr\fR is newly allocated, and should be -released by passing it to \fBTcl_Free\fR. Some functions (the -standard set implemented in the core, and those defined by placing -commands in the \fBtcl::mathfunc\fR namespace) do not have -argument type information; attempting to retrieve values for -them causes a NULL to be stored in the variable pointed to by -\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR -will not be modified. The variable pointed to by \fInumArgsPointer\fR -will contain -1, and no argument types will be stored in the variable -pointed to by \fIargTypesPointer\fR. -.PP -\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all -the math functions defined in the interpreter whose name matches -\fIpattern\fR. The returned value has a reference count of zero. -.SH "SEE ALSO" -expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) -.SH KEYWORDS -expression, mathematical function diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 14b448e..a9b8a94 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -106,10 +106,7 @@ of which work solely with floating-point numbers unless otherwise noted: In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define -new commands in the \fBtcl::mathfunc\fR namespace. In addition, an -obsolete interface named \fBTcl_CreateMathFunc\fR() is available to -extensions that are written in C. The latter interface is not recommended -for new implementations. +new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR diff --git a/generic/tcl.decls b/generic/tcl.decls index 5a928ec..986f2d7 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -352,11 +352,11 @@ declare 93 { declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -declare 95 { - void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, - int numArgs, Tcl_ValueType *argTypes, - Tcl_MathProc *proc, ClientData clientData) -} +#declare 95 { +# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, +# int numArgs, Tcl_ValueType *argTypes, +# Tcl_MathProc *proc, ClientData clientData) +#} declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, @@ -1548,14 +1548,14 @@ declare 434 { } # TIP#15 (math function introspection) dkf -declare 435 { - int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, - int *numArgsPtr, Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, ClientData *clientDataPtr) -} -declare 436 { - Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) -} +#declare 435 { +# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, +# int *numArgsPtr, Tcl_ValueType **argTypesPtr, +# Tcl_MathProc **procPtr, ClientData *clientDataPtr) +#} +#declare 436 { +# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) +#} # TIP#36 (better access to 'subst') dkf declare 437 { diff --git a/generic/tcl.h b/generic/tcl.h index 024aec9..db21243 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -613,22 +613,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_SUBST_ALL 007 /* - * Argument descriptors for math function callbacks in expressions: - */ - -typedef enum { - TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT -} Tcl_ValueType; - -typedef struct Tcl_Value { - Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, - * or both. */ - long intValue; /* Integer value. */ - double doubleValue; /* Double-precision floating value. */ - Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ -} Tcl_Value; - -/* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ @@ -673,8 +657,6 @@ typedef void (Tcl_FreeProc) (char *blockPtr); typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); -typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, - Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ca339dc..2735abc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -41,18 +41,6 @@ #endif /* - * The following structure defines the client data for a math function - * registered with Tcl_CreateMathFunc - */ - -typedef struct OldMathFuncData { - Tcl_MathProc *proc; /* Handler function */ - int numArgs; /* Number of args expected */ - Tcl_ValueType *argTypes; /* Types of the args */ - ClientData clientData; /* Client data for the handler function */ -} OldMathFuncData; - -/* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler @@ -136,8 +124,6 @@ static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); static Tcl_NRPostProc NRRunObjProc; -static Tcl_ObjCmdProc OldMathFuncProc; -static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); @@ -3427,360 +3413,6 @@ TclCleanupCommand( /* *---------------------------------------------------------------------- * - * Tcl_CreateMathFunc -- - * - * Creates a new math function for expressions in a given interpreter. - * - * Results: - * None. - * - * Side effects: - * The Tcl function defined by "name" is created or redefined. If the - * function already exists then its definition is replaced; this includes - * the builtin functions. Redefining a builtin function forces all - * existing code to be invalidated since that code may be compiled using - * an instruction specific to the replaced function. In addition, - * redefioning a non-builtin function will force existing code to be - * invalidated if the number of arguments has changed. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_CreateMathFunc( - Tcl_Interp *interp, /* Interpreter in which function is to be - * available. */ - const char *name, /* Name of function (e.g. "sin"). */ - int numArgs, /* Nnumber of arguments required by - * function. */ - Tcl_ValueType *argTypes, /* Array of types acceptable for each - * argument. */ - Tcl_MathProc *proc, /* C function that implements the math - * function. */ - ClientData clientData) /* Additional value to pass to the - * function. */ -{ - Tcl_DString bigName; - OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData)); - - data->proc = proc; - data->numArgs = numArgs; - data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType)); - memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); - data->clientData = clientData; - - Tcl_DStringInit(&bigName); - TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); - Tcl_DStringAppend(&bigName, name, -1); - - Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), - OldMathFuncProc, data, OldMathFuncDeleteProc); - Tcl_DStringFree(&bigName); -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncProc -- - * - * Dispatch to a math function created with Tcl_CreateMathFunc - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * Whatever the math function does. - * - *---------------------------------------------------------------------- - */ - -static int -OldMathFuncProc( - ClientData clientData, /* Ponter to OldMathFuncData describing the - * function being called */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Actual parameter count */ - Tcl_Obj *const *objv) /* Parameter vector */ -{ - Tcl_Obj *valuePtr; - OldMathFuncData *dataPtr = clientData; - Tcl_Value funcResult, *args; - int result; - int j, k; - double d; - - /* - * Check argument count. - */ - - if (objc != dataPtr->numArgs + 1) { - MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv); - return TCL_ERROR; - } - - /* - * Convert arguments from Tcl_Obj's to Tcl_Value's. - */ - - args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value)); - for (j = 1, k = 0; j < objc; ++j, ++k) { - /* TODO: Convert to TclGetNumberFromObj? */ - valuePtr = objv[j]; - result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); -#ifdef ACCEPT_NAN - if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) { - d = valuePtr->internalRep.doubleValue; - result = TCL_OK; - } -#endif - if (result != TCL_OK) { - /* - * We have a non-numeric argument. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "argument to math function didn't have numeric value", - -1)); - TclCheckBadOctal(interp, Tcl_GetString(valuePtr)); - ckfree(args); - return TCL_ERROR; - } - - /* - * Copy the object's numeric value to the argument record, converting - * it if necessary. - * - * NOTE: no bignum support; use the new mathfunc interface for that. - */ - - args[k].type = dataPtr->argTypes[k]; - switch (args[k].type) { - case TCL_EITHER: - if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue) - == TCL_OK) { - args[k].type = TCL_INT; - break; - } - if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue) - == TCL_OK) { - args[k].type = TCL_WIDE_INT; - break; - } - args[k].type = TCL_DOUBLE; - /* FALLTHROUGH */ - - case TCL_DOUBLE: - args[k].doubleValue = d; - break; - case TCL_INT: - if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { - ckfree(args); - return TCL_ERROR; - } - valuePtr = Tcl_GetObjResult(interp); - Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); - Tcl_ResetResult(interp); - break; - case TCL_WIDE_INT: - if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { - ckfree(args); - return TCL_ERROR; - } - valuePtr = Tcl_GetObjResult(interp); - Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); - Tcl_ResetResult(interp); - break; - } - } - - /* - * Call the function. - */ - - errno = 0; - result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult); - ckfree(args); - if (result != TCL_OK) { - return result; - } - - /* - * Return the result of the call. - */ - - if (funcResult.type == TCL_INT) { - TclNewLongObj(valuePtr, funcResult.intValue); - } else if (funcResult.type == TCL_WIDE_INT) { - valuePtr = Tcl_NewWideIntObj(funcResult.wideValue); - } else { - return CheckDoubleResult(interp, funcResult.doubleValue); - } - Tcl_SetObjResult(interp, valuePtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncDeleteProc -- - * - * Cleans up after deleting a math function registered with - * Tcl_CreateMathFunc - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -OldMathFuncDeleteProc( - ClientData clientData) -{ - OldMathFuncData *dataPtr = clientData; - - ckfree(dataPtr->argTypes); - ckfree(dataPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetMathFuncInfo -- - * - * Discovers how a particular math function was created in a given - * interpreter. - * - * Results: - * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the - * interpreter result if that happens.) - * - * Side effects: - * If this function succeeds, the variables pointed to by the numArgsPtr - * and argTypePtr arguments will be updated to detail the arguments - * allowed by the function. The variable pointed to by the procPtr - * argument will be set to NULL if the function is a builtin function, - * and will be set to the address of the C function used to implement the - * math function otherwise (in which case the variable pointed to by the - * clientDataPtr argument will also be updated.) - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GetMathFuncInfo( - Tcl_Interp *interp, - const char *name, - int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - ClientData *clientDataPtr) -{ - Tcl_Obj *cmdNameObj; - Command *cmdPtr; - - /* - * Get the command that implements the math function. - */ - - TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::"); - Tcl_AppendToObj(cmdNameObj, name, -1); - Tcl_IncrRefCount(cmdNameObj); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj); - Tcl_DecrRefCount(cmdNameObj); - - /* - * Report unknown functions. - */ - - if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown math function \"%s\"", name)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - return TCL_ERROR; - } - - /* - * Retrieve function info for user defined functions; return dummy - * information for builtins. - */ - - if (cmdPtr->objProc == &OldMathFuncProc) { - OldMathFuncData *dataPtr = cmdPtr->clientData; - - *procPtr = dataPtr->proc; - *numArgsPtr = dataPtr->numArgs; - *argTypesPtr = dataPtr->argTypes; - *clientDataPtr = dataPtr->clientData; - } else { - *procPtr = NULL; - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ListMathFuncs -- - * - * Produces a list of all the math functions defined in a given - * interpreter. - * - * Results: - * A pointer to a Tcl_Obj structure with a reference count of zero, or - * NULL in the case of an error (in which case a suitable error message - * will be left in the interpreter result.) - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -Tcl_ListMathFuncs( - Tcl_Interp *interp, - const char *pattern) -{ - Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1); - Tcl_Obj *result; - Tcl_InterpState state; - - if (pattern) { - Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1); - Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj); - - Tcl_AppendObjToObj(script, arg); - Tcl_DecrRefCount(arg); /* Should tear down patternObj too */ - } - - state = Tcl_SaveInterpState(interp, TCL_OK); - Tcl_IncrRefCount(script); - if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { - result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); - } else { - result = Tcl_NewObj(); - } - Tcl_DecrRefCount(script); - Tcl_RestoreInterpState(interp, state); - - return result; -} - -/* - *---------------------------------------------------------------------- - * * TclInterpReady -- * * Check if an interpreter is ready to eval commands or scripts, i.e., if diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 5da5963..3690a77 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -307,11 +307,7 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); -/* 95 */ -EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp, - const char *name, int numArgs, - Tcl_ValueType *argTypes, Tcl_MathProc *proc, - ClientData clientData); +/* Slot 95 is reserved */ /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, @@ -1246,15 +1242,8 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); -/* 435 */ -EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp, - const char *name, int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - ClientData *clientDataPtr); -/* 436 */ -EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, - const char *pattern); +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); @@ -1926,7 +1915,7 @@ typedef struct TclStubs { void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ - void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ + void (*reserved95)(void); Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */ Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */ @@ -2274,8 +2263,8 @@ typedef struct TclStubs { int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ - int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ - Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ + void (*reserved435)(void); + void (*reserved436)(void); Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ @@ -2688,8 +2677,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ -#define Tcl_CreateMathFunc \ - (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ +/* Slot 95 is reserved */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateSlave \ @@ -3372,10 +3360,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ -#define Tcl_GetMathFuncInfo \ - (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ -#define Tcl_ListMathFuncs \ - (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 24786a4..9fcb1d3 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -741,7 +741,7 @@ const TclStubs tclStubs = { Tcl_CreateEventSource, /* 92 */ Tcl_CreateExitHandler, /* 93 */ Tcl_CreateInterp, /* 94 */ - Tcl_CreateMathFunc, /* 95 */ + 0, /* 95 */ Tcl_CreateObjCommand, /* 96 */ Tcl_CreateSlave, /* 97 */ Tcl_CreateTimerHandler, /* 98 */ @@ -1089,8 +1089,8 @@ const TclStubs tclStubs = { Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ Tcl_GetUnicodeFromObj, /* 434 */ - Tcl_GetMathFuncInfo, /* 435 */ - Tcl_ListMathFuncs, /* 436 */ + 0, /* 435 */ + 0, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 64a1f87..878ffba 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -294,12 +294,6 @@ static int TestlinkCmd(ClientData dummy, static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestMathFunc(ClientData clientData, - Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr); -static int TestMathFunc2(ClientData clientData, - Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr); static int TestmainthreadCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetmainloopCmd(ClientData dummy, @@ -523,8 +517,6 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { - Tcl_ValueType t3ArgTypes[2]; - Tcl_Obj *listPtr; Tcl_Obj **objv; int objc, index; @@ -665,8 +657,7 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); - Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); - Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); + Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, @@ -677,10 +668,6 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif - t3ArgTypes[0] = TCL_EITHER; - t3ArgTypes[1] = TCL_EITHER; - Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, - NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); @@ -3302,144 +3289,6 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * - * TestMathFunc -- - * - * This is a user-defined math procedure to test out math procedures - * with no arguments. - * - * Results: - * A normal Tcl completion code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -static int -TestMathFunc( - ClientData clientData, /* Integer value to return. */ - Tcl_Interp *interp, /* Not used. */ - Tcl_Value *args, /* Not used. */ - Tcl_Value *resultPtr) /* Where to store result. */ -{ - resultPtr->type = TCL_INT; - resultPtr->intValue = PTR2INT(clientData); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestMathFunc2 -- - * - * This is a user-defined math procedure to test out math procedures - * that do have arguments, in this case 2. - * - * Results: - * A normal Tcl completion code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -static int -TestMathFunc2( - ClientData clientData, /* Integer value to return. */ - Tcl_Interp *interp, /* Used to report errors. */ - Tcl_Value *args, /* Points to an array of two Tcl_Value structs - * for the two arguments. */ - Tcl_Value *resultPtr) /* Where to store the result. */ -{ - int result = TCL_OK; - - /* - * Return the maximum of the two arguments with the correct type. - */ - - if (args[0].type == TCL_INT) { - int i0 = args[0].intValue; - - if (args[1].type == TCL_INT) { - int i1 = args[1].intValue; - - resultPtr->type = TCL_INT; - resultPtr->intValue = ((i0 > i1)? i0 : i1); - } else if (args[1].type == TCL_DOUBLE) { - double d0 = i0; - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - Tcl_WideInt w0 = Tcl_LongAsWide(i0); - Tcl_WideInt w1 = args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); - result = TCL_ERROR; - } - } else if (args[0].type == TCL_DOUBLE) { - double d0 = args[0].doubleValue; - - if (args[1].type == TCL_INT) { - double d1 = args[1].intValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_DOUBLE) { - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - double d1 = Tcl_WideAsDouble(args[1].wideValue); - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); - result = TCL_ERROR; - } - } else if (args[0].type == TCL_WIDE_INT) { - Tcl_WideInt w0 = args[0].wideValue; - - if (args[1].type == TCL_INT) { - Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else if (args[1].type == TCL_DOUBLE) { - double d0 = Tcl_WideAsDouble(w0); - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - Tcl_WideInt w1 = args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); - result = TCL_ERROR; - } - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC); - result = TCL_ERROR; - } - return result; -} - -/* - *---------------------------------------------------------------------- - * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bae26a0..4664b7a 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -18,13 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} # Big test for correct ordering of data in [expr] @@ -602,21 +595,6 @@ test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body { test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * -test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr 2*T1() -} 246 -test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T2()*3 -} 1035 -test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(21, 37) -} 37 -test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(21.2, 37) -} 37.0 -test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(-21.2, -17.5) -} -17.5 test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} diff --git a/tests/compExpr.test b/tests/compExpr.test index 14c875d..a2a021e 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -14,13 +14,6 @@ if {"::tcltest" ni [namespace children]} { } ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} # Constrain memory leak tests testConstraint memory [llength [info commands memory]] @@ -319,12 +312,6 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { expr {do_it()} } -returnCodes error -match glob -result {* "*do_it"} -test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr 3*T1()-1 -} 368 -test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T2()*3 -} 1035 test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body { expr {atan2(1.0)} } -returnCodes error -match glob -result {too few arguments for math function*} diff --git a/tests/expr-old.test b/tests/expr-old.test index 4f3cb2e..e6808c6 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -26,12 +26,6 @@ testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} - # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -849,12 +843,6 @@ test expr-old-32.41 {math functions in expressions} { test expr-old-32.42 {math functions in expressions} { list [catch {expr hypot(5*.8,3)} msg] $msg } {0 5.0} -test expr-old-32.43 {math functions in expressions} testmathfunctions { - expr 2*T1() -} 246 -test expr-old-32.44 {math functions in expressions} testmathfunctions { - expr T2()*3 -} 1035 test expr-old-32.45 {math functions in expressions} { expr (0 <= rand()) && (rand() < 1) } {1} @@ -954,10 +942,6 @@ test expr-old-34.15 {errors in math functions} { test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 -test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \ - -body { - list [catch {expr T1(4)} msg] $msg - } -match glob -result {1 {too many arguments for math function*}} test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 diff --git a/tests/expr.test b/tests/expr.test index 6ad7208..813812d 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -16,11 +16,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -testConstraint testmathfunctions [expr { - ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"}) -}] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. @@ -685,41 +680,6 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} -body { test expr-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * -test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr 2*T1() -} 246 -test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T2()*3 -} 1035 -test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(21, 37) -} 37 -test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(21.2, 37) -} 37.0 -test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(-21.2, -17.5) -} -17.5 -test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(21, wide(37)) -} 37 -test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), 37) -} 37 -test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), wide(37)) -} 37 -test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(21.0, wide(37)) -} 37.0 -test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), 37.0) -} 37.0 -test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints { - testmathfunctions -} -body { - expr T3(0,"a") -} -returnCodes error -result {argument to math function didn't have numeric value} test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { -- cgit v0.12 From 9bbc90b227c1184c4973ddbe460b1416fec9dad1 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 Nov 2012 17:57:38 +0000 Subject: Tcl_Value is now a synonym for Tcl_Obj ! --- generic/tcl.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tcl.h b/generic/tcl.h index db21243..9ea2e90 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -619,6 +619,8 @@ typedef struct stat *Tcl_OldStat_; struct Tcl_Obj; +typedef struct Tcl_Obj Tcl_Value; + /* *---------------------------------------------------------------------------- * Function types defined by Tcl: -- cgit v0.12 From e63dcc2677b18312bcdc261a91e55ea24e07092a Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 Nov 2012 19:17:21 +0000 Subject: Burn the octal bridges. We're not goin' back. --- generic/tclExecute.c | 14 +--- generic/tclInt.h | 2 - generic/tclStrToD.c | 70 +---------------- generic/tclUtil.c | 68 ----------------- tests/assemble.test | 2 +- tests/compExpr-old.test | 24 +++--- tests/compile.test | 2 +- tests/execute.test | 22 +++--- tests/expr-old.test | 64 ++++++++-------- tests/expr.test | 46 ++++++------ tests/lindex.test | 16 ++-- tests/mathop.test | 194 ++++++++++++++++++++++++------------------------ tests/string.test | 4 +- tests/stringComp.test | 4 +- tests/while-old.test | 2 +- tests/while.test | 4 +- 16 files changed, 196 insertions(+), 342 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 36f87c0..54b1867 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -8438,16 +8438,7 @@ IllegalExprOperandType( } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; - const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes); - - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } + description = "non-numeric string"; } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { @@ -8458,7 +8449,8 @@ IllegalExprOperandType( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%s\"", description, operator)); + "can't use %s \"%s\" as operand of \"%s\"", description, + Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } diff --git a/generic/tclInt.h b/generic/tclInt.h index b328d56..d548a16 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2904,8 +2904,6 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, - const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 1a47304..9f81c13 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -18,13 +18,6 @@ #include /* - * Define KILL_OCTAL to suppress interpretation of numbers with leading zero - * as octal. (Ceterum censeo: numeros octonarios delendos esse.) - */ - -#define KILL_OCTAL - -/* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. @@ -487,7 +480,7 @@ TclParseNumber( enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -648,10 +641,7 @@ TclParseNumber( state = ZERO_O; break; } -#ifdef KILL_OCTAL goto decimal; -#endif - /* FALLTHROUGH */ case OCTAL: /* @@ -714,58 +704,6 @@ TclParseNumber( state = OCTAL; break; } - /* FALLTHROUGH */ - - case BAD_OCTAL: - if (explicitOctal) { - /* - * No forgiveness for bad digits in explicitly octal numbers. - */ - - goto endgame; - } - if (flags & TCL_PARSE_INTEGER_ONLY) { - /* - * No seeking floating point when parsing only integer. - */ - - goto endgame; - } -#ifndef KILL_OCTAL - - /* - * Scanned a number with a leading zero that contains an 8, 9, - * radix point or E. This is an invalid octal number, but might - * still be floating point. - */ - - if (c == '0') { - numTrailZeros++; - state = BAD_OCTAL; - break; - } else if (isdigit(UCHAR(c))) { - if (objPtr != NULL) { - significandOverflow = AccumulateDecimalDigit( - (unsigned)(c-'0'), numTrailZeros, - &significandWide, &significandBig, - significandOverflow); - } - if (numSigDigs != 0) { - numSigDigs += (numTrailZeros + 1); - } else { - numSigDigs = 1; - } - numTrailZeros = 0; - state = BAD_OCTAL; - break; - } else if (c == '.') { - state = FRACTION; - break; - } else if (c == 'E' || c == 'e') { - state = EXPONENT_START; - break; - } -#endif goto endgame; /* @@ -870,9 +808,7 @@ TclParseNumber( * digits. */ -#ifdef KILL_OCTAL decimal: -#endif acceptState = state; acceptPoint = p; acceptLen = len; @@ -1156,7 +1092,6 @@ TclParseNumber( TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: - case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: @@ -1381,9 +1316,6 @@ TclParseNumber( Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); - if (state == BAD_OCTAL) { - Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); - } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 40073d3..4e92772 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3546,7 +3546,6 @@ TclGetIntForIndex( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } @@ -3691,73 +3690,6 @@ SetEndOffsetFromAny( /* *---------------------------------------------------------------------- * - * TclCheckBadOctal -- - * - * This function checks for a bad octal value and appends a meaningful - * error to the interp's result. - * - * Results: - * 1 if the argument was a bad octal, else 0. - * - * Side effects: - * The interpreter's result is modified. - * - *---------------------------------------------------------------------- - */ - -int -TclCheckBadOctal( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ - const char *value) /* String to check. */ -{ - register const char *p = value; - - /* - * A frequent mistake is invalid octal values due to an unwanted leading - * zero. Try to generate a meaningful error message. - */ - - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '+' || *p == '-') { - p++; - } - if (*p == '0') { - if ((p[1] == 'o') || p[1] == 'O') { - p += 2; - } - while (isdigit(UCHAR(*p))) { /* INTL: digit. */ - p++; - } - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '\0') { - /* - * Reached end of string. - */ - - if (interp != NULL) { - /* - * Don't reset the result here because we want this result to - * be added to an existing error message as extra info. - */ - - Tcl_AppendToObj(Tcl_GetObjResult(interp), - " (looks like invalid octal number)", -1); - } - return 1; - } - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. diff --git a/tests/assemble.test b/tests/assemble.test index 7d4e5d1..942b763 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -782,7 +782,7 @@ test assemble-7.43 {uplus} { } } -returnCodes error - -result {can't use non-numeric floating-point value as operand of "+"} + -result {can't use non-numeric floating-point value "NaN" as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 4664b7a..774060d 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -278,10 +278,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -302,10 +302,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 @@ -370,10 +370,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test compExpr-old-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -392,10 +392,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -423,10 +423,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -444,10 +444,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 diff --git a/tests/compile.test b/tests/compile.test index 4d91940..d276460 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -282,7 +282,7 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} -} -returnCodes error -match glob -result {*invalid octal number*} +} -returnCodes error -match glob -result {*} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; array set var {one two many} }} } -returnCodes error -result {list must have an even number of elements} diff --git a/tests/execute.test b/tests/execute.test index 94af158..e0b68e5 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -174,7 +174,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} @@ -199,7 +199,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { @@ -226,7 +226,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} @@ -251,7 +251,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { @@ -278,7 +278,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} @@ -303,7 +303,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { @@ -330,7 +330,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} @@ -355,7 +355,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { @@ -382,7 +382,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { @@ -409,7 +409,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { @@ -457,7 +457,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "foo" as operand of "!"}} # INST_BITNOT not tested # INST_CALL_BUILTIN_FUNC1 not tested diff --git a/tests/expr-old.test b/tests/expr-old.test index e6808c6..ed0f11f 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -193,34 +193,34 @@ test expr-old-2.38 {floating-point operators} { test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "4.0" as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "27.0" as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "3.0" as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "3.0" as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg -} {1 {can't use floating-point value as operand of "|"}} +} {1 {can't use floating-point value "24.0" as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} # Check the string operators individually. @@ -261,46 +261,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "a" as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "a" as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "%"}} +} {1 {can't use non-numeric string "a" as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of ">>"}} +} {1 {can't use non-numeric string "a" as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "|"}} +} {1 {can't use non-numeric string "a" as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -489,7 +489,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0 test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * @@ -503,10 +503,10 @@ test expr-old-26.4 {error conditions} { set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * @@ -530,7 +530,7 @@ test expr-old-26.12 {error conditions} -body { } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * @@ -949,7 +949,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} -body { test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o289" as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} @@ -989,11 +989,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} { test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "10;" as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string " +" as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} @@ -1001,7 +1001,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} { test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o99 " as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} diff --git a/tests/expr.test b/tests/expr.test index 813812d..29fb967 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -252,7 +252,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} { } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -299,10 +299,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -323,10 +323,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { @@ -451,10 +451,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test expr-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -473,10 +473,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -504,10 +504,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -524,10 +524,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -804,15 +804,15 @@ test expr-21.13 {non-numeric boolean literals} -body { } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "true " as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err @@ -832,23 +832,23 @@ test expr-21.20 {non-numeric boolean variables} { test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "o" as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use empty string as operand of "!"}} +} {1 {can't use non-numeric string "" as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg @@ -861,7 +861,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "/"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} @@ -888,10 +888,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "xx" as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "a" as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} diff --git a/tests/lindex.test b/tests/lindex.test index b86e2e0..81f5c40 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -70,11 +70,11 @@ test lindex-3.4 {integer 3} testevalex { test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.6 {bad octal} -constraints testevalex -body { set x -0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] @@ -105,11 +105,11 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.7 {bad octal} -constraints testevalex -body { set x end--0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result @@ -261,11 +261,11 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-11.6 {bad octal} -body { set x -0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} # Indices relative to end @@ -307,11 +307,11 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.7 {bad octal} -body { set x end--0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result diff --git a/tests/mathop.test b/tests/mathop.test index f122b7b..0808d42 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -114,22 +114,22 @@ namespace eval ::testmathop { test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError @@ -152,22 +152,22 @@ namespace eval ::testmathop { test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -189,22 +189,22 @@ namespace eval ::testmathop { test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError @@ -227,22 +227,22 @@ namespace eval ::testmathop { test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -261,7 +261,7 @@ namespace eval ::testmathop { test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -278,7 +278,7 @@ namespace eval ::testmathop { test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -287,10 +287,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 @@ -301,7 +301,7 @@ namespace eval ::testmathop { test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -310,10 +310,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 @@ -324,7 +324,7 @@ namespace eval ::testmathop { test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -333,10 +333,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 @@ -377,32 +377,32 @@ namespace eval ::testmathop { test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError @@ -419,32 +419,32 @@ namespace eval ::testmathop { test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -487,32 +487,32 @@ namespace eval ::testmathop { test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError @@ -529,32 +529,32 @@ namespace eval ::testmathop { test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -597,32 +597,32 @@ namespace eval ::testmathop { test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError @@ -639,32 +639,32 @@ namespace eval ::testmathop { test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] - lappend exp "can't use non-numeric string as operand of \"$op\"\ + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] - lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ + lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} @@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] - lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] - lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] - lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] - lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] - lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { @@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } { set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 @@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } { set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] @@ -1240,9 +1240,9 @@ test mathop-25.23 { exp operator errors } { lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 diff --git a/tests/string.test b/tests/string.test index f558d30..e9e6e6d 100644 --- a/tests/string.test +++ b/tests/string.test @@ -280,10 +280,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} { } 0 test string-5.17 {string index, bad integer} -body { list [catch {string index "abc" 0o8} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.18 {string index, bad integer} -body { list [catch {string index "abc" end-0o0289} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.19 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] -1 } {} diff --git a/tests/stringComp.test b/tests/stringComp.test index 56fb69d..017e768 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -339,11 +339,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} -body { proc foo {} {string index "abc" 0o8} list [catch {foo} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test stringComp-5.18 {string index, bad integer} -body { proc foo {} {string index "abc" end-0o0289} list [catch {foo} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo diff --git a/tests/while-old.test b/tests/while-old.test index ee17d0b..e33bd0b 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} { test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 diff --git a/tests/while.test b/tests/while.test index 642ec93..c25b404 100644 --- a/tests/while.test +++ b/tests/while.test @@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body { } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ @@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body { test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while -- cgit v0.12 From 80630f4ec9d479d7a28d3379a9e19fe08187f250 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 Nov 2012 21:17:29 +0000 Subject: Burn the bridge back to obsolete [puts] syntax. (Tcl 6?!) --- generic/tclIOCmd.c | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 005713d..2b3e805 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -139,19 +139,6 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if TCL_MAJOR_VERSION < 9 - } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - chanObjPtr = objv[1]; - string = objv[2]; - break; -#endif } /* Fall through */ default: /* [puts] or -- cgit v0.12 From f4fb1d1752d1317c4b43ea6d95516cc53d641210 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 18 Nov 2012 16:54:16 +0000 Subject: On-hold at Don Porter's request. change stub library to detect - and generate a nice error-message - when a shared library compiled for Tcl 8.x is attempted to be loaded in Tcl 9.x: Tcl 9 will not have the iPtr->result field so we cannot use that any more. --- generic/tclStubLib.c | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 1ab7ff3..b204306 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -38,19 +38,40 @@ TclIntPlatStubs *tclIntPlatStubsPtr = NULL; static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp)); +typedef Tcl_Obj *(NewStringObjProc) _ANSI_ARGS_((CONST char *bytes, + size_t length)); + + static TclStubs * HasStubSupport (interp) Tcl_Interp *interp; { Interp *iPtr = (Interp *) interp; - if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { - return iPtr->stubTable; + if (!iPtr->stubTable) { + /* No stub table at all? Nothing we can do. */ + return NULL; } - interp->result = "This interpreter does not support stubs-enabled extensions."; - interp->freeProc = TCL_STATIC; - - return NULL; + if (iPtr->stubTable->magic != TCL_STUB_MAGIC) { + /* + * We cannot acces interp->result and interp->freeProc + * any more: They will be gone in Tcl 9. In stead, + * assume that the iPtr->stubTable entry from Tcl_Interp + * and the Tcl_NewStringObj() and Tcl_SetObjResult() entries + * in the stub table don't change in Tcl 9. Need to add + * a test-case in Tcl 9 to assure that. + * + * The signature of Tcl_NewStringObj will change: the length + * parameter will be of type size_t. But passing the value + * (size_t)-1 will work, whatever the signature will be. + */ + NewStringObjProc *newStringObj = (NewStringObjProc *) + iPtr->stubTable->tcl_NewStringObj; + iPtr->stubTable->tcl_SetObjResult(interp, newStringObj( + "This extension is compiled for Tcl 8.x", (size_t)-1)); + return NULL; + } + return iPtr->stubTable; } /* -- cgit v0.12 From 44869c9e35948e1217a567f936d638d98da61705 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Nov 2012 08:30:11 +0000 Subject: Better solution for handling errors from Tcl 8.x compiled extensions. Works for existing ones. --- generic/tclLoad.c | 10 ++++++++-- generic/tclStubLib.c | 3 +-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 5cacab1..a2cdc04 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -463,14 +463,20 @@ Tcl_LoadObjCmd( } code = pkgPtr->initProc(target); } - /* * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ if (code != TCL_OK) { - Tcl_TransferResult(target, code, interp); + Interp *iPtr = (Interp *) target; + if (iPtr->result != NULL) { + /* We have an Tcl 8.x extension with incompatible stub table. */ + Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); + Tcl_SetObjResult(interp, obj); + } else { + Tcl_TransferResult(target, code, interp); + } goto done; } diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index bd8f6e7..be2c966 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -52,8 +52,7 @@ HasStubSupport( */ iPtr->stubTable->tcl_SetObjResult(interp, iPtr->stubTable->tcl_NewStringObj( - "This extension is compiled for Tcl 9.x", - TCL_NOSIZE)); + "This extension is compiled for Tcl 9.x", -1)); return NULL; } return iPtr->stubTable; -- cgit v0.12 From c4b5bfbd507454a4c2dfa42c34eeb33579833735 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Nov 2012 11:17:58 +0000 Subject: Remove some undocumented - obsolete - function from the API with 'Old' in the name. --- generic/tcl.decls | 16 ++++++++-------- generic/tclDecls.h | 16 ++++++---------- generic/tclIO.c | 53 --------------------------------------------------- generic/tclInt.decls | 16 +++++++++------- generic/tclIntDecls.h | 18 ++++++----------- generic/tclStubInit.c | 20 ++++--------------- 6 files changed, 33 insertions(+), 106 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 986f2d7..3d1458f 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -780,10 +780,10 @@ declare 218 { declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Obsolete -declare 220 { - int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) -} +# Removed in Tcl 9 +#declare 220 { +# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +#} declare 221 { int Tcl_ServiceAll(void) } @@ -868,10 +868,10 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Obsolete -declare 246 { - int Tcl_TellOld(Tcl_Channel chan) -} +# Removed in Tcl 9 +#declare 246 { +# int Tcl_TellOld(Tcl_Channel chan) +#} declare 247 { int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3690a77..114fdf4 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -648,8 +648,7 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ EXTERN int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr); -/* 220 */ -EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); +/* Slot 220 is reserved */ /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ @@ -718,8 +717,7 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, Tcl_PackageInitProc *safeInitProc); /* 245 */ EXTERN int Tcl_StringMatch(const char *str, const char *pattern); -/* 246 */ -EXTERN int Tcl_TellOld(Tcl_Channel chan); +/* Slot 246 is reserved */ /* 247 */ EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, @@ -2048,7 +2046,7 @@ typedef struct TclStubs { void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ - int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ + void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ @@ -2074,7 +2072,7 @@ typedef struct TclStubs { void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ - int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ + void (*reserved246)(void); int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ @@ -2931,8 +2929,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ -#define Tcl_SeekOld \ - (tclStubsPtr->tcl_SeekOld) /* 220 */ +/* Slot 220 is reserved */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ @@ -2983,8 +2980,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_StaticPackage) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ +/* Slot 246 is reserved */ #define Tcl_TraceVar \ (tclStubsPtr->tcl_TraceVar) /* 247 */ #define Tcl_TraceVar2 \ diff --git a/generic/tclIO.c b/generic/tclIO.c index 0cb9fa9..5bd0e2a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7059,47 +7059,6 @@ Tcl_Tell( /* *--------------------------------------------------------------------------- * - * Tcl_SeekOld, Tcl_TellOld -- - * - * Backward-compatability versions of the seek/tell interface that do not - * support 64-bit offsets. This interface is not documented or expected - * to be supported indefinitely. - * - * Results: - * As for Tcl_Seek and Tcl_Tell respectively, except truncated to - * whatever value will fit in an 'int'. - * - * Side effects: - * As for Tcl_Seek and Tcl_Tell respectively. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_SeekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - Tcl_WideInt wOffset, wResult; - - wOffset = Tcl_LongAsWide((long) offset); - wResult = Tcl_Seek(chan, wOffset, mode); - return (int) Tcl_WideAsLong(wResult); -} - -int -Tcl_TellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); -} - -/* - *--------------------------------------------------------------------------- - * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. @@ -9006,18 +8965,6 @@ ZeroTransferTimerProc( */ int -TclCopyChannelOld( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Channel inChan, /* Channel to read from. */ - Tcl_Channel outChan, /* Channel to write to. */ - int toRead, /* Amount of data to copy, or -1 for all. */ - Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ -{ - return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, - cmdPtr); -} - -int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index e310293..2b6860f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -51,10 +51,11 @@ declare 6 { declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } -declare 8 { - int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, - Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) -} +# Removed in Tcl 9 +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. @@ -420,9 +421,10 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -declare 104 { - int TclSockMinimumBuffersOld(int sock, int size) -} +# Removed in Tcl 9 +#declare 104 { +# int TclSockMinimumBuffersOld(int sock, int size) +#} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index af0cbac..da3b1ae 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -69,10 +69,7 @@ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ EXTERN int TclCopyAndCollapse(int count, const char *src, char *dst); -/* 8 */ -EXTERN int TclCopyChannelOld(Tcl_Interp *interp, - Tcl_Channel inChan, Tcl_Channel outChan, - int toRead, Tcl_Obj *cmdPtr); +/* Slot 8 is reserved */ /* 9 */ EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, @@ -260,8 +257,7 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* 104 */ -EXTERN int TclSockMinimumBuffersOld(int sock, int size); +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -611,7 +607,7 @@ typedef struct TclIntStubs { int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ - int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ + void (*reserved8)(void); int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ @@ -707,7 +703,7 @@ typedef struct TclIntStubs { const char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ - int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ + void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); @@ -882,8 +878,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ -#define TclCopyChannelOld \ - (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ +/* Slot 8 is reserved */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ @@ -1029,8 +1024,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -#define TclSockMinimumBuffersOld \ - (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 9fcb1d3..582e739 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -42,18 +42,6 @@ #undef TclpGetPid #undef TclSockMinimumBuffers -/* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#ifdef _WIN64 -# define TclSockMinimumBuffersOld 0 -#else -#define TclSockMinimumBuffersOld sockMinimumBuffersOld -static int TclSockMinimumBuffersOld(int sock, int size) -{ - return TclSockMinimumBuffers(INT2PTR(sock), size); -} -#endif - - #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS #define TclWinNToHS winNToHS @@ -193,7 +181,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -289,7 +277,7 @@ static const TclIntStubs tclIntStubs = { TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -874,7 +862,7 @@ const TclStubs tclStubs = { Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - Tcl_SeekOld, /* 220 */ + 0, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ @@ -900,7 +888,7 @@ const TclStubs tclStubs = { Tcl_SplitPath, /* 243 */ Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ + 0, /* 246 */ Tcl_TraceVar, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ -- cgit v0.12 From e59a1e0b1444fee36e3fed174465983c356e11f5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Nov 2012 21:45:34 +0000 Subject: eliminate unused variable --- generic/tclStrToD.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 9f81c13..2287a16 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -525,7 +525,6 @@ TclParseNumber( char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ - int explicitOctal = 0; #define ALL_BITS (~(Tcl_WideUInt)0) #define MOST_BITS (ALL_BITS >> 1) @@ -637,7 +636,6 @@ TclParseNumber( goto zerob; } if (c == 'o' || c == 'O') { - explicitOctal = 1; state = ZERO_O; break; } -- cgit v0.12 From dde5a2565e391dd7f91885bb2f18c51f15c05c87 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Nov 2012 21:46:51 +0000 Subject: Single stub library can now handle Tcl8 and Tcl9 with different MAGIC values --- generic/tcl.h | 15 ++++++------ generic/tclStubLib.c | 14 +++++++----- generic/tclStubLibCompat.c | 57 ++++++++++++++++++++++++++++++++++++++++++++++ unix/Makefile.in | 10 +++++++- win/Makefile.in | 4 ++++ win/makefile.vc | 1 + 6 files changed, 86 insertions(+), 15 deletions(-) create mode 100644 generic/tclStubLibCompat.c diff --git a/generic/tcl.h b/generic/tcl.h index c18b251..b69160d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2277,7 +2277,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * stubs tables. */ -#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + sizeof(size_t)) +#define TCL_STUB_MAGIC ((int) (0xFCA3BACB + sizeof(size_t))) /* * The following function is required to be defined in all stubs aware @@ -2286,8 +2286,8 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * main library in case an extension is statically linked into an application. */ -const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, - int exact); +const char * TclInitStubs(Tcl_Interp *interp, const char *version, + int exact, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); @@ -2295,16 +2295,15 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, * When not using stubs, make it a macro. */ -#ifndef USE_TCL_STUBS +#ifdef USE_TCL_STUBS +#define Tcl_InitStubs(interp, version, exact) \ + TclInitStubs(interp, version, exact, TCL_STUB_MAGIC) +#else #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) #endif /* - * TODO - tommath stubs export goes here! - */ - -/* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index be2c966..bd80ec1 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -34,7 +34,8 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; static const TclStubs * HasStubSupport( - Tcl_Interp *interp) + Tcl_Interp *interp, + int magic) { Interp *iPtr = (Interp *) interp; @@ -42,7 +43,7 @@ HasStubSupport( /* No stub table at all? Nothing we can do. */ return NULL; } - if (iPtr->stubTable->magic != TCL_STUB_MAGIC) { + if (iPtr->stubTable->magic != magic) { /* * The iPtr->stubTable entry from Tcl_Interp and the * Tcl_NewStringObj() and Tcl_SetObjResult() entries @@ -70,7 +71,7 @@ static int isDigit(const int c) /* *---------------------------------------------------------------------- * - * Tcl_InitStubs -- + * TclInitStubs -- * * Tries to initialise the stub table pointers and ensures that the * correct version of Tcl is loaded. @@ -86,10 +87,11 @@ static int isDigit(const int c) */ MODULE_SCOPE const char * -Tcl_InitStubs( +TclInitStubs( Tcl_Interp *interp, const char *version, - int exact) + int exact, + int magic) { const char *actualVersion = NULL; ClientData pkgData = NULL; @@ -100,7 +102,7 @@ Tcl_InitStubs( * times. [Bug 615304] */ - tclStubsPtr = HasStubSupport(interp); + tclStubsPtr = HasStubSupport(interp, magic); if (!tclStubsPtr) { return NULL; } diff --git a/generic/tclStubLibCompat.c b/generic/tclStubLibCompat.c new file mode 100644 index 0000000..7d8c5c3 --- /dev/null +++ b/generic/tclStubLibCompat.c @@ -0,0 +1,57 @@ +/* + * tclStubLibCompat.c -- + * + * Stub object that will be statically linked into extensions that want + * to access Tcl. + * + * Copyright (c) 2012 Jan Nijtmans + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +/* + * Small wrapper, which allows Tcl8 extensions to use the same stub + * library as Tcl 9. + */ + +#include "tclInt.h" + + +/* + *---------------------------------------------------------------------- + * + * Tcl_InitStubs -- + * + * Tries to initialise the stub table pointers and ensures that the + * correct version of Tcl is loaded. + * + * Results: + * The actual version of Tcl that satisfies the request, or NULL to + * indicate that an error occurred. + * + * Side effects: + * Sets the stub table pointers. + * + *---------------------------------------------------------------------- + */ +#undef Tcl_InitStubs + +MODULE_SCOPE const char * +Tcl_InitStubs( + Tcl_Interp *interp, + const char *version, + int exact) +{ + /* Use the hardcoded Tcl8 magic value here. */ + return TclInitStubs(interp, version, exact, (int) 0xFCA3BACF); +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ + diff --git a/unix/Makefile.in b/unix/Makefile.in index 4f66646..9a7d6db 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -335,7 +335,11 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o -STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS} +STUB_LIB_OBJS = tclStubLib.o \ + tclStubLibCompat.o \ + tclTomMathStubLib.o \ + tclOOStubLib.o \ + ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ @@ -468,6 +472,7 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ + $(GENERIC_DIR)/tclStubLibCompat.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c @@ -1656,6 +1661,9 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c +tclStubLibCompat.o: $(GENERIC_DIR)/tclStubLibCompat.c + $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLibCompat.c + tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c diff --git a/win/Makefile.in b/win/Makefile.in index dacbbb5..6b9685d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -378,6 +378,7 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ + tclStubLibCompat.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) @@ -505,6 +506,9 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported +tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) diff --git a/win/makefile.vc b/win/makefile.vc index 2784140..823142f 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -448,6 +448,7 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ + $(TMP_DIR)\tclStubLibCompat.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj -- cgit v0.12 From f4ed4079b7abc8e42b9f1c1a4cbc8cc948673606 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Nov 2012 22:34:32 +0000 Subject: make windde and winreg load again --- win/tclWinDde.c | 2 +- win/tclWinReg.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d0600e6..5cf7d60 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -157,7 +157,7 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.1", 0)) { + if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { return TCL_ERROR; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 6ac5caf..dadfa2b 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -165,7 +165,7 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } -- cgit v0.12 From d29d888dc616e6f2815075b28608f5ba03da3fd5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Nov 2012 08:40:56 +0000 Subject: Add checks for the assumtions made in tclStubLib.c, making sure that those assumtions are maintained for Tcl 9! If not, extensions compiled for Tcl9 but loaded in Tcl8 (with an incompatible stub table) cannot produce a nice error-message any more.

This is probably not the best place to do the check, maybe it's better to do this in tclTest.c, as part of the test suite.

Feedback welcome! --- generic/tclBasic.c | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 2735abc..63bc4b8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -431,6 +431,14 @@ TclFinalizeEvaluation(void) *---------------------------------------------------------------------- */ +/* Template for internal Interp structure: the stubTable entry cannot move! */ +typedef struct { + char *dumm1; + Tcl_FreeProc *dummy2; + int dummy3; + const struct TclStubs *stubTable; +} InterpTemplate; + Tcl_Interp * Tcl_CreateInterp(void) { @@ -466,6 +474,21 @@ Tcl_CreateInterp(void) /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } + if ((void *) tclStubs.tcl_SetObjResult + != (void *)((&(tclStubs.tcl_PkgProvideEx))[235])) { + /*NOTREACHED*/ + Tcl_Panic("Tcl_SetObjResult entry in the stub table must be kept"); + } + if ((void *) tclStubs.tcl_NewStringObj + != (void *)((&(tclStubs.tcl_PkgProvideEx))[56])) { + /*NOTREACHED*/ + Tcl_Panic("Tcl_NewStringObj entry in the stub table must be kept"); + } + if (offsetof(InterpTemplate, stubTable) + != offsetof(Interp, stubTable)) { + /*NOTREACHED*/ + Tcl_Panic("stubsTable entry in the Interp structure must be kept"); + } if (cancelTableInitialized == 0) { Tcl_MutexLock(&cancelLock); -- cgit v0.12 From d2b1e66352e07f5adca772ea04e970f6573995c8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Nov 2012 08:42:36 +0000 Subject: ... make it more portable --- generic/tclBasic.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 63bc4b8..6ce06fe 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -484,8 +484,8 @@ Tcl_CreateInterp(void) /*NOTREACHED*/ Tcl_Panic("Tcl_NewStringObj entry in the stub table must be kept"); } - if (offsetof(InterpTemplate, stubTable) - != offsetof(Interp, stubTable)) { + if (TclOffset(InterpTemplate, stubTable) + != TclOffset(Interp, stubTable)) { /*NOTREACHED*/ Tcl_Panic("stubsTable entry in the Interp structure must be kept"); } -- cgit v0.12 From 56b69c4e9a3935058b4fc2dedbfe3051b3a154a4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 20 Nov 2012 09:01:46 +0000 Subject: It might be that iPtr->result points to an empty string but that iPtr->objResult contains the real error-message. So, handle that too. --- generic/tclLoad.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index a2cdc04..61c763f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -470,7 +470,7 @@ Tcl_LoadObjCmd( if (code != TCL_OK) { Interp *iPtr = (Interp *) target; - if (iPtr->result != NULL) { + if (iPtr->result != NULL && iPtr->result[0] != '\0') { /* We have an Tcl 8.x extension with incompatible stub table. */ Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); Tcl_SetObjResult(interp, obj); -- cgit v0.12 From c4cf77f310c13ca824b3bbc07d5d7604c827d158 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Nov 2012 14:29:58 +0000 Subject: Removed functions marked deprecated or obsolete for a long time: Tcl_Backslash, Tcl_EvalFile, Tcl_GlobalEvalObj, Tcl_GlobalEval, Tcl_EvalTokens. Remove Tcl_FindExecutable from stub table: It is needed by embedders, not extenders. Remove TclpGetDate, TclpGmtime, TclpLocaltime: it isn't use anywhere since the new clock implementation. Remove TclWinConvertWSAError, it's the same as TclWinConvertError. --- doc/AllowExc.3 | 3 +- doc/Backslash.3 | 47 ------- doc/CrtInterp.3 | 39 +++--- doc/DString.3 | 8 +- doc/Eval.3 | 45 +------ doc/ParseCmd.3 | 24 +--- doc/RecEvalObj.3 | 4 +- doc/RecordEval.3 | 3 +- doc/SetRecLmt.3 | 4 +- doc/info.n | 2 +- generic/tcl.decls | 44 ++++--- generic/tcl.h | 14 +-- generic/tclBasic.c | 94 +------------- generic/tclDecls.h | 58 ++++----- generic/tclIOUtil.c | 16 --- generic/tclInt.decls | 30 ++--- generic/tclIntDecls.h | 24 ++-- generic/tclIntPlatDecls.h | 12 +- generic/tclMain.c | 8 +- generic/tclStubInit.c | 20 +-- generic/tclTest.c | 8 +- generic/tclThreadTest.c | 4 +- generic/tclUtil.c | 34 ------ generic/tclVar.c | 3 - unix/tclUnixTime.c | 120 ------------------ win/tclAppInit.c | 2 +- win/tclWinTime.c | 306 ---------------------------------------------- 27 files changed, 133 insertions(+), 843 deletions(-) delete mode 100644 doc/Backslash.3 diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index ae595f1..0477c88 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -30,8 +30,7 @@ or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR return with an appropriate message. The particular script evaluation procedures of Tcl that act in the manner are \fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR, -\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and -\fBTcl_VarEvalVA\fR. +\fBTcl_VarEval\fR and \fBTcl_VarEvalVA\fR. .PP However, if \fBTcl_AllowExceptions\fR is invoked immediately before calling one of those a procedures, then arbitrary completion diff --git a/doc/Backslash.3 b/doc/Backslash.3 deleted file mode 100644 index 8b399fc..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -1,47 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.so man.macros -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.BS -.SH NAME -Tcl_Backslash \- parse a backslash sequence -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -char -\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) -.SH ARGUMENTS -.AS char *countPtr out -.AP char *src in -Pointer to a string starting with a backslash. -.AP int *countPtr out -If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled -in with number of characters in the backslash sequence, including -the backslash character. -.BE - -.SH DESCRIPTION -.PP -The use of \fBTcl_Backslash\fR is deprecated in favor of -\fBTcl_UtfBackslash\fR. -.PP -This is a utility procedure provided for backwards compatibility with -non-internationalized Tcl extensions. It parses a backslash sequence and -returns the low byte of the Unicode character corresponding to the sequence. -\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of -characters in the backslash sequence. -.PP -See the Tcl manual entry for information on the valid backslash sequences. -All of the sequences described in the Tcl manual entry are supported by -\fBTcl_Backslash\fR. -.SH "SEE ALSO" -Tcl(n), Tcl_UtfBackslash(3) - -.SH KEYWORDS -backslash, parse diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index a248cf4..d8ee2cc 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -107,31 +107,30 @@ uses. \fBInterpreter Creation And Deletion\fR . When a new interpreter is created and used in a call to \fBTcl_Eval\fR, -\fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or -\fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and -\fBTcl_Release\fR should be wrapped around all uses of the interpreter. -Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR -has been called. To ensure that the interpreter is properly deleted when -it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other -code already called \fBTcl_DeleteInterp\fR; if not, call -\fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code. +\fBTcl_VarEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of calls +to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all +uses of the interpreter. Remember that it is unsafe to use the interpreter +once \fBTcl_Release\fR has been called. To ensure that the interpreter is +properly deleted when it is no longer needed, call \fBTcl_InterpDeleted\fR +to test if some other code already called \fBTcl_DeleteInterp\fR; if not, +call \fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own +code. .TP \fBRetrieving An Interpreter From A Data Structure\fR . When an interpreter is retrieved from a data structure (e.g. the client data of a callback) for use in one of the evaluation functions -(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_EvalObjv\fR, -etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, -\fBTcl_SetVar2Ex\fR, etc.), a pair of -calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around -all uses of the interpreter; it is unsafe to reuse the interpreter once -\fBTcl_Release\fR has been called. If an interpreter is stored inside a -callback data structure, an appropriate deletion cleanup mechanism should -be set up by the code that creates the data structure so that the -interpreter is removed from the data structure (e.g. by setting the field -to NULL) when the interpreter is deleted. Otherwise, you may be using an -interpreter that has been freed and whose memory may already have been -reused. +(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_EvalObjv\fR etc.) or variable +access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, \fBTcl_SetVar2Ex\fR, +etc.), a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should +be wrapped around all uses of the interpreter; it is unsafe to reuse the +interpreter once \fBTcl_Release\fR has been called. If an interpreter is +stored inside a callback data structure, an appropriate deletion cleanup +mechanism should be set up by the code that creates the data structure so +that the interpreter is removed from the data structure (e.g. by setting +the field to NULL) when the interpreter is deleted. Otherwise, you may be +using an interpreter that has been freed and whose memory may already have +been reused. .PP All uses of interpreters in Tcl and Tk have already been protected. Extension writers should ensure that their code also properly protects any diff --git a/doc/DString.3 b/doc/DString.3 index a85b1cf..9f097ab 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -9,7 +9,7 @@ .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings +Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings .SH SYNOPSIS .nf \fB#include \fR @@ -34,8 +34,6 @@ char * .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp -\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR) -.sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) @@ -128,10 +126,6 @@ caller to fill in the new space. even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP -\fBTcl_DStringTrunc\fR changes the length of a dynamic string. -This procedure is now deprecated. \fBTcl_DStringSetLength\fR should -be used instead. -.PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. diff --git a/doc/Eval.3 b/doc/Eval.3 index 0ecf7fa..f1c7c46 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -10,7 +10,7 @@ .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include \fR @@ -19,9 +19,6 @@ int \fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR) .sp int -\fBTcl_EvalFile\fR(\fIinterp, fileName\fR) -.sp -int \fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR) .sp int @@ -31,12 +28,6 @@ int \fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR) .sp int -\fBTcl_GlobalEval\fR(\fIinterp, script\fR) -.sp -int -\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) -.sp -int \fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR) .sp int @@ -93,22 +84,6 @@ integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP -\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates -its contents as a Tcl script. It returns the same information as -\fBTcl_EvalObjEx\fR. -If the file could not be read then a Tcl error is returned to describe -why the file could not be read. -The eofchar for files is -.QW \e32 -(^Z) for all platforms. If you require a -.QW ^Z -in code for string comparison, you can use -.QW \e032 -or -.QW \eu001a , -which will be safely substituted by the Tcl interpreter into -.QW ^Z . -.PP \fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a script. The \fIobjc\fR and \fIobjv\fR arguments contain the values of the words for the Tcl command, one word in each value in @@ -128,23 +103,11 @@ might be a UTF-8 special code. The string is parsed and executed directly bytecodes. In situations where it is known that the script will never be executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR. \fBTcl_Eval\fR returns a completion code and result just like -\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before -Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to -\fIinterp->result\fR (use is deprecated) where it can be accessed directly. - This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which -does not do the copy. +\fBTcl_EvalObjEx\fR. .PP \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes -additional arguments \fInumBytes\fR and \fIflags\fR. For the -efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred -over \fBTcl_Eval\fR. -.PP -\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures -that are now deprecated. They are similar to \fBTcl_EvalEx\fR and -\fBTcl_EvalObjEx\fR except that the script is evaluated in the global -namespace and its variable context consists of global variables only -(it ignores any Tcl procedures that are active). These functions are -equivalent to using the \fBTCL_EVAL_GLOBAL\fR flag (see below). +additional arguments \fInumBytes\fR and \fIflags\fR. \fBTcl_EvalEx\fR +is generally preferred over \fBTcl_Eval\fR. .PP \fBTcl_VarEval\fR takes any number of string arguments of any length, concatenates them into a single string, diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 5fd9b9c..984f56a 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include \fR @@ -33,20 +33,16 @@ const char * .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp -Tcl_Obj * -\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) -.sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR -and \fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR and +\fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, -determines the context for evaluating the -script and also is used for error reporting; must not be NULL. +For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating +the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in @@ -191,16 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. -.PP -\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in -the return convention used: it returns the result in a new Tcl_Obj. -The reference count of the value returned as result has been -incremented, so the caller must -invoke \fBTcl_DecrRefCount\fR when it is finished with the value. -If an error or other exception occurs while evaluating the tokens -(such as a reference to a non-existent variable) then the return value -is NULL and an error message is left in \fIinterp\fR's result. The use -of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index 44888f6..4629f1e 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.3 @@ -31,9 +31,7 @@ the command at global level instead of the current stack level. .SH DESCRIPTION .PP \fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event -on the history list and then execute it using \fBTcl_EvalObjEx\fR -(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set -in \fIflags\fR). +on the history list and then execute it using \fBTcl_EvalObjEx\fR. It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR, as well as a result value containing additional information (a result value or error message) diff --git a/doc/RecordEval.3 b/doc/RecordEval.3 index a29f974..2bd5581 100644 --- a/doc/RecordEval.3 +++ b/doc/RecordEval.3 @@ -31,8 +31,7 @@ the command at global level instead of the current stack level. .SH DESCRIPTION .PP \fBTcl_RecordAndEval\fR is invoked to record a command as an event -on the history list and then execute it using \fBTcl_Eval\fR -(or \fBTcl_GlobalEval\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set in \fIflags\fR). +on the history list and then execute it using \fBTcl_Eval\fR. It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_Eval\fR and it leaves information in the interpreter's result. If you do not want the command recorded on the history list then diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index e38ba2f..1ab5384 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -29,8 +29,8 @@ New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .PP At any given time Tcl enforces a limit on the number of recursive calls that may be active for \fBTcl_Eval\fR and related procedures -such as \fBTcl_GlobalEval\fR. -Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with +such as \fBTcl_EvalEx\fR. +Any call to \fBTcl_EvalEx\fR that exceeds this depth is aborted with an error. By default the recursion limit is 1000. .PP diff --git a/doc/info.n b/doc/info.n index e65a083..2ef33af 100644 --- a/doc/info.n +++ b/doc/info.n @@ -357,7 +357,7 @@ namespace separator. \fBinfo script\fR ?\fIfilename\fR? . If a Tcl script file is currently being evaluated (i.e. there is a -call to \fBTcl_EvalFile\fR active or there is an active invocation +call to \fBTcl_FSEvalFile\fR active or there is an active invocation of the \fBsource\fR command), then this command returns the name of the innermost file being processed. If \fIfilename\fR is specified, then the return value of this command will be modified for the diff --git a/generic/tcl.decls b/generic/tcl.decls index 3d1458f..818f713 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -285,9 +285,10 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -declare 77 { - char Tcl_Backslash(const char *src, int *readPtr) -} +# Removed in 9.0 +#declare 77 { +# char Tcl_Backslash(const char *src, int *readPtr) +#} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) @@ -469,10 +470,10 @@ declare 128 { declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } -# This is obsolete, use Tcl_FSEvalFile -declare 130 { - int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) -} +# Removed in 9.0: +#declare 130 { +# int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) +#} declare 131 { int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } @@ -514,9 +515,10 @@ declare 142 { declare 143 { void Tcl_Finalize(void) } -declare 144 { - void Tcl_FindExecutable(const char *argv0) -} +# Removed in 9.0: +#declare 144 { +# void Tcl_FindExecutable(const char *argv0) +#} declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) @@ -633,12 +635,13 @@ declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 177 { - int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) -} -declare 178 { - int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in Tcl 9.0 +#declare 177 { +# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) +#} +#declare 178 { +# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 179 { int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken) @@ -1266,10 +1269,11 @@ declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -declare 357 { - Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count) -} +# Removed in 9.0: +#declare 357 { +# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, +# int count) +#} declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } diff --git a/generic/tcl.h b/generic/tcl.h index b69160d..b9ff28c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -910,7 +910,6 @@ typedef struct Tcl_DString { #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) -#define Tcl_DStringTrunc Tcl_DStringSetLength /* * Definitions for the maximum number of digits of precision that may be @@ -2310,6 +2309,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) +EXTERN void Tcl_FindExecutable(const char *argv0); EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, @@ -2494,21 +2494,9 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); # undef Tcl_EvalObj # define Tcl_EvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),0) -# undef Tcl_GlobalEvalObj -# define Tcl_GlobalEvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif /* !TCL_NO_DEPRECATED */ -/* - *---------------------------------------------------------------------------- - * Convenience declaration of Tcl_AppInit for backwards compatibility. This - * function is not *implemented* by the tcl library, so the storage class is - * neither DLLEXPORT nor DLLIMPORT. - */ - -extern Tcl_AppInitProc Tcl_AppInit; - #endif /* RC_INVOKED */ /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 6ce06fe..146247e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4477,54 +4477,6 @@ Tcl_EvalTokensStandard( /* *---------------------------------------------------------------------- * - * Tcl_EvalTokens -- - * - * Given an array of tokens parsed from a Tcl command (e.g., the tokens - * that make up a word or the index for an array variable) this function - * evaluates the tokens and concatenates their values to form a single - * result value. - * - * Results: - * The return value is a pointer to a newly allocated Tcl_Obj containing - * the value of the array of tokens. The reference count of the returned - * object has been incremented. If an error occurs in evaluating the - * tokens then a NULL value is returned and an error message is left in - * interp's result. - * - * Side effects: - * A new object is allocated to hold the result. - * - *---------------------------------------------------------------------- - * - * This uses a non-standard return convention; its use is now deprecated. It - * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used - * in the core any longer. It is only kept for backward compatibility. - */ - -Tcl_Obj * -Tcl_EvalTokens( - Tcl_Interp *interp, /* Interpreter in which to lookup variables, - * execute nested commands, and report - * errors. */ - Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to - * evaluate and concatenate. */ - int count) /* Number of tokens to consider at tokenPtr. - * Must be at least 1. */ -{ - Tcl_Obj *resPtr; - - if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) { - return NULL; - } - resPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(resPtr); - Tcl_ResetResult(interp); - return resPtr; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalEx, TclEvalEx -- * * This function evaluates a Tcl script without using the compiler or @@ -5487,7 +5439,7 @@ Tcl_Eval( /* *---------------------------------------------------------------------- * - * Tcl_EvalObj, Tcl_GlobalEvalObj -- + * Tcl_EvalObj -- * * These functions are deprecated but we keep them around for backwards * compatibility reasons. @@ -5509,14 +5461,6 @@ Tcl_EvalObj( { return Tcl_EvalObjEx(interp, objPtr, 0); } -#undef Tcl_GlobalEvalObj -int -Tcl_GlobalEvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); -} /* *---------------------------------------------------------------------- @@ -6594,42 +6538,6 @@ Tcl_VarEval( /* *---------------------------------------------------------------------- * - * Tcl_GlobalEval -- - * - * Evaluate a command at global level in an interpreter. - * - * Results: - * A standard Tcl result is returned, and the interp's result is modified - * accordingly. - * - * Side effects: - * The command string is executed in interp, and the execution is carried - * out in the variable context of global level (no functions active), - * just as if an "uplevel #0" command were being executed. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GlobalEval( - Tcl_Interp *interp, /* Interpreter in which to evaluate - * command. */ - const char *command) /* Command to evaluate. */ -{ - register Interp *iPtr = (Interp *) interp; - int result; - CallFrame *savedVarFramePtr; - - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_Eval(interp, command); - iPtr->varFramePtr = savedVarFramePtr; - return result; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetRecursionLimit -- * * Set the maximum number of recursive calls that may be active for an diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 114fdf4..e12e969 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -248,8 +248,7 @@ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); EXTERN int Tcl_AsyncReady(void); /* 76 */ EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); -/* 77 */ -EXTERN char Tcl_Backslash(const char *src, int *readPtr); +/* Slot 77 is reserved */ /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, @@ -399,9 +398,7 @@ EXTERN const char * Tcl_ErrnoId(void); EXTERN const char * Tcl_ErrnoMsg(int err); /* 129 */ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); -/* 130 */ -EXTERN int Tcl_EvalFile(Tcl_Interp *interp, - const char *fileName); +/* Slot 130 is reserved */ /* 131 */ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 132 */ @@ -438,8 +435,7 @@ EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ EXTERN void Tcl_Finalize(void); -/* 144 */ -EXTERN void Tcl_FindExecutable(const char *argv0); +/* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); @@ -535,12 +531,8 @@ EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, /* 176 */ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* 177 */ -EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, - const char *command); -/* 178 */ -EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ /* 179 */ EXTERN int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, @@ -1020,9 +1012,7 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); -/* 357 */ -EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count); +/* Slot 357 is reserved */ /* 358 */ EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ @@ -1895,7 +1885,7 @@ typedef struct TclStubs { void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ + void (*reserved77)(void); int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ @@ -1948,7 +1938,7 @@ typedef struct TclStubs { const char * (*tcl_ErrnoId) (void); /* 127 */ const char * (*tcl_ErrnoMsg) (int err); /* 128 */ int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ - int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ + void (*reserved130)(void); int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ void (*tcl_Exit) (int status); /* 133 */ @@ -1962,7 +1952,7 @@ typedef struct TclStubs { int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ - void (*tcl_FindExecutable) (const char *argv0); /* 144 */ + void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ @@ -2003,8 +1993,8 @@ typedef struct TclStubs { const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ - int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ - int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ + void (*reserved177)(void); + void (*reserved178)(void); int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ int (*tcl_Init) (Tcl_Interp *interp); /* 180 */ void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */ @@ -2183,7 +2173,7 @@ typedef struct TclStubs { char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ - Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ + void (*reserved357)(void); void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ @@ -2639,8 +2629,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ -#define Tcl_Backslash \ - (tclStubsPtr->tcl_Backslash) /* 77 */ +/* Slot 77 is reserved */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ @@ -2744,8 +2733,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ #define Tcl_Eval \ (tclStubsPtr->tcl_Eval) /* 129 */ -#define Tcl_EvalFile \ - (tclStubsPtr->tcl_EvalFile) /* 130 */ +/* Slot 130 is reserved */ #define Tcl_EvalObj \ (tclStubsPtr->tcl_EvalObj) /* 131 */ #define Tcl_EventuallyFree \ @@ -2772,8 +2760,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ -#define Tcl_FindExecutable \ - (tclStubsPtr->tcl_FindExecutable) /* 144 */ +/* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ @@ -2844,10 +2831,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetVar) /* 175 */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ -#define Tcl_GlobalEval \ - (tclStubsPtr->tcl_GlobalEval) /* 177 */ -#define Tcl_GlobalEvalObj \ - (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ @@ -3200,8 +3185,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ -#define Tcl_EvalTokens \ - (tclStubsPtr->tcl_EvalTokens) /* 357 */ +/* Slot 357 is reserved */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ @@ -3757,15 +3741,15 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_GetStringResult # undef Tcl_Init # undef Tcl_SetPanicProc -# undef Tcl_SetVar +# undef Tcl_SetVar2 # undef Tcl_StaticPackage # undef TclFSGetNativePath # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) # define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) # define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) # define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc)) -# define Tcl_SetVar(interp, varName, newValue, flags) \ - (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags)) +# define Tcl_SetVar2(interp, part1, part2, newValue, flags) \ + (tclStubsPtr->tcl_SetVar2(interp, part1, part2, newValue, flags)) #endif #if defined(_WIN32) && defined(UNICODE) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index ab08353..8773cb6 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -410,22 +410,6 @@ Tcl_GetCwd( return Tcl_DStringValue(cwdPtr); } -/* Obsolete */ -int -Tcl_EvalFile( - Tcl_Interp *interp, /* Interpreter in which to process file. */ - const char *fileName) /* Name of file to process. Tilde-substitution - * will be performed on this name. */ -{ - int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); - - Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSEvalFile(interp, pathPtr); - Tcl_DecrRefCount(pathPtr); - return ret; -} - /* * Now move on to the basic filesystem implementation. */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 2b6860f..7b77579 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -535,9 +535,10 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -declare 133 { - struct tm *TclpGetDate(const time_t *time, int useGMT) -} +# Removed in 9.0 +#declare 133 { +# struct tm *TclpGetDate(const time_t *time, int useGMT) +#} # Removed in 8.5 #declare 134 { # size_t TclpStrftime(char *s, size_t maxsize, const char *format, @@ -751,14 +752,14 @@ declare 177 { # const char *file, int line) #} -# TclpGmtime and TclpLocaltime promoted to the generic interface from unix - -declare 182 { - struct tm *TclpLocaltime(const time_t *clock) -} -declare 183 { - struct tm *TclpGmtime(const time_t *clock) -} +# Removed in 9.0 +#declare 182 { +# struct tm *TclpLocaltime(const time_t *clock) +#} +# Removed in 9.0 +#declare 183 { +# struct tm *TclpGmtime(const time_t *clock) +#} # For the new "Thread Storage" subsystem. @@ -1022,9 +1023,10 @@ interface tclIntPlat declare 0 win { void TclWinConvertError(DWORD errCode) } -declare 1 win { - void TclWinConvertWSAError(DWORD errCode) -} +# Removed in Tcl 9.0 +#declare 1 win { +# void TclWinConvertWSAError(DWORD errCode) +#} declare 2 win { struct servent *TclWinGetServByName(const char *nm, const char *proto) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index da3b1ae..bf6a21d 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -339,8 +339,7 @@ EXTERN void Tcl_SetNamespaceResolvers( Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* 133 */ -EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT); +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -444,10 +443,8 @@ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, /* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* 182 */ -EXTERN struct tm * TclpLocaltime(const time_t *clock); -/* 183 */ -EXTERN struct tm * TclpGmtime(const time_t *clock); +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -732,7 +729,7 @@ typedef struct TclIntStubs { int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ + void (*reserved133)(void); void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); @@ -781,8 +778,8 @@ typedef struct TclIntStubs { void (*reserved179)(void); void (*reserved180)(void); void (*reserved181)(void); - struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ - struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ + void (*reserved182)(void); + void (*reserved183)(void); void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); @@ -1078,8 +1075,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -#define TclpGetDate \ - (tclIntStubsPtr->tclpGetDate) /* 133 */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1158,10 +1154,8 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -#define TclpLocaltime \ - (tclIntStubsPtr->tclpLocaltime) /* 182 */ -#define TclpGmtime \ - (tclIntStubsPtr->tclpGmtime) /* 183 */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index bfce9a8..c1531f3 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -100,8 +100,7 @@ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); -/* 1 */ -EXTERN void TclWinConvertWSAError(DWORD errCode); +/* Slot 1 is reserved */ /* 2 */ EXTERN struct servent * TclWinGetServByName(const char *nm, const char *proto); @@ -278,7 +277,7 @@ typedef struct TclIntPlatStubs { #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ - void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ + void (*reserved1)(void); 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 */ @@ -405,8 +404,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ +/* Slot 1 is reserved */ #define TclWinGetServByName \ (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ #define TclWinGetSockOpt \ @@ -520,10 +518,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclpLocaltime_unix -#undef TclpGmtime_unix -#undef TclWinConvertWSAError -#define TclWinConvertWSAError TclWinConvertError #if defined(__WIN32__) || defined(__CYGWIN__) # undef TclWinNToHS diff --git a/generic/tclMain.c b/generic/tclMain.c index f445383..73989ef 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -243,7 +243,7 @@ Tcl_SourceRCFile( const char *fileName; Tcl_Channel chan; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; @@ -263,14 +263,18 @@ Tcl_SourceRCFile( c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { + Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1); + Tcl_Close(NULL, c); - if (Tcl_EvalFile(interp, fullName) != TCL_OK) { + Tcl_IncrRefCount(fullNameObj); + if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } + Tcl_DecrRefCount(fullNameObj); } } Tcl_DStringFree(&temp); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 582e739..7106d3d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -306,7 +306,7 @@ static const TclIntStubs tclIntStubs = { Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - TclpGetDate, /* 133 */ + 0, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -355,8 +355,8 @@ static const TclIntStubs tclIntStubs = { 0, /* 179 */ 0, /* 180 */ 0, /* 181 */ - TclpLocaltime, /* 182 */ - TclpGmtime, /* 183 */ + 0, /* 182 */ + 0, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -463,7 +463,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ + 0, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ @@ -711,7 +711,7 @@ const TclStubs tclStubs = { Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ Tcl_BackgroundError, /* 76 */ - Tcl_Backslash, /* 77 */ + 0, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ @@ -764,7 +764,7 @@ const TclStubs tclStubs = { Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ Tcl_Eval, /* 129 */ - Tcl_EvalFile, /* 130 */ + 0, /* 130 */ Tcl_EvalObj, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ @@ -778,7 +778,7 @@ const TclStubs tclStubs = { Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ - Tcl_FindExecutable, /* 144 */ + 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ Tcl_FreeResult, /* 147 */ @@ -819,8 +819,8 @@ const TclStubs tclStubs = { Tcl_GetStringResult, /* 174 */ Tcl_GetVar, /* 175 */ Tcl_GetVar2, /* 176 */ - Tcl_GlobalEval, /* 177 */ - Tcl_GlobalEvalObj, /* 178 */ + 0, /* 177 */ + 0, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ @@ -999,7 +999,7 @@ const TclStubs tclStubs = { Tcl_UniCharToUtfDString, /* 354 */ Tcl_UtfToUniCharDString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ - Tcl_EvalTokens, /* 357 */ + 0, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 878ffba..7a10bef 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1833,7 +1833,7 @@ TestdstringCmd( if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { return TCL_ERROR; } - Tcl_DStringTrunc(&dstring, count); + Tcl_DStringSetLength(&dstring, count); } else if (strcmp(argv[1], "start") == 0) { if (argc != 2) { goto wrongNumArgs; @@ -1959,7 +1959,7 @@ EncodingToUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -1991,7 +1991,7 @@ EncodingFromUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -4323,7 +4323,7 @@ TestfeventCmd( return TCL_ERROR; } if (interp2 != NULL) { - code = Tcl_GlobalEval(interp2, argv[2]); + code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 22b5995..c1828bb 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -835,7 +835,7 @@ ThreadSend( if (threadId == Tcl_GetCurrentThread()) { Tcl_MutexUnlock(&threadMutex); - return Tcl_GlobalEval(interp, script); + return Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); } /* @@ -1029,7 +1029,7 @@ ThreadEventProc( Tcl_Preserve(interp); Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script); - code = Tcl_GlobalEval(interp, threadEventPtr->script); + code = Tcl_EvalEx(interp, threadEventPtr->script, -1, TCL_EVAL_GLOBAL); Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 4e92772..cad6e4a 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1556,40 +1556,6 @@ Tcl_Merge( /* *---------------------------------------------------------------------- * - * Tcl_Backslash -- - * - * Figure out how to handle a backslash sequence. - * - * Results: - * The return value is the character that should be substituted in place - * of the backslash sequence that starts at src. If readPtr isn't NULL - * then it is filled in with a count of the number of characters in the - * backslash sequence. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -char -Tcl_Backslash( - const char *src, /* Points to the backslash character of a - * backslash sequence. */ - int *readPtr) /* Fill in with number of characters read from - * src, unless NULL. */ -{ - char buf[TCL_UTF_MAX]; - Tcl_UniChar ch; - - Tcl_UtfBackslash(src, readPtr, buf); - TclUtfToUniChar(buf, &ch); - return (char) ch; -} - -/* - *---------------------------------------------------------------------- - * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null diff --git a/generic/tclVar.c b/generic/tclVar.c index 1c01e41..d8a7141 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -802,9 +802,6 @@ TclObjLookupVarEx( * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers - * - * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag - * (Bug #835020) */ #define AVOID_RESOLVERS 0x40000 diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index c7921fe..6e8c5f4 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -20,18 +20,6 @@ #define IsLeapYear(x) (((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0)) /* - * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread - * safety, this structure must be in thread-specific data. The 'tmKey' - * variable is the key to this buffer. - */ - -static Tcl_ThreadDataKey tmKey; -typedef struct ThreadSpecificData { - struct tm gmtime_buf; - struct tm localtime_buf; -} ThreadSpecificData; - -/* * If we fall back on the thread-unsafe versions of gmtime and localtime, use * this mutex to try to protect them. */ @@ -251,114 +239,6 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGetDate( - const time_t *time, - int useGMT) -{ - if (useGMT) { - return TclpGmtime(time); - } else { - return TclpLocaltime(time); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - -#ifdef HAVE_GMTIME_R - gmtime_r(timePtr, &tsdPtr->gmtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->gmtime_buf; -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - - SetTZIfNecessary(); -#ifdef HAVE_LOCALTIME_R - localtime_r(timePtr, &tsdPtr->localtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->localtime_buf; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 56f45a0..5ecebea 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -193,7 +193,7 @@ Tcl_AppInit( * specific startup file will be run under any conditions. */ - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); + (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclshrc.tcl", TCL_GLOBAL_ONLY); return TCL_OK; } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index daa229d..9cfbac0 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,10 +12,6 @@ #include "tclInt.h" -#define SECSPERDAY (60L * 60L * 24L) -#define SECSPERYEAR (SECSPERDAY * 365L) -#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) - /* * Number of samples over which to estimate the performance counter. */ @@ -23,25 +19,6 @@ #define SAMPLES 64 /* - * The following arrays contain the day of year for the last day of each - * month, where index 1 is January. - */ - -static const int normalDays[] = { - -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 -}; - -static const int leapDays[] = { - -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 -}; - -typedef struct ThreadSpecificData { - char tzName[64]; /* Time zone name */ - struct tm tm; /* time information */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; - -/* * Data for managing high-resolution timers. */ @@ -113,7 +90,6 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ -static struct tm * ComputeGMT(const time_t *tp); static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -489,227 +465,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGetDate( - const time_t *t, - int useGMT) -{ - struct tm *tmPtr; - time_t time; - - if (!useGMT) { - tzset(); - - /* - * If we are in the valid range, let the C run-time library handle it. - * Otherwise we need to fake it. Note that this algorithm ignores - * daylight savings time before the epoch. - */ - - /* - * Hm, Borland's localtime manages to return NULL under certain - * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, - * since 'localtime' isn't supposed to do this, possibly leading to - * crashes. - * - * Patch: We only call this function if we are at least one day into - * the epoch, else we handle it ourselves (like we do for times < 0). - * H. Giese, June 2003 - */ - -#ifdef __BORLANDC__ -#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY -#else -#define LOCALTIME_VALIDITY_BOUNDARY 0 -#endif - - if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(t); - } - - time = *t - timezone; - - /* - * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust the - * result at the end. - */ - - if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(t); - - tzset(); - - /* - * Add the bias directly to the tm structure to avoid overflow. - * Propagate seconds overflow into minutes, hours and days. - */ - - time = tmPtr->tm_sec - timezone; - tmPtr->tm_sec = (int)(time % 60); - if (tmPtr->tm_sec < 0) { - tmPtr->tm_sec += 60; - time -= 60; - } - - time = tmPtr->tm_min + time/60; - tmPtr->tm_min = (int)(time % 60); - if (tmPtr->tm_min < 0) { - tmPtr->tm_min += 60; - time -= 60; - } - - time = tmPtr->tm_hour + time/60; - tmPtr->tm_hour = (int)(time % 24); - if (tmPtr->tm_hour < 0) { - tmPtr->tm_hour += 24; - time -= 24; - } - - time /= 24; - tmPtr->tm_mday += (int)time; - tmPtr->tm_yday += (int)time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; - } - } else { - tmPtr = ComputeGMT(t); - } - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * - * ComputeGMT -- - * - * This function computes GMT given the number of seconds since the epoch - * (midnight Jan 1 1970). - * - * Results: - * Returns a (per thread) statically allocated struct tm. - * - * Side effects: - * Updates the values of the static struct tm. - * - *---------------------------------------------------------------------- - */ - -static struct tm * -ComputeGMT( - const time_t *tp) -{ - struct tm *tmPtr; - long tmp, rem; - int isLeap; - const int *days; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tmPtr = &tsdPtr->tm; - - /* - * Compute the 4 year span containing the specified time. - */ - - tmp = (long)(*tp / SECSPER4YEAR); - rem = (long)(*tp % SECSPER4YEAR); - - /* - * Correct for weird mod semantics so the remainder is always positive. - */ - - if (rem < 0) { - tmp--; - rem += SECSPER4YEAR; - } - - /* - * Compute the year after 1900 by taking the 4 year span and adjusting for - * the remainder. This works because 2000 is a leap year, and 1900/2100 - * are out of the range. - */ - - tmp = (tmp * 4) + 70; - isLeap = 0; - if (rem >= SECSPERYEAR) { /* 1971, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR) { /* 1972, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ - tmp++; - rem -= SECSPERYEAR + SECSPERDAY; - } else { - isLeap = 1; - } - } - } - tmPtr->tm_year = tmp; - - /* - * Compute the day of year and leave the seconds in the current day in the - * remainder. - */ - - tmPtr->tm_yday = rem / SECSPERDAY; - rem %= SECSPERDAY; - - /* - * Compute the time of day. - */ - - tmPtr->tm_hour = rem / 3600; - rem %= 3600; - tmPtr->tm_min = rem / 60; - tmPtr->tm_sec = rem % 60; - - /* - * Compute the month and day of month. - */ - - days = (isLeap) ? leapDays : normalDays; - for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { - /* empty body */ - } - tmPtr->tm_mon = --tmp; - tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; - - /* - * Compute day of week. Epoch started on a Thursday. - */ - - tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; - if ((*tp % SECSPERDAY) < 0) { - tmPtr->tm_wday--; - } - tmPtr->tm_wday %= 7; - if (tmPtr->tm_wday < 0) { - tmPtr->tm_wday += 7; - } - - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -1037,67 +792,6 @@ AccumulateSample( /* *---------------------------------------------------------------------- * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of gmtime is thread safe because it returns the - * time in a block of thread-local storage, and Windows does not provide a - * Posix gmtime_r function. - */ - - return gmtime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of localtime is thread safe because it returns - * the time in a block of thread-local storage, and Windows does not - * provide a Posix localtime_r function. - */ - - return localtime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the -- cgit v0.12 From 44427fccaa4b14a7ddbeef627ea042de41cca263 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Nov 2012 15:33:47 +0000 Subject: unbreak UNIX build --- unix/tclAppInit.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 159bbd8..21dce71 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -150,9 +150,9 @@ Tcl_AppInit( */ #ifdef DJGPP - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY); + (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclsh.rc", TCL_GLOBAL_ONLY); #else - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); + (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/.tclshrc", TCL_GLOBAL_ONLY); #endif return TCL_OK; -- cgit v0.12 From 0a224ddfc82ffbb22df797a97c2fb834f5ccab6b Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 26 Nov 2012 21:25:26 +0000 Subject: Comments and renamings around the legacy fields for string results. --- generic/tclInt.h | 38 ++++++++++++++++++++------------------ generic/tclStubLib.c | 27 +++++++++++++++++++++++++-- 2 files changed, 45 insertions(+), 20 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 7ed9bdf..90f283c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1799,31 +1799,33 @@ typedef struct AllocCache { */ typedef struct Interp { + /* - * Note: the first three fields must match exactly the fields in a - * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the - * other. - * - * The interpreter's result is held in the objResultPtr field. This field - * holds the result's object value. The interpreter's result is always in - * objResultPtr. Programs should not access objResultPtr directly; - * instead, they should always get and set the result using procedures - * such as Tcl_SetObjResult, Tcl_GetObjResult, and Tcl_GetStringResult. - * See the SetResult man page for details. + * The first two fields were named "result" and "freeProc" in earlier + * versions of Tcl. They are no longer used within Tcl, and are no + * longer available to be accessed by extensions. However, they cannot + * be removed. Why? There is a deployed base of stub-enabled extensions + * that query the value of iPtr->stubTable. For them to continue to work, + * the location of the field "stubTable" within the Interp struct cannot + * change. The most robust way to assure that is to leave all fields up to + * that one undisturbed. */ - char *unused3; - Tcl_FreeProc *unused4; + char *legacyResult; + Tcl_FreeProc *legacyFreeProc; int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. On - * previous versions of Tcl this is a pointer - * to the objResultPtr or a pointer to a - * buckets array in a hash table. We therefore - * have to do some careful checking before we - * can use this. */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultPtr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 9e9208d..35c7f09 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -41,9 +41,32 @@ HasStubSupport( if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } - iPtr->unused3 + + /* + * Either interp has no stubTable field, or its magic number has been + * changed, indicating a release of Tcl that no longer supports the + * stubs mechanism with which the extension has been prepared. This + * either means interp comes from Tcl releases 7.5 - 8.0, when [load] + * of extensions was possible, but stubs were not yet in use, or it means + * interp come from some future release of Tcl where it has been necessary + * to stop supporting this particular stubs mechanism. In either case, + * we can count on the fields legacyResult and legacyFreeProc existing + * (since they persist to maintain the struct offset fo stubTable; see + * tclInt.h comments.), and we can hope that [load] or any sensible + * successor will be able to reach into them to report the mismatch error + * message sensibly. + * + * For maximum compat support, even if only for the sake of reporting + * clean errors, rather than crashing, we assume the TCL_STUB_MAGIC + * value is changed only when absolutely necessary. So long as the first + * slot in the stub table holds (some function compatible with) the routine + * Tcl_PkgRequireEx(), that routine can take care of verifying the version + * compatibility testing with all deployed + */ + + iPtr->legacyResult = "This interpreter does not support stubs-enabled extensions."; - iPtr->unused4 = TCL_STATIC; + iPtr->legacyFreeProc = TCL_STATIC; return NULL; } -- cgit v0.12 From 8c19725a30da943dd85def2579fc7210a204416a Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 26 Nov 2012 21:30:13 +0000 Subject: ...and here's the lines left behind in the editor. --- generic/tclStubLib.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 35c7f09..fe1302c 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -61,7 +61,10 @@ HasStubSupport( * value is changed only when absolutely necessary. So long as the first * slot in the stub table holds (some function compatible with) the routine * Tcl_PkgRequireEx(), that routine can take care of verifying the version - * compatibility testing with all deployed + * compatibility testing with all deployed stubs-enabled extensions. That is, + * there is no need to change the value of TCL_STUB_MAGIC when transitioning + * from the Tcl 8 stubs table to the Tcl 9 stubs table, so long as they + * share just their first slot in common. */ iPtr->legacyResult -- cgit v0.12 From 4c5cc88bdfb8a2393cc311327e5aeb63896fc7d5 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 26 Nov 2012 22:23:43 +0000 Subject: Stop segfaults in test suite. --- generic/tclBasic.c | 1 + generic/tclLoad.c | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3906c0a..abfc456 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -485,6 +485,7 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; + iPtr->legacyResult = NULL; iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); diff --git a/generic/tclLoad.c b/generic/tclLoad.c index d4c67d7..ec1c617 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -472,11 +472,12 @@ Tcl_LoadObjCmd( Interp *iPtr = (Interp *) target; if (iPtr->legacyResult != NULL) { /* - * A call to Tcl_InitStubs() determined the caller extension and this - * interp are incompatible in their stubs mechanisms, and recorded the - * error in the oldest legacy place we have to do so. + * A call to Tcl_InitStubs() determined the caller extension and + * this interp are incompatible in their stubs mechanisms, and + * recorded the error in the oldest legacy place we have to do so. */ Tcl_SetObjResult(interp, Tcl_NewStringObj(iPtr->legacyResult, -1)); + iPtr->legacyResult = NULL; } else { Tcl_TransferResult(target, code, interp); } -- cgit v0.12 From 0d78d389e17f7e34f073b6890fa44a79805c4463 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 27 Nov 2012 21:09:20 +0000 Subject: 3588687 Added cross checks so that [load]ed extension, [load]ing interp, and linked stubs library all agree on their versions in the ways that matter. --- generic/tcl.h | 9 ++++++--- generic/tclStubLib.c | 57 ++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 59 insertions(+), 7 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 147672c..74dd452 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2394,8 +2394,8 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * main library in case an extension is statically linked into an application. */ -const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, - int exact); +const char * TclInitStubs(Tcl_Interp *interp, const char *version, + int exact, int major); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); @@ -2403,7 +2403,10 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, * When not using stubs, make it a macro. */ -#ifndef USE_TCL_STUBS +#ifdef USE_TCL_STUBS +#define Tcl_InitStubs(interp, version, exact) \ + TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION) +#else #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) #endif diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index f569820..ca6f4ff 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -76,13 +76,52 @@ static int isDigit(const int c) */ MODULE_SCOPE const char * -Tcl_InitStubs( +TclInitStubs( Tcl_Interp *interp, const char *version, - int exact) + int exact, + int major) { + Interp *iPtr = (Interp *) interp; const char *actualVersion = NULL; ClientData pkgData = NULL; + const char *p, *q; + + /* + * Detect whether the extension and the stubs library were built + * against Tcl header files from different major versions. That's + * seriously broken. + */ + + if (major != TCL_MAJOR_VERSION) { + iPtr->result = + (char *)"extension linked to incompatible stubs library"; + iPtr->freeProc = TCL_STATIC; + return NULL; + } + + /* + * Detect whether an extension compiled against a Tcl header file + * of one major version is requesting to use a stubs table of a + * different major version. According to our compat rules, that's + * a request that cannot succeed. Different major versions imply + * incompatible stub tables. + */ + + p = version; + q = TCL_VERSION; + while (isDigit(*p)) { + if (*p++ != *q++) { + goto badVersion; + } + } + if (isDigit(*q)) { + badVersion: + iPtr->result = + (char *)"extension passed bad version argument to stubs library"; + iPtr->freeProc = TCL_STATIC; + return NULL; + } /* * We can't optimize this check by caching tclStubsPtr because that @@ -100,14 +139,14 @@ Tcl_InitStubs( return NULL; } if (exact) { - const char *p = version; int count = 0; + p = version; while (*p) { count += !isDigit(*p++); } if (count == 1) { - const char *q = actualVersion; + q = actualVersion; p = version; while (*p && (*p == *q)) { @@ -140,6 +179,16 @@ Tcl_InitStubs( return actualVersion; } +#undef Tcl_InitStubs +MODULE_SCOPE const char * +Tcl_InitStubs( + Tcl_Interp *interp, + const char *version, + int exact) +{ + return TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION); +} + /* * Local Variables: * mode: c -- cgit v0.12 From 206428d2cf92bd15670bf5ad8464be4f0c471d86 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 16:52:45 +0000 Subject: Get the updated error message --- generic/tclStubLib.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index e875bf7..648ed24 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -68,7 +68,7 @@ HasStubSupport( */ iPtr->legacyResult - = "This interpreter does not support stubs-enabled extensions."; + = (char *) "interpreter uses an incompatible stubs mechanism"; iPtr->legacyFreeProc = TCL_STATIC; return NULL; } -- cgit v0.12 From 03bdf41de2ee32283160a235dc221e2ab38c4b64 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 17:03:17 +0000 Subject: missed bit of merge --- generic/tclStubLib.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 648ed24..23085e2 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -85,7 +85,7 @@ static int isDigit(const int c) /* *---------------------------------------------------------------------- * - * Tcl_InitStubs -- + * TclInitStubs -- * * Tries to initialise the stub table pointers and ensures that the * correct version of Tcl is loaded. -- cgit v0.12 From cb7c84c3101a5c957ceb858bb001128b1c69290f Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 17:25:59 +0000 Subject: Proposed rollback of the TCL_STUB_MAGIC change on novem branch. --- generic/tcl.h | 7 ++--- generic/tclBasic.c | 23 -------------- generic/tclLoad.c | 3 +- generic/tclStubLib.c | 74 ++++++++++++++++++++++++++++++++-------------- generic/tclStubLibCompat.c | 57 ----------------------------------- unix/Makefile.in | 5 ---- win/Makefile.in | 4 --- win/makefile.vc | 1 - 8 files changed, 56 insertions(+), 118 deletions(-) delete mode 100644 generic/tclStubLibCompat.c diff --git a/generic/tcl.h b/generic/tcl.h index b9ff28c..91bf623 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -136,7 +136,6 @@ extern "C" { */ #include -#include /* *---------------------------------------------------------------------------- @@ -2276,7 +2275,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * stubs tables. */ -#define TCL_STUB_MAGIC ((int) (0xFCA3BACB + sizeof(size_t))) +#define TCL_STUB_MAGIC ((int) 0xFCA3BACF) /* * The following function is required to be defined in all stubs aware @@ -2286,7 +2285,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, */ const char * TclInitStubs(Tcl_Interp *interp, const char *version, - int exact, int magic); + int exact, int major, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); @@ -2296,7 +2295,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, #ifdef USE_TCL_STUBS #define Tcl_InitStubs(interp, version, exact) \ - TclInitStubs(interp, version, exact, TCL_STUB_MAGIC) + TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION, TCL_STUB_MAGIC) #else #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 146247e..4f3b77e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -431,14 +431,6 @@ TclFinalizeEvaluation(void) *---------------------------------------------------------------------- */ -/* Template for internal Interp structure: the stubTable entry cannot move! */ -typedef struct { - char *dumm1; - Tcl_FreeProc *dummy2; - int dummy3; - const struct TclStubs *stubTable; -} InterpTemplate; - Tcl_Interp * Tcl_CreateInterp(void) { @@ -474,21 +466,6 @@ Tcl_CreateInterp(void) /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } - if ((void *) tclStubs.tcl_SetObjResult - != (void *)((&(tclStubs.tcl_PkgProvideEx))[235])) { - /*NOTREACHED*/ - Tcl_Panic("Tcl_SetObjResult entry in the stub table must be kept"); - } - if ((void *) tclStubs.tcl_NewStringObj - != (void *)((&(tclStubs.tcl_PkgProvideEx))[56])) { - /*NOTREACHED*/ - Tcl_Panic("Tcl_NewStringObj entry in the stub table must be kept"); - } - if (TclOffset(InterpTemplate, stubTable) - != TclOffset(Interp, stubTable)) { - /*NOTREACHED*/ - Tcl_Panic("stubsTable entry in the Interp structure must be kept"); - } if (cancelTableInitialized == 0) { Tcl_MutexLock(&cancelLock); diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 61c763f..6f5b9cf 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -474,9 +474,8 @@ Tcl_LoadObjCmd( /* We have an Tcl 8.x extension with incompatible stub table. */ Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); Tcl_SetObjResult(interp, obj); - } else { - Tcl_TransferResult(target, code, interp); } + Tcl_TransferResult(target, code, interp); goto done; } diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index bd80ec1..f1229d5 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -34,29 +34,17 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; static const TclStubs * HasStubSupport( - Tcl_Interp *interp, - int magic) + Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; - if (!iPtr->stubTable) { - /* No stub table at all? Nothing we can do. */ - return NULL; - } - if (iPtr->stubTable->magic != magic) { - /* - * The iPtr->stubTable entry from Tcl_Interp and the - * Tcl_NewStringObj() and Tcl_SetObjResult() entries - * in the stub table cannot change in Tcl 9 compared - * to Tcl 8.x. Otherwise the lines below won't work. - * TODO: add a test case for that. - */ - iPtr->stubTable->tcl_SetObjResult(interp, - iPtr->stubTable->tcl_NewStringObj( - "This extension is compiled for Tcl 9.x", -1)); - return NULL; + if (iPtr->stubTable && iPtr->stubTable->magic == TCL_STUB_MAGIC) { + return iPtr->stubTable; } - return iPtr->stubTable; + iPtr->result = + (char *) "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; + return NULL; } /* @@ -91,10 +79,52 @@ TclInitStubs( Tcl_Interp *interp, const char *version, int exact, + int major, int magic) { + Interp *iPtr = (Interp *) interp; const char *actualVersion = NULL; ClientData pkgData = NULL; + const char *p, *q; + + /* + * Detect whether the extension and the stubs library were built + * against Tcl header files declaring use of incompatible stubs + * mechanisms. Even within the same mechanism, also detect if + * the header files are from different major versions. Either + * is seriously broken. An extension and its stubs library ought + * to share compatible headers, if not the same one. + */ + + if (magic != TCL_STUB_MAGIC || major != TCL_MAJOR_VERSION) { + iPtr->result = + (char *) "extension linked to incompatible stubs library"; + iPtr->freeProc = TCL_STATIC; + return NULL; + } + + /* + * Detect whether an extension compiled against a Tcl header file + * of one major version is requesting to use a stubs table of a + * different major version. According to our compat rules, that's + * a request that cannot succeed. Different major versions imply + * incompatible stub tables. + */ + + p = version; + q = TCL_VERSION; + while (isDigit(*p)) { + if (*p++ != *q++) { + goto badVersion; + } + } + if (isDigit(*q)) { + badVersion: + iPtr->result = (char *) + "extension passed bad version argument to stubs library"; + iPtr->freeProc = TCL_STATIC; + return NULL; + } /* * We can't optimize this check by caching tclStubsPtr because that @@ -102,7 +132,7 @@ TclInitStubs( * times. [Bug 615304] */ - tclStubsPtr = HasStubSupport(interp, magic); + tclStubsPtr = HasStubSupport(interp); if (!tclStubsPtr) { return NULL; } @@ -112,14 +142,14 @@ TclInitStubs( return NULL; } if (exact) { - const char *p = version; + p = version; int count = 0; while (*p) { count += !isDigit(*p++); } if (count == 1) { - const char *q = actualVersion; + q = actualVersion; p = version; while (*p && (*p == *q)) { diff --git a/generic/tclStubLibCompat.c b/generic/tclStubLibCompat.c deleted file mode 100644 index 7d8c5c3..0000000 --- a/generic/tclStubLibCompat.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * tclStubLibCompat.c -- - * - * Stub object that will be statically linked into extensions that want - * to access Tcl. - * - * Copyright (c) 2012 Jan Nijtmans - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -/* - * Small wrapper, which allows Tcl8 extensions to use the same stub - * library as Tcl 9. - */ - -#include "tclInt.h" - - -/* - *---------------------------------------------------------------------- - * - * Tcl_InitStubs -- - * - * Tries to initialise the stub table pointers and ensures that the - * correct version of Tcl is loaded. - * - * Results: - * The actual version of Tcl that satisfies the request, or NULL to - * indicate that an error occurred. - * - * Side effects: - * Sets the stub table pointers. - * - *---------------------------------------------------------------------- - */ -#undef Tcl_InitStubs - -MODULE_SCOPE const char * -Tcl_InitStubs( - Tcl_Interp *interp, - const char *version, - int exact) -{ - /* Use the hardcoded Tcl8 magic value here. */ - return TclInitStubs(interp, version, exact, (int) 0xFCA3BACF); -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - diff --git a/unix/Makefile.in b/unix/Makefile.in index 9a7d6db..b89b2e6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -336,7 +336,6 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ - tclStubLibCompat.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ ${COMPAT_OBJS} @@ -472,7 +471,6 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ - $(GENERIC_DIR)/tclStubLibCompat.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c @@ -1661,9 +1659,6 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c -tclStubLibCompat.o: $(GENERIC_DIR)/tclStubLibCompat.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLibCompat.c - tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c diff --git a/win/Makefile.in b/win/Makefile.in index 6b9685d..dacbbb5 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -378,7 +378,6 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ - tclStubLibCompat.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) @@ -506,9 +505,6 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported -tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c - $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) - tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) diff --git a/win/makefile.vc b/win/makefile.vc index 823142f..2784140 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -448,7 +448,6 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ - $(TMP_DIR)\tclStubLibCompat.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj -- cgit v0.12 From 905d1e5d030d74f8bbfc5fb21044fa263f3d08b0 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 17:45:20 +0000 Subject: Remove STRINGIFY and JOIN utility macros. Tcl doesn't use them. And Tcl doesn't need to be in the utility macro supply business. If an extension needs these, let them define them. --- generic/tcl.h | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index b9ff28c..1926dc7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -90,20 +90,6 @@ extern "C" { #endif /* __WIN32__ */ /* - * Utility macros: STRINGIFY takes an argument and wraps it in "" (double - * quotation marks), JOIN joins two arguments. - */ - -#ifndef STRINGIFY -# define STRINGIFY(x) STRINGIFY1(x) -# define STRINGIFY1(x) #x -#endif -#ifndef JOIN -# define JOIN(a,b) JOIN1(a,b) -# define JOIN1(a,b) a##b -#endif - -/* * A special definition used to allow this header file to be included from * windows resource files so that they can obtain version information. * RC_INVOKED is defined by default by the windows RC tool. -- cgit v0.12 From 98a8b3604fc14935986f5620795e235d05503b7f Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 20:32:16 +0000 Subject: Destroy all the TCL_STORAGE_CLASS and associated nonsense. --- generic/tcl.decls | 2 +- generic/tcl.h | 31 +- generic/tclDecls.h | 1256 ++++++++++++++++++++++----------------------- generic/tclIntDecls.h | 316 ++++++------ generic/tclIntPlatDecls.h | 134 +++-- generic/tclPlatDecls.h | 22 +- generic/tclTest.c | 12 +- generic/tclTomMath.decls | 2 +- generic/tclTomMathDecls.h | 142 +++-- tools/genStubs.tcl | 1 + unix/dltest/pkga.c | 11 +- unix/dltest/pkgb.c | 13 +- unix/dltest/pkgc.c | 13 +- unix/dltest/pkgd.c | 13 +- unix/dltest/pkge.c | 11 +- unix/dltest/pkgua.c | 17 +- unix/tclLoadShl.c | 9 - win/tclWinDde.c | 14 +- win/tclWinReg.c | 13 +- 19 files changed, 927 insertions(+), 1105 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 818f713..ec7864d 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -21,7 +21,7 @@ library tcl interface tcl hooks {tclPlat tclInt tclIntPlat} -scspec EXTERN +scspec TCLAPI # Declare each of the functions in the public Tcl interface. Note that # the an index should never be reused for a different function in order diff --git a/generic/tcl.h b/generic/tcl.h index 1926dc7..786c64e 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -214,15 +214,10 @@ extern "C" { * be reset to DLLIMPORT. */ -#undef TCL_STORAGE_CLASS #ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT +# define TCLAPI DLLEXPORT #else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif +# define TCLAPI DLLIMPORT #endif /* @@ -235,20 +230,6 @@ extern "C" { #endif /* - * Make sure EXTERN isn't defined elsewhere. - */ - -#ifdef EXTERN -# undef EXTERN -#endif /* EXTERN */ - -#ifdef __cplusplus -# define EXTERN extern "C" TCL_STORAGE_CLASS -#else -# define EXTERN extern TCL_STORAGE_CLASS -#endif - -/* *---------------------------------------------------------------------------- * The following code is copied from winnt.h. If we don't replicate it here, * then can't be included after tcl.h, since tcl.h also defines @@ -2295,13 +2276,13 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) -EXTERN void Tcl_FindExecutable(const char *argv0); -EXTERN void Tcl_MainEx(int argc, char **argv, +TCLAPI void Tcl_FindExecutable(const char *argv0); +TCLAPI void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); -EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, +TCLAPI const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) -EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); +TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #endif /* diff --git a/generic/tclDecls.h b/generic/tclDecls.h index e12e969..d152ea8 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -12,17 +12,6 @@ #ifndef _TCLDECLS #define _TCLDECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -36,1749 +25,1749 @@ */ /* 0 */ -EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp, +TCLAPI int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 1 */ -EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp, +TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 2 */ -EXTERN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); +TCLAPI void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -EXTERN char * Tcl_Alloc(unsigned int size); +TCLAPI char * Tcl_Alloc(unsigned int size); /* 4 */ -EXTERN void Tcl_Free(char *ptr); +TCLAPI void Tcl_Free(char *ptr); /* 5 */ -EXTERN char * Tcl_Realloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_Realloc(char *ptr, unsigned int size); /* 6 */ -EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file, +TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file, int line); /* 7 */ -EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); +TCLAPI void Tcl_DbCkfree(char *ptr, const char *file, int line); /* 8 */ -EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, +TCLAPI char * Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line); #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ -EXTERN void Tcl_CreateFileHandler(int fd, int mask, +TCLAPI void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ -EXTERN void Tcl_CreateFileHandler(int fd, int mask, +TCLAPI void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* MACOSX */ #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ -EXTERN void Tcl_DeleteFileHandler(int fd); +TCLAPI void Tcl_DeleteFileHandler(int fd); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 10 */ -EXTERN void Tcl_DeleteFileHandler(int fd); +TCLAPI void Tcl_DeleteFileHandler(int fd); #endif /* MACOSX */ /* 11 */ -EXTERN void Tcl_SetTimer(const Tcl_Time *timePtr); +TCLAPI void Tcl_SetTimer(const Tcl_Time *timePtr); /* 12 */ -EXTERN void Tcl_Sleep(int ms); +TCLAPI void Tcl_Sleep(int ms); /* 13 */ -EXTERN int Tcl_WaitForEvent(const Tcl_Time *timePtr); +TCLAPI int Tcl_WaitForEvent(const Tcl_Time *timePtr); /* 14 */ -EXTERN int Tcl_AppendAllObjTypes(Tcl_Interp *interp, +TCLAPI int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 15 */ -EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); +TCLAPI void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); /* 16 */ -EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, +TCLAPI void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length); /* 17 */ -EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); +TCLAPI Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); /* 18 */ -EXTERN int Tcl_ConvertToType(Tcl_Interp *interp, +TCLAPI int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 19 */ -EXTERN void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, +TCLAPI void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 20 */ -EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, +TCLAPI void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 21 */ -EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, +TCLAPI int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); /* 22 */ -EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, +TCLAPI Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, int line); /* 23 */ -EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, +TCLAPI Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line); /* 24 */ -EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, +TCLAPI Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line); /* 25 */ -EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, +TCLAPI Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line); /* 26 */ -EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, +TCLAPI Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, int line); /* 27 */ -EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line); +TCLAPI Tcl_Obj * Tcl_DbNewObj(const char *file, int line); /* 28 */ -EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, +TCLAPI Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, const char *file, int line); /* 29 */ -EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); +TCLAPI Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); /* 30 */ -EXTERN void TclFreeObj(Tcl_Obj *objPtr); +TCLAPI void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ -EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, +TCLAPI int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); /* 32 */ -EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 33 */ -EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, +TCLAPI unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 34 */ -EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, +TCLAPI int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); /* 35 */ -EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ -EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 37 */ -EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, +TCLAPI int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); /* 38 */ -EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 39 */ -EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ -EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); +TCLAPI const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ -EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); +TCLAPI char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ -EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); +TCLAPI void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ -EXTERN int Tcl_ListObjAppendList(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 44 */ -EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ -EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ -EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 47 */ -EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 48 */ -EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 49 */ -EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue); +TCLAPI Tcl_Obj * Tcl_NewBooleanObj(int boolValue); /* 50 */ -EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, +TCLAPI Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, int length); /* 51 */ -EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); +TCLAPI Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); /* 52 */ -EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue); +TCLAPI Tcl_Obj * Tcl_NewIntObj(int intValue); /* 53 */ -EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); +TCLAPI Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); /* 54 */ -EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue); +TCLAPI Tcl_Obj * Tcl_NewLongObj(long longValue); /* 55 */ -EXTERN Tcl_Obj * Tcl_NewObj(void); +TCLAPI Tcl_Obj * Tcl_NewObj(void); /* 56 */ -EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); +TCLAPI Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); /* 57 */ -EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); +TCLAPI void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); /* 58 */ -EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); +TCLAPI unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); /* 59 */ -EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 60 */ -EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); +TCLAPI void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); /* 61 */ -EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); +TCLAPI void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); /* 62 */ -EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, +TCLAPI void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 63 */ -EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); +TCLAPI void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); /* 64 */ -EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); +TCLAPI void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); /* 65 */ -EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, +TCLAPI void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length); /* 66 */ -EXTERN void Tcl_AddErrorInfo(Tcl_Interp *interp, +TCLAPI void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message); /* 67 */ -EXTERN void Tcl_AddObjErrorInfo(Tcl_Interp *interp, +TCLAPI void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, int length); /* 68 */ -EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); +TCLAPI void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ -EXTERN void Tcl_AppendElement(Tcl_Interp *interp, +TCLAPI void Tcl_AppendElement(Tcl_Interp *interp, const char *element); /* 70 */ -EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); +TCLAPI void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ -EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, +TCLAPI Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, ClientData clientData); /* 72 */ -EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); +TCLAPI void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ -EXTERN int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); +TCLAPI int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); /* 74 */ -EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); +TCLAPI void Tcl_AsyncMark(Tcl_AsyncHandler async); /* 75 */ -EXTERN int Tcl_AsyncReady(void); +TCLAPI int Tcl_AsyncReady(void); /* 76 */ -EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); +TCLAPI void Tcl_BackgroundError(Tcl_Interp *interp); /* Slot 77 is reserved */ /* 78 */ -EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, +TCLAPI int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList); /* 79 */ -EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, +TCLAPI void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 80 */ -EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, +TCLAPI void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData); /* 81 */ -EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); +TCLAPI int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ -EXTERN int Tcl_CommandComplete(const char *cmd); +TCLAPI int Tcl_CommandComplete(const char *cmd); /* 83 */ -EXTERN char * Tcl_Concat(int argc, const char *const *argv); +TCLAPI char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ -EXTERN int Tcl_ConvertElement(const char *src, char *dst, +TCLAPI int Tcl_ConvertElement(const char *src, char *dst, int flags); /* 85 */ -EXTERN int Tcl_ConvertCountedElement(const char *src, +TCLAPI int Tcl_ConvertCountedElement(const char *src, int length, char *dst, int flags); /* 86 */ -EXTERN int Tcl_CreateAlias(Tcl_Interp *slave, +TCLAPI int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 87 */ -EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave, +TCLAPI int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 88 */ -EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, +TCLAPI Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 89 */ -EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, +TCLAPI void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 90 */ -EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, +TCLAPI void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 91 */ -EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ -EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, +TCLAPI void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 93 */ -EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 94 */ -EXTERN Tcl_Interp * Tcl_CreateInterp(void); +TCLAPI Tcl_Interp * Tcl_CreateInterp(void); /* Slot 95 is reserved */ /* 96 */ -EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ -EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, +TCLAPI Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName, int isSafe); /* 98 */ -EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, +TCLAPI Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 99 */ -EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, +TCLAPI Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 100 */ -EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, +TCLAPI void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ -EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, +TCLAPI void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 102 */ -EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, +TCLAPI void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 103 */ -EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, +TCLAPI int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); /* 104 */ -EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, +TCLAPI int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ -EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, +TCLAPI void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData); /* 106 */ -EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, +TCLAPI void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 107 */ -EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 108 */ -EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); +TCLAPI void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ -EXTERN void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr); +TCLAPI void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr); /* 110 */ -EXTERN void Tcl_DeleteInterp(Tcl_Interp *interp); +TCLAPI void Tcl_DeleteInterp(Tcl_Interp *interp); /* 111 */ -EXTERN void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr); +TCLAPI void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr); /* 112 */ -EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); +TCLAPI void Tcl_DeleteTimerHandler(Tcl_TimerToken token); /* 113 */ -EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); +TCLAPI void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ -EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, +TCLAPI void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 115 */ -EXTERN int Tcl_DoOneEvent(int flags); +TCLAPI int Tcl_DoOneEvent(int flags); /* 116 */ -EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, +TCLAPI void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData); /* 117 */ -EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, +TCLAPI char * Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length); /* 118 */ -EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, +TCLAPI char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element); /* 119 */ -EXTERN void Tcl_DStringEndSublist(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringEndSublist(Tcl_DString *dsPtr); /* 120 */ -EXTERN void Tcl_DStringFree(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringFree(Tcl_DString *dsPtr); /* 121 */ -EXTERN void Tcl_DStringGetResult(Tcl_Interp *interp, +TCLAPI void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 122 */ -EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringInit(Tcl_DString *dsPtr); /* 123 */ -EXTERN void Tcl_DStringResult(Tcl_Interp *interp, +TCLAPI void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 124 */ -EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); +TCLAPI void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); /* 125 */ -EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ -EXTERN int Tcl_Eof(Tcl_Channel chan); +TCLAPI int Tcl_Eof(Tcl_Channel chan); /* 127 */ -EXTERN const char * Tcl_ErrnoId(void); +TCLAPI const char * Tcl_ErrnoId(void); /* 128 */ -EXTERN const char * Tcl_ErrnoMsg(int err); +TCLAPI const char * Tcl_ErrnoMsg(int err); /* 129 */ -EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); +TCLAPI int Tcl_Eval(Tcl_Interp *interp, const char *script); /* Slot 130 is reserved */ /* 131 */ -EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +TCLAPI int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 132 */ -EXTERN void Tcl_EventuallyFree(ClientData clientData, +TCLAPI void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc); /* 133 */ -EXTERN void Tcl_Exit(int status); +TCLAPI void Tcl_Exit(int status); /* 134 */ -EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp, +TCLAPI int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 135 */ -EXTERN int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, +TCLAPI int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, int *ptr); /* 136 */ -EXTERN int Tcl_ExprBooleanObj(Tcl_Interp *interp, +TCLAPI int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 137 */ -EXTERN int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, +TCLAPI int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, double *ptr); /* 138 */ -EXTERN int Tcl_ExprDoubleObj(Tcl_Interp *interp, +TCLAPI int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 139 */ -EXTERN int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, +TCLAPI int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, long *ptr); /* 140 */ -EXTERN int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 141 */ -EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 142 */ -EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); +TCLAPI int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ -EXTERN void Tcl_Finalize(void); +TCLAPI void Tcl_Finalize(void); /* Slot 144 is reserved */ /* 145 */ -EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, +TCLAPI Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ -EXTERN int Tcl_Flush(Tcl_Channel chan); +TCLAPI int Tcl_Flush(Tcl_Channel chan); /* 147 */ -EXTERN void Tcl_FreeResult(Tcl_Interp *interp); +TCLAPI void Tcl_FreeResult(Tcl_Interp *interp); /* 148 */ -EXTERN int Tcl_GetAlias(Tcl_Interp *interp, +TCLAPI int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 149 */ -EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ -EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, +TCLAPI ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ -EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr); /* 152 */ -EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); +TCLAPI int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ -EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, +TCLAPI int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, ClientData *handlePtr); /* 154 */ -EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); +TCLAPI ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ -EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); +TCLAPI int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ -EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan); +TCLAPI const char * Tcl_GetChannelName(Tcl_Channel chan); /* 157 */ -EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, +TCLAPI int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ -EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); +TCLAPI const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ -EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, +TCLAPI int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 160 */ -EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp, +TCLAPI const char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command); /* 161 */ -EXTERN int Tcl_GetErrno(void); +TCLAPI int Tcl_GetErrno(void); /* 162 */ -EXTERN const char * Tcl_GetHostName(void); +TCLAPI const char * Tcl_GetHostName(void); /* 163 */ -EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp, +TCLAPI int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 164 */ -EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp); +TCLAPI Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp); /* 165 */ -EXTERN const char * Tcl_GetNameOfExecutable(void); +TCLAPI const char * Tcl_GetNameOfExecutable(void); /* 166 */ -EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); +TCLAPI Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 167 */ -EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, +TCLAPI int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ -EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, +TCLAPI int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); #endif /* MACOSX */ /* 168 */ -EXTERN Tcl_PathType Tcl_GetPathType(const char *path); +TCLAPI Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ -EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); +TCLAPI int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ -EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); +TCLAPI int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ -EXTERN int Tcl_GetServiceMode(void); +TCLAPI int Tcl_GetServiceMode(void); /* 172 */ -EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, +TCLAPI Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName); /* 173 */ -EXTERN Tcl_Channel Tcl_GetStdChannel(int type); +TCLAPI Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ -EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp); +TCLAPI const char * Tcl_GetStringResult(Tcl_Interp *interp); /* 175 */ -EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, +TCLAPI const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags); /* 176 */ -EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, +TCLAPI const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* Slot 177 is reserved */ /* Slot 178 is reserved */ /* 179 */ -EXTERN int Tcl_HideCommand(Tcl_Interp *interp, +TCLAPI int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 180 */ -EXTERN int Tcl_Init(Tcl_Interp *interp); +TCLAPI int Tcl_Init(Tcl_Interp *interp); /* 181 */ -EXTERN void Tcl_InitHashTable(Tcl_HashTable *tablePtr, +TCLAPI void Tcl_InitHashTable(Tcl_HashTable *tablePtr, int keyType); /* 182 */ -EXTERN int Tcl_InputBlocked(Tcl_Channel chan); +TCLAPI int Tcl_InputBlocked(Tcl_Channel chan); /* 183 */ -EXTERN int Tcl_InputBuffered(Tcl_Channel chan); +TCLAPI int Tcl_InputBuffered(Tcl_Channel chan); /* 184 */ -EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp); +TCLAPI int Tcl_InterpDeleted(Tcl_Interp *interp); /* 185 */ -EXTERN int Tcl_IsSafe(Tcl_Interp *interp); +TCLAPI int Tcl_IsSafe(Tcl_Interp *interp); /* 186 */ -EXTERN char * Tcl_JoinPath(int argc, const char *const *argv, +TCLAPI char * Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr); /* 187 */ -EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, +TCLAPI int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr, int type); /* Slot 188 is reserved */ /* 189 */ -EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); +TCLAPI Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); /* 190 */ -EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); +TCLAPI int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ -EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); +TCLAPI Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); /* 192 */ -EXTERN char * Tcl_Merge(int argc, const char *const *argv); +TCLAPI char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ -EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); +TCLAPI Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); /* 194 */ -EXTERN void Tcl_NotifyChannel(Tcl_Channel channel, int mask); +TCLAPI void Tcl_NotifyChannel(Tcl_Channel channel, int mask); /* 195 */ -EXTERN Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, +TCLAPI Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 196 */ -EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, +TCLAPI Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 197 */ -EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, +TCLAPI Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, const char **argv, int flags); /* 198 */ -EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 199 */ -EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, +TCLAPI Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 200 */ -EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, +TCLAPI Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 201 */ -EXTERN void Tcl_Preserve(ClientData data); +TCLAPI void Tcl_Preserve(ClientData data); /* 202 */ -EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, +TCLAPI void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); /* 203 */ -EXTERN int Tcl_PutEnv(const char *assignment); +TCLAPI int Tcl_PutEnv(const char *assignment); /* 204 */ -EXTERN const char * Tcl_PosixError(Tcl_Interp *interp); +TCLAPI const char * Tcl_PosixError(Tcl_Interp *interp); /* 205 */ -EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, +TCLAPI void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); /* 206 */ -EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); +TCLAPI int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); /* 207 */ -EXTERN void Tcl_ReapDetachedProcs(void); +TCLAPI void Tcl_ReapDetachedProcs(void); /* 208 */ -EXTERN int Tcl_RecordAndEval(Tcl_Interp *interp, +TCLAPI int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags); /* 209 */ -EXTERN int Tcl_RecordAndEvalObj(Tcl_Interp *interp, +TCLAPI int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 210 */ -EXTERN void Tcl_RegisterChannel(Tcl_Interp *interp, +TCLAPI void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 211 */ -EXTERN void Tcl_RegisterObjType(const Tcl_ObjType *typePtr); +TCLAPI void Tcl_RegisterObjType(const Tcl_ObjType *typePtr); /* 212 */ -EXTERN Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, +TCLAPI Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern); /* 213 */ -EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, +TCLAPI int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 214 */ -EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, +TCLAPI int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ -EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, +TCLAPI void Tcl_RegExpRange(Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 216 */ -EXTERN void Tcl_Release(ClientData clientData); +TCLAPI void Tcl_Release(ClientData clientData); /* 217 */ -EXTERN void Tcl_ResetResult(Tcl_Interp *interp); +TCLAPI void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); +TCLAPI int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ -EXTERN int Tcl_ScanCountedElement(const char *src, int length, +TCLAPI int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr); /* Slot 220 is reserved */ /* 221 */ -EXTERN int Tcl_ServiceAll(void); +TCLAPI int Tcl_ServiceAll(void); /* 222 */ -EXTERN int Tcl_ServiceEvent(int flags); +TCLAPI int Tcl_ServiceEvent(int flags); /* 223 */ -EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, +TCLAPI void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 224 */ -EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); +TCLAPI void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ -EXTERN int Tcl_SetChannelOption(Tcl_Interp *interp, +TCLAPI int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 226 */ -EXTERN int Tcl_SetCommandInfo(Tcl_Interp *interp, +TCLAPI int Tcl_SetCommandInfo(Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 227 */ -EXTERN void Tcl_SetErrno(int err); +TCLAPI void Tcl_SetErrno(int err); /* 228 */ -EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); +TCLAPI void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ -EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); +TCLAPI void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ -EXTERN void Tcl_SetPanicProc(Tcl_PanicProc *panicProc); +TCLAPI void Tcl_SetPanicProc(Tcl_PanicProc *panicProc); /* 231 */ -EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); +TCLAPI int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); /* 232 */ -EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, +TCLAPI void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 233 */ -EXTERN int Tcl_SetServiceMode(int mode); +TCLAPI int Tcl_SetServiceMode(int mode); /* 234 */ -EXTERN void Tcl_SetObjErrorCode(Tcl_Interp *interp, +TCLAPI void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 235 */ -EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, +TCLAPI void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ -EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); +TCLAPI void Tcl_SetStdChannel(Tcl_Channel channel, int type); /* 237 */ -EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, +TCLAPI const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 238 */ -EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, +TCLAPI const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 239 */ -EXTERN const char * Tcl_SignalId(int sig); +TCLAPI const char * Tcl_SignalId(int sig); /* 240 */ -EXTERN const char * Tcl_SignalMsg(int sig); +TCLAPI const char * Tcl_SignalMsg(int sig); /* 241 */ -EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); +TCLAPI void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ -EXTERN int Tcl_SplitList(Tcl_Interp *interp, +TCLAPI int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 243 */ -EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, +TCLAPI void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr); /* 244 */ -EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, +TCLAPI void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 245 */ -EXTERN int Tcl_StringMatch(const char *str, const char *pattern); +TCLAPI int Tcl_StringMatch(const char *str, const char *pattern); /* Slot 246 is reserved */ /* 247 */ -EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, +TCLAPI int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ -EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, +TCLAPI int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 249 */ -EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, +TCLAPI char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 250 */ -EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str, +TCLAPI int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead); /* 251 */ -EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, +TCLAPI void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName); /* 252 */ -EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp, +TCLAPI int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 253 */ -EXTERN int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, +TCLAPI int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags); /* 254 */ -EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, +TCLAPI int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 255 */ -EXTERN void Tcl_UntraceVar(Tcl_Interp *interp, +TCLAPI void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ -EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, +TCLAPI void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 257 */ -EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, +TCLAPI void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); /* 258 */ -EXTERN int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, +TCLAPI int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 259 */ -EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, +TCLAPI int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 260 */ -EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); +TCLAPI int Tcl_VarEval(Tcl_Interp *interp, ...); /* 261 */ -EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, +TCLAPI ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ -EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, +TCLAPI ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 263 */ -EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); +TCLAPI int Tcl_Write(Tcl_Channel chan, const char *s, int slen); /* 264 */ -EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, +TCLAPI void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 265 */ -EXTERN int Tcl_DumpActiveMemory(const char *fileName); +TCLAPI int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ -EXTERN void Tcl_ValidateAllMemory(const char *file, int line); +TCLAPI void Tcl_ValidateAllMemory(const char *file, int line); /* 267 */ -EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp, +TCLAPI void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList); /* 268 */ -EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList); /* 269 */ -EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); +TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ -EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, +TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr); /* 271 */ -EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, +TCLAPI const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, const char *version, int exact); /* 272 */ -EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp, +TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 273 */ -EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, +TCLAPI int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, const char *version); /* 274 */ -EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, +TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact); /* 275 */ -EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp, +TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList); /* 276 */ -EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); +TCLAPI int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); /* 277 */ -EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); +TCLAPI Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); /* 278 */ -EXTERN void Tcl_PanicVA(const char *format, va_list argList); +TCLAPI void Tcl_PanicVA(const char *format, va_list argList); /* 279 */ -EXTERN void Tcl_GetVersion(int *major, int *minor, +TCLAPI void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); /* 280 */ -EXTERN void Tcl_InitMemory(Tcl_Interp *interp); +TCLAPI void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ -EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 282 */ -EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, +TCLAPI int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 283 */ -EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); +TCLAPI Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); /* 284 */ -EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); +TCLAPI void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); /* Slot 285 is reserved */ /* 286 */ -EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 287 */ -EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); +TCLAPI Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ -EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 289 */ -EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 290 */ -EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); +TCLAPI void Tcl_DiscardResult(Tcl_SavedResult *statePtr); /* 291 */ -EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, +TCLAPI int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 292 */ -EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc, +TCLAPI int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 293 */ -EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 294 */ -EXTERN void Tcl_ExitThread(int status); +TCLAPI void Tcl_ExitThread(int status); /* 295 */ -EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp, +TCLAPI int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 296 */ -EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, +TCLAPI char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 297 */ -EXTERN void Tcl_FinalizeThread(void); +TCLAPI void Tcl_FinalizeThread(void); /* 298 */ -EXTERN void Tcl_FinalizeNotifier(ClientData clientData); +TCLAPI void Tcl_FinalizeNotifier(ClientData clientData); /* 299 */ -EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); +TCLAPI void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ -EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); +TCLAPI Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ -EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); +TCLAPI Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); /* 302 */ -EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding); +TCLAPI const char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ -EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); +TCLAPI void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ -EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, +TCLAPI int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 305 */ -EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, +TCLAPI void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size); /* 306 */ -EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, +TCLAPI Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ -EXTERN ClientData Tcl_InitNotifier(void); +TCLAPI ClientData Tcl_InitNotifier(void); /* 308 */ -EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); +TCLAPI void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ -EXTERN void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr); +TCLAPI void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr); /* 310 */ -EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); +TCLAPI void Tcl_ConditionNotify(Tcl_Condition *condPtr); /* 311 */ -EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, +TCLAPI void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN int Tcl_NumUtfChars(const char *src, int length); +TCLAPI int Tcl_NumUtfChars(const char *src, int length); /* 313 */ -EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, +TCLAPI int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 314 */ -EXTERN void Tcl_RestoreResult(Tcl_Interp *interp, +TCLAPI void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ -EXTERN void Tcl_SaveResult(Tcl_Interp *interp, +TCLAPI void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 316 */ -EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, +TCLAPI int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); /* 317 */ -EXTERN Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, +TCLAPI Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 318 */ -EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); +TCLAPI void Tcl_ThreadAlert(Tcl_ThreadId threadId); /* 319 */ -EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, +TCLAPI void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); +TCLAPI Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); /* 321 */ -EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch); +TCLAPI Tcl_UniChar Tcl_UniCharToLower(int ch); /* 322 */ -EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch); +TCLAPI Tcl_UniChar Tcl_UniCharToTitle(int ch); /* 323 */ -EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); +TCLAPI Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ -EXTERN int Tcl_UniCharToUtf(int ch, char *buf); +TCLAPI int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN const char * Tcl_UtfAtIndex(const char *src, int index); +TCLAPI const char * Tcl_UtfAtIndex(const char *src, int index); /* 326 */ -EXTERN int Tcl_UtfCharComplete(const char *src, int length); +TCLAPI int Tcl_UtfCharComplete(const char *src, int length); /* 327 */ -EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, +TCLAPI int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ -EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); +TCLAPI const char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ -EXTERN const char * Tcl_UtfFindLast(const char *src, int ch); +TCLAPI const char * Tcl_UtfFindLast(const char *src, int ch); /* 330 */ -EXTERN const char * Tcl_UtfNext(const char *src); +TCLAPI const char * Tcl_UtfNext(const char *src); /* 331 */ -EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); +TCLAPI const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ -EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, +TCLAPI int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ -EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, +TCLAPI char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 334 */ -EXTERN int Tcl_UtfToLower(char *src); +TCLAPI int Tcl_UtfToLower(char *src); /* 335 */ -EXTERN int Tcl_UtfToTitle(char *src); +TCLAPI int Tcl_UtfToTitle(char *src); /* 336 */ -EXTERN int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); +TCLAPI int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); /* 337 */ -EXTERN int Tcl_UtfToUpper(char *src); +TCLAPI int Tcl_UtfToUpper(char *src); /* 338 */ -EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, +TCLAPI int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen); /* 339 */ -EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); +TCLAPI int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ -EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); +TCLAPI char * Tcl_GetString(Tcl_Obj *objPtr); /* 341 */ -EXTERN const char * Tcl_GetDefaultEncodingDir(void); +TCLAPI const char * Tcl_GetDefaultEncodingDir(void); /* 342 */ -EXTERN void Tcl_SetDefaultEncodingDir(const char *path); +TCLAPI void Tcl_SetDefaultEncodingDir(const char *path); /* 343 */ -EXTERN void Tcl_AlertNotifier(ClientData clientData); +TCLAPI void Tcl_AlertNotifier(ClientData clientData); /* 344 */ -EXTERN void Tcl_ServiceModeHook(int mode); +TCLAPI void Tcl_ServiceModeHook(int mode); /* 345 */ -EXTERN int Tcl_UniCharIsAlnum(int ch); +TCLAPI int Tcl_UniCharIsAlnum(int ch); /* 346 */ -EXTERN int Tcl_UniCharIsAlpha(int ch); +TCLAPI int Tcl_UniCharIsAlpha(int ch); /* 347 */ -EXTERN int Tcl_UniCharIsDigit(int ch); +TCLAPI int Tcl_UniCharIsDigit(int ch); /* 348 */ -EXTERN int Tcl_UniCharIsLower(int ch); +TCLAPI int Tcl_UniCharIsLower(int ch); /* 349 */ -EXTERN int Tcl_UniCharIsSpace(int ch); +TCLAPI int Tcl_UniCharIsSpace(int ch); /* 350 */ -EXTERN int Tcl_UniCharIsUpper(int ch); +TCLAPI int Tcl_UniCharIsUpper(int ch); /* 351 */ -EXTERN int Tcl_UniCharIsWordChar(int ch); +TCLAPI int Tcl_UniCharIsWordChar(int ch); /* 352 */ -EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr); +TCLAPI int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ -EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, +TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 354 */ -EXTERN char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, +TCLAPI char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 355 */ -EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, +TCLAPI Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr); /* 356 */ -EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, +TCLAPI Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* Slot 357 is reserved */ /* 358 */ -EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); +TCLAPI void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ -EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, +TCLAPI void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, int length); /* 360 */ -EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, +TCLAPI int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 361 */ -EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, +TCLAPI int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 362 */ -EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, +TCLAPI int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 363 */ -EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, +TCLAPI int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 364 */ -EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, +TCLAPI int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 365 */ -EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); +TCLAPI char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 366 */ -EXTERN int Tcl_Chdir(const char *dirName); +TCLAPI int Tcl_Chdir(const char *dirName); /* 367 */ -EXTERN int Tcl_Access(const char *path, int mode); +TCLAPI int Tcl_Access(const char *path, int mode); /* 368 */ -EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); +TCLAPI int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, +TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n); /* 370 */ -EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, +TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n); /* 371 */ -EXTERN int Tcl_StringCaseMatch(const char *str, +TCLAPI int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); /* 372 */ -EXTERN int Tcl_UniCharIsControl(int ch); +TCLAPI int Tcl_UniCharIsControl(int ch); /* 373 */ -EXTERN int Tcl_UniCharIsGraph(int ch); +TCLAPI int Tcl_UniCharIsGraph(int ch); /* 374 */ -EXTERN int Tcl_UniCharIsPrint(int ch); +TCLAPI int Tcl_UniCharIsPrint(int ch); /* 375 */ -EXTERN int Tcl_UniCharIsPunct(int ch); +TCLAPI int Tcl_UniCharIsPunct(int ch); /* 376 */ -EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, +TCLAPI int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 377 */ -EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, +TCLAPI void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ -EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, +TCLAPI Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars); /* 379 */ -EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 380 */ -EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); +TCLAPI int Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index); +TCLAPI Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index); /* 382 */ -EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); +TCLAPI Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); +TCLAPI Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); /* 384 */ -EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 385 */ -EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, +TCLAPI int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 386 */ -EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); +TCLAPI void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); /* 387 */ -EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void); +TCLAPI Tcl_Mutex * Tcl_GetAllocMutex(void); /* 388 */ -EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); +TCLAPI int Tcl_GetChannelNames(Tcl_Interp *interp); /* 389 */ -EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, +TCLAPI int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ -EXTERN int Tcl_ProcObjCmd(ClientData clientData, +TCLAPI int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 391 */ -EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); +TCLAPI void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ -EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); +TCLAPI void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ -EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, +TCLAPI int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 394 */ -EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, +TCLAPI int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead); /* 395 */ -EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, +TCLAPI int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen); /* 396 */ -EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); +TCLAPI Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ -EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); +TCLAPI int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ -EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr); +TCLAPI const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr); /* 399 */ -EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion( +TCLAPI Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr); /* 400 */ -EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( +TCLAPI Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr); /* 401 */ -EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc( +TCLAPI Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr); /* 402 */ -EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( +TCLAPI Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr); /* 403 */ -EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc( +TCLAPI Tcl_DriverInputProc * Tcl_ChannelInputProc( const Tcl_ChannelType *chanTypePtr); /* 404 */ -EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc( +TCLAPI Tcl_DriverOutputProc * Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr); /* 405 */ -EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc( +TCLAPI Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr); /* 406 */ -EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( +TCLAPI Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 407 */ -EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc( +TCLAPI Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 408 */ -EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc( +TCLAPI Tcl_DriverWatchProc * Tcl_ChannelWatchProc( const Tcl_ChannelType *chanTypePtr); /* 409 */ -EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc( +TCLAPI Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc( const Tcl_ChannelType *chanTypePtr); /* 410 */ -EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc( +TCLAPI Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr); /* 411 */ -EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( +TCLAPI Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr); /* 412 */ -EXTERN int Tcl_JoinThread(Tcl_ThreadId threadId, int *result); +TCLAPI int Tcl_JoinThread(Tcl_ThreadId threadId, int *result); /* 413 */ -EXTERN int Tcl_IsChannelShared(Tcl_Channel channel); +TCLAPI int Tcl_IsChannelShared(Tcl_Channel channel); /* 414 */ -EXTERN int Tcl_IsChannelRegistered(Tcl_Interp *interp, +TCLAPI int Tcl_IsChannelRegistered(Tcl_Interp *interp, Tcl_Channel channel); /* 415 */ -EXTERN void Tcl_CutChannel(Tcl_Channel channel); +TCLAPI void Tcl_CutChannel(Tcl_Channel channel); /* 416 */ -EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); +TCLAPI void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ -EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); +TCLAPI void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ -EXTERN int Tcl_IsChannelExisting(const char *channelName); +TCLAPI int Tcl_IsChannelExisting(const char *channelName); /* 419 */ -EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, +TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 420 */ -EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, +TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 421 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, +TCLAPI Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key); /* 422 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +TCLAPI Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 423 */ -EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, +TCLAPI void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 424 */ -EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); +TCLAPI void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ -EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, +TCLAPI ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 426 */ -EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, +TCLAPI int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ -EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, +TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ -EXTERN char * Tcl_AttemptAlloc(unsigned int size); +TCLAPI char * Tcl_AttemptAlloc(unsigned int size); /* 429 */ -EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size, +TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line); /* 430 */ -EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_AttemptRealloc(char *ptr, unsigned int size); /* 431 */ -EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, +TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line); /* 432 */ -EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); +TCLAPI int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); /* 433 */ -EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); +TCLAPI Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ -EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, +TCLAPI Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* Slot 435 is reserved */ /* Slot 436 is reserved */ /* 437 */ -EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 438 */ -EXTERN int Tcl_DetachChannel(Tcl_Interp *interp, +TCLAPI int Tcl_DetachChannel(Tcl_Interp *interp, Tcl_Channel channel); /* 439 */ -EXTERN int Tcl_IsStandardChannel(Tcl_Channel channel); +TCLAPI int Tcl_IsStandardChannel(Tcl_Channel channel); /* 440 */ -EXTERN int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, +TCLAPI int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 441 */ -EXTERN int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, +TCLAPI int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 442 */ -EXTERN int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); +TCLAPI int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); /* 443 */ -EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); +TCLAPI int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); /* 444 */ -EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, +TCLAPI int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 445 */ -EXTERN int Tcl_FSMatchInDirectory(Tcl_Interp *interp, +TCLAPI int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 446 */ -EXTERN Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, +TCLAPI Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 447 */ -EXTERN int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, +TCLAPI int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 448 */ -EXTERN int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, +TCLAPI int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 449 */ -EXTERN int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +TCLAPI int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 450 */ -EXTERN int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); +TCLAPI int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); /* 451 */ -EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, +TCLAPI int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 452 */ -EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, +TCLAPI int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ -EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, +TCLAPI const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ -EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +TCLAPI int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 455 */ -EXTERN int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode); +TCLAPI int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode); /* 456 */ -EXTERN Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 457 */ -EXTERN Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp); +TCLAPI Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp); /* 458 */ -EXTERN int Tcl_FSChdir(Tcl_Obj *pathPtr); +TCLAPI int Tcl_FSChdir(Tcl_Obj *pathPtr); /* 459 */ -EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, +TCLAPI int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 460 */ -EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements); +TCLAPI Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements); /* 461 */ -EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); +TCLAPI Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); /* 462 */ -EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, +TCLAPI int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 463 */ -EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 464 */ -EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, +TCLAPI Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ -EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, +TCLAPI ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ -EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 467 */ -EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); +TCLAPI int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ -EXTERN Tcl_Obj * Tcl_FSNewNativePath( +TCLAPI Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 469 */ -EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); +TCLAPI const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ -EXTERN Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr); +TCLAPI Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr); /* 471 */ -EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); +TCLAPI Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ -EXTERN Tcl_Obj * Tcl_FSListVolumes(void); +TCLAPI Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ -EXTERN int Tcl_FSRegister(ClientData clientData, +TCLAPI int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr); /* 474 */ -EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); +TCLAPI int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ -EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); +TCLAPI ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ -EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, +TCLAPI const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ -EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); +TCLAPI const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ -EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); +TCLAPI Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ -EXTERN int Tcl_OutputBuffered(Tcl_Channel chan); +TCLAPI int Tcl_OutputBuffered(Tcl_Channel chan); /* 480 */ -EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); +TCLAPI void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); /* 481 */ -EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp, +TCLAPI int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 482 */ -EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); +TCLAPI void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ -EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, +TCLAPI Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ -EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, +TCLAPI int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 485 */ -EXTERN int Tcl_SetCommandInfoFromToken(Tcl_Command token, +TCLAPI int Tcl_SetCommandInfoFromToken(Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 486 */ -EXTERN Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, +TCLAPI Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, const char *file, int line); /* 487 */ -EXTERN int Tcl_GetWideIntFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 488 */ -EXTERN Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); +TCLAPI Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); /* 489 */ -EXTERN void Tcl_SetWideIntObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 490 */ -EXTERN Tcl_StatBuf * Tcl_AllocStatBuf(void); +TCLAPI Tcl_StatBuf * Tcl_AllocStatBuf(void); /* 491 */ -EXTERN Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, +TCLAPI Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 492 */ -EXTERN Tcl_WideInt Tcl_Tell(Tcl_Channel chan); +TCLAPI Tcl_WideInt Tcl_Tell(Tcl_Channel chan); /* 493 */ -EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( +TCLAPI Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr); /* 494 */ -EXTERN int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, +TCLAPI int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 495 */ -EXTERN int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, +TCLAPI int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 496 */ -EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ -EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, +TCLAPI int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 498 */ -EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ -EXTERN void Tcl_DictObjNext(Tcl_DictSearch *searchPtr, +TCLAPI void Tcl_DictObjNext(Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 500 */ -EXTERN void Tcl_DictObjDone(Tcl_DictSearch *searchPtr); +TCLAPI void Tcl_DictObjDone(Tcl_DictSearch *searchPtr); /* 501 */ -EXTERN int Tcl_DictObjPutKeyList(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 502 */ -EXTERN int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 503 */ -EXTERN Tcl_Obj * Tcl_NewDictObj(void); +TCLAPI Tcl_Obj * Tcl_NewDictObj(void); /* 504 */ -EXTERN Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line); +TCLAPI Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line); /* 505 */ -EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp, +TCLAPI void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 506 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); +TCLAPI void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 508 */ -EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, +TCLAPI int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 509 */ -EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 510 */ -EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 511 */ -EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, +TCLAPI int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 512 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); /* 513 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); /* 514 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */ -EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +TCLAPI Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 516 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 517 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, +TCLAPI void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 518 */ -EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, +TCLAPI int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 519 */ -EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); +TCLAPI Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); /* 520 */ -EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, +TCLAPI void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ -EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, +TCLAPI void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 522 */ -EXTERN int Tcl_LimitReady(Tcl_Interp *interp); +TCLAPI int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ -EXTERN int Tcl_LimitCheck(Tcl_Interp *interp); +TCLAPI int Tcl_LimitCheck(Tcl_Interp *interp); /* 524 */ -EXTERN int Tcl_LimitExceeded(Tcl_Interp *interp); +TCLAPI int Tcl_LimitExceeded(Tcl_Interp *interp); /* 525 */ -EXTERN void Tcl_LimitSetCommands(Tcl_Interp *interp, +TCLAPI void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit); /* 526 */ -EXTERN void Tcl_LimitSetTime(Tcl_Interp *interp, +TCLAPI void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 527 */ -EXTERN void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, +TCLAPI void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, int granularity); /* 528 */ -EXTERN int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type); +TCLAPI int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type); /* 529 */ -EXTERN int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type); +TCLAPI int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type); /* 530 */ -EXTERN void Tcl_LimitTypeSet(Tcl_Interp *interp, int type); +TCLAPI void Tcl_LimitTypeSet(Tcl_Interp *interp, int type); /* 531 */ -EXTERN void Tcl_LimitTypeReset(Tcl_Interp *interp, int type); +TCLAPI void Tcl_LimitTypeReset(Tcl_Interp *interp, int type); /* 532 */ -EXTERN int Tcl_LimitGetCommands(Tcl_Interp *interp); +TCLAPI int Tcl_LimitGetCommands(Tcl_Interp *interp); /* 533 */ -EXTERN void Tcl_LimitGetTime(Tcl_Interp *interp, +TCLAPI void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 534 */ -EXTERN int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type); +TCLAPI int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type); /* 535 */ -EXTERN Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status); +TCLAPI Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status); /* 536 */ -EXTERN int Tcl_RestoreInterpState(Tcl_Interp *interp, +TCLAPI int Tcl_RestoreInterpState(Tcl_Interp *interp, Tcl_InterpState state); /* 537 */ -EXTERN void Tcl_DiscardInterpState(Tcl_InterpState state); +TCLAPI void Tcl_DiscardInterpState(Tcl_InterpState state); /* 538 */ -EXTERN int Tcl_SetReturnOptions(Tcl_Interp *interp, +TCLAPI int Tcl_SetReturnOptions(Tcl_Interp *interp, Tcl_Obj *options); /* 539 */ -EXTERN Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result); +TCLAPI Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result); /* 540 */ -EXTERN int Tcl_IsEnsemble(Tcl_Command token); +TCLAPI int Tcl_IsEnsemble(Tcl_Command token); /* 541 */ -EXTERN Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags); /* 542 */ -EXTERN Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 543 */ -EXTERN int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 544 */ -EXTERN int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 545 */ -EXTERN int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 546 */ -EXTERN int Tcl_SetEnsembleFlags(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int flags); /* 547 */ -EXTERN int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 548 */ -EXTERN int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 549 */ -EXTERN int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 550 */ -EXTERN int Tcl_GetEnsembleFlags(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 551 */ -EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 552 */ -EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, +TCLAPI void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 553 */ -EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, +TCLAPI void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 554 */ -EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( +TCLAPI Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ -EXTERN Tcl_Obj * Tcl_NewBignumObj(mp_int *value); +TCLAPI Tcl_Obj * Tcl_NewBignumObj(mp_int *value); /* 556 */ -EXTERN Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file, +TCLAPI Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file, int line); /* 557 */ -EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value); +TCLAPI void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value); /* 558 */ -EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */ -EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 560 */ -EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, +TCLAPI int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length); /* 561 */ -EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( +TCLAPI Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr); /* 562 */ -EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, +TCLAPI void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg); /* 563 */ -EXTERN void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, +TCLAPI void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg); /* 564 */ -EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); +TCLAPI void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); /* 565 */ -EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); +TCLAPI void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); /* 566 */ -EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp, +TCLAPI int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, mp_int *toInit); /* 567 */ -EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 568 */ -EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, +TCLAPI int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 569 */ -EXTERN int Tcl_GetEncodingFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetEncodingFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 570 */ -EXTERN Tcl_Obj * Tcl_GetEncodingSearchPath(void); +TCLAPI Tcl_Obj * Tcl_GetEncodingSearchPath(void); /* 571 */ -EXTERN int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath); +TCLAPI int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath); /* 572 */ -EXTERN const char * Tcl_GetEncodingNameFromEnvironment( +TCLAPI const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr); /* 573 */ -EXTERN int Tcl_PkgRequireProc(Tcl_Interp *interp, +TCLAPI int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 574 */ -EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, +TCLAPI void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 575 */ -EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 576 */ -EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, +TCLAPI Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ -EXTERN int Tcl_AppendFormatToObj(Tcl_Interp *interp, +TCLAPI int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 578 */ -EXTERN Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); +TCLAPI Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 579 */ -EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ -EXTERN int Tcl_CancelEval(Tcl_Interp *interp, +TCLAPI int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 581 */ -EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); +TCLAPI int Tcl_Canceled(Tcl_Interp *interp, int flags); /* 582 */ -EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, +TCLAPI int Tcl_CreatePipe(Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 583 */ -EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ -EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 585 */ -EXTERN int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, +TCLAPI int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ -EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, +TCLAPI int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ -EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, +TCLAPI void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 588 */ -EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, +TCLAPI int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 589 */ -EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ -EXTERN unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr); /* 591 */ -EXTERN unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr); /* 592 */ -EXTERN int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr); /* 593 */ -EXTERN int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); /* 594 */ -EXTERN int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); /* 595 */ -EXTERN int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); /* 596 */ -EXTERN Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr); /* 597 */ -EXTERN Tcl_WideInt Tcl_GetModificationTimeFromStat( +TCLAPI Tcl_WideInt Tcl_GetModificationTimeFromStat( const Tcl_StatBuf *statPtr); /* 598 */ -EXTERN Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr); /* 599 */ -EXTERN Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr); /* 600 */ -EXTERN Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr); /* 601 */ -EXTERN unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr); /* 602 */ -EXTERN int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 603 */ -EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ -EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, +TCLAPI int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 605 */ -EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); +TCLAPI int Tcl_GetErrorLine(Tcl_Interp *interp); /* 606 */ -EXTERN void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum); +TCLAPI void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum); /* 607 */ -EXTERN void Tcl_TransferResult(Tcl_Interp *sourceInterp, +TCLAPI void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 608 */ -EXTERN int Tcl_InterpActive(Tcl_Interp *interp); +TCLAPI int Tcl_InterpActive(Tcl_Interp *interp); /* 609 */ -EXTERN void Tcl_BackgroundException(Tcl_Interp *interp, int code); +TCLAPI void Tcl_BackgroundException(Tcl_Interp *interp, int code); /* 610 */ -EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, +TCLAPI int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 611 */ -EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format, +TCLAPI int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 612 */ -EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc, +TCLAPI unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, int len); /* 613 */ -EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler, +TCLAPI unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, int len); /* 614 */ -EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, +TCLAPI int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 615 */ -EXTERN Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle); +TCLAPI Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle); /* 616 */ -EXTERN int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle); /* 617 */ -EXTERN int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle); /* 618 */ -EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, +TCLAPI int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 619 */ -EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, +TCLAPI int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 620 */ -EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); /* 621 */ -EXTERN int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle); /* 622 */ -EXTERN void Tcl_SetStartupScript(Tcl_Obj *path, +TCLAPI void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding); /* 623 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr); +TCLAPI Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr); /* 624 */ -EXTERN int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, +TCLAPI int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 625 */ -EXTERN int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 626 */ -EXTERN int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 627 */ -EXTERN int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, +TCLAPI int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 628 */ -EXTERN void * Tcl_FindSymbol(Tcl_Interp *interp, +TCLAPI void * Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 629 */ -EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, +TCLAPI int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 630 */ -EXTERN void Tcl_ZlibStreamSetCompressionDictionary( +TCLAPI void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); @@ -3759,7 +3748,4 @@ extern const TclStubs *tclStubsPtr; Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLDECLS */ diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index bf6a21d..65b1888 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -17,17 +17,6 @@ #include "tclPort.h" -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */ #undef Tcl_AppendExportList #undef Tcl_CreateNamespace @@ -59,162 +48,162 @@ /* Slot 1 is reserved */ /* Slot 2 is reserved */ /* 3 */ -EXTERN void TclAllocateFreeObjects(void); +TCLAPI void TclAllocateFreeObjects(void); /* Slot 4 is reserved */ /* 5 */ -EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, +TCLAPI int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 6 */ -EXTERN void TclCleanupCommand(Command *cmdPtr); +TCLAPI void TclCleanupCommand(Command *cmdPtr); /* 7 */ -EXTERN int TclCopyAndCollapse(int count, const char *src, +TCLAPI int TclCopyAndCollapse(int count, const char *src, char *dst); /* Slot 8 is reserved */ /* 9 */ -EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, +TCLAPI int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 10 */ -EXTERN int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, +TCLAPI int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 11 */ -EXTERN void TclDeleteCompiledLocalVars(Interp *iPtr, +TCLAPI void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr); /* 12 */ -EXTERN void TclDeleteVars(Interp *iPtr, +TCLAPI void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ -EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); +TCLAPI int TclDumpMemoryInfo(ClientData clientData, int flags); /* Slot 15 is reserved */ /* 16 */ -EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); +TCLAPI void TclExprFloatError(Tcl_Interp *interp, double value); /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ /* 22 */ -EXTERN int TclFindElement(Tcl_Interp *interp, +TCLAPI int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ -EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); +TCLAPI Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN int TclFormatInt(char *buffer, long n); +TCLAPI int TclFormatInt(char *buffer, long n); /* 25 */ -EXTERN void TclFreePackageInfo(Interp *iPtr); +TCLAPI void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* 28 */ -EXTERN Tcl_Channel TclpGetDefaultStdChannel(int type); +TCLAPI Tcl_Channel TclpGetDefaultStdChannel(int type); /* Slot 29 is reserved */ /* Slot 30 is reserved */ /* 31 */ -EXTERN const char * TclGetExtension(const char *name); +TCLAPI const char * TclGetExtension(const char *name); /* 32 */ -EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, +TCLAPI int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ /* 34 */ -EXTERN int TclGetIntForIndex(Tcl_Interp *interp, +TCLAPI int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* 37 */ -EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, +TCLAPI int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName); /* 38 */ -EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, +TCLAPI int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ -EXTERN TclObjCmdProcType TclGetObjInterpProc(void); +TCLAPI TclObjCmdProcType TclGetObjInterpProc(void); /* 40 */ -EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, +TCLAPI int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ -EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); +TCLAPI Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ -EXTERN const char * TclpGetUserHome(const char *name, +TCLAPI const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ -EXTERN int TclGuessPackageName(const char *fileName, +TCLAPI int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); /* 45 */ -EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); +TCLAPI int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ -EXTERN int TclInExit(void); +TCLAPI int TclInExit(void); /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ /* 50 */ -EXTERN void TclInitCompiledLocals(Tcl_Interp *interp, +TCLAPI void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 51 */ -EXTERN int TclInterpInit(Tcl_Interp *interp); +TCLAPI int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ -EXTERN int TclInvokeObjectCommand(ClientData clientData, +TCLAPI int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 54 */ -EXTERN int TclInvokeStringCommand(ClientData clientData, +TCLAPI int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ -EXTERN Proc * TclIsProc(Command *cmdPtr); +TCLAPI Proc * TclIsProc(Command *cmdPtr); /* Slot 56 is reserved */ /* Slot 57 is reserved */ /* 58 */ -EXTERN Var * TclLookupVar(Tcl_Interp *interp, const char *part1, +TCLAPI Var * TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* Slot 59 is reserved */ /* 60 */ -EXTERN int TclNeedSpace(const char *start, const char *end); +TCLAPI int TclNeedSpace(const char *start, const char *end); /* 61 */ -EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); +TCLAPI Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ -EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); +TCLAPI int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ -EXTERN int TclObjInterpProc(ClientData clientData, +TCLAPI int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ -EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, +TCLAPI int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -EXTERN char * TclpAlloc(unsigned int size); +TCLAPI char * TclpAlloc(unsigned int size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ -EXTERN void TclpFree(char *ptr); +TCLAPI void TclpFree(char *ptr); /* 75 */ -EXTERN unsigned long TclpGetClicks(void); +TCLAPI unsigned long TclpGetClicks(void); /* 76 */ -EXTERN unsigned long TclpGetSeconds(void); +TCLAPI unsigned long TclpGetSeconds(void); /* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -EXTERN char * TclpRealloc(char *ptr, unsigned int size); +TCLAPI char * TclpRealloc(char *ptr, unsigned int size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -222,221 +211,221 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size); /* Slot 86 is reserved */ /* Slot 87 is reserved */ /* 88 */ -EXTERN char * TclPrecTraceProc(ClientData clientData, +TCLAPI char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 89 */ -EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, +TCLAPI int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* Slot 90 is reserved */ /* 91 */ -EXTERN void TclProcCleanupProc(Proc *procPtr); +TCLAPI void TclProcCleanupProc(Proc *procPtr); /* 92 */ -EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, +TCLAPI int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 93 */ -EXTERN void TclProcDeleteProc(ClientData clientData); +TCLAPI void TclProcDeleteProc(ClientData clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ -EXTERN int TclRenameCommand(Tcl_Interp *interp, +TCLAPI int TclRenameCommand(Tcl_Interp *interp, const char *oldName, const char *newName); /* 97 */ -EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, +TCLAPI void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr); /* 98 */ -EXTERN int TclServiceIdle(void); +TCLAPI int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ -EXTERN const char * TclSetPreInitScript(const char *string); +TCLAPI const char * TclSetPreInitScript(const char *string); /* 102 */ -EXTERN void TclSetupEnv(Tcl_Interp *interp); +TCLAPI void TclSetupEnv(Tcl_Interp *interp); /* 103 */ -EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, +TCLAPI int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ /* 108 */ -EXTERN void TclTeardownNamespace(Namespace *nsPtr); +TCLAPI void TclTeardownNamespace(Namespace *nsPtr); /* 109 */ -EXTERN int TclUpdateReturnInfo(Interp *iPtr); +TCLAPI int TclUpdateReturnInfo(Interp *iPtr); /* 110 */ -EXTERN int TclSockMinimumBuffers(void *sock, int size); +TCLAPI int TclSockMinimumBuffers(void *sock, int size); /* 111 */ -EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, +TCLAPI void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 112 */ -EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, +TCLAPI int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 113 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 114 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); +TCLAPI void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 115 */ -EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 116 */ -EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +TCLAPI Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 118 */ -EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, +TCLAPI int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 119 */ -EXTERN int Tcl_GetNamespaceResolvers( +TCLAPI int Tcl_GetNamespaceResolvers( Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 120 */ -EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, +TCLAPI Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 121 */ -EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, +TCLAPI int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 122 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 123 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, +TCLAPI void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 124 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); /* 125 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); /* 126 */ -EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, +TCLAPI void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 127 */ -EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 128 */ -EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); +TCLAPI void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ -EXTERN int Tcl_PushCallFrame(Tcl_Interp *interp, +TCLAPI int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 130 */ -EXTERN int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, +TCLAPI int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name); /* 131 */ -EXTERN void Tcl_SetNamespaceResolvers( +TCLAPI void Tcl_SetNamespaceResolvers( Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ -EXTERN int TclpHasSockets(Tcl_Interp *interp); +TCLAPI int TclpHasSockets(Tcl_Interp *interp); /* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ -EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr); +TCLAPI const char * TclGetEnv(const char *name, Tcl_DString *valuePtr); /* Slot 139 is reserved */ /* Slot 140 is reserved */ /* 141 */ -EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); +TCLAPI const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ -EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, +TCLAPI int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 143 */ -EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, +TCLAPI int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 144 */ -EXTERN void TclHideLiteral(Tcl_Interp *interp, +TCLAPI void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 145 */ -EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName); +TCLAPI const struct AuxDataType * TclGetAuxDataType(const char *typeName); /* 146 */ -EXTERN TclHandle TclHandleCreate(void *ptr); +TCLAPI TclHandle TclHandleCreate(void *ptr); /* 147 */ -EXTERN void TclHandleFree(TclHandle handle); +TCLAPI void TclHandleFree(TclHandle handle); /* 148 */ -EXTERN TclHandle TclHandlePreserve(TclHandle handle); +TCLAPI TclHandle TclHandlePreserve(TclHandle handle); /* 149 */ -EXTERN void TclHandleRelease(TclHandle handle); +TCLAPI void TclHandleRelease(TclHandle handle); /* 150 */ -EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); +TCLAPI int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ -EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index, +TCLAPI void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 152 */ -EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); +TCLAPI void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ -EXTERN Tcl_Obj * TclGetLibraryPath(void); +TCLAPI Tcl_Obj * TclGetLibraryPath(void); /* Slot 154 is reserved */ /* Slot 155 is reserved */ /* 156 */ -EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, +TCLAPI void TclRegError(Tcl_Interp *interp, const char *msg, int status); /* 157 */ -EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, +TCLAPI Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); /* Slot 158 is reserved */ /* Slot 159 is reserved */ /* Slot 160 is reserved */ /* 161 */ -EXTERN int TclChannelTransform(Tcl_Interp *interp, +TCLAPI int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ -EXTERN void TclChannelEventScriptInvoker(ClientData clientData, +TCLAPI void TclChannelEventScriptInvoker(ClientData clientData, int flags); /* 163 */ -EXTERN const void * TclGetInstructionTable(void); +TCLAPI const void * TclGetInstructionTable(void); /* 164 */ -EXTERN void TclExpandCodeArray(void *envPtr); +TCLAPI void TclExpandCodeArray(void *envPtr); /* 165 */ -EXTERN void TclpSetInitialEncodings(void); +TCLAPI void TclpSetInitialEncodings(void); /* 166 */ -EXTERN int TclListObjSetElement(Tcl_Interp *interp, +TCLAPI int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* Slot 167 is reserved */ /* Slot 168 is reserved */ /* 169 */ -EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, +TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n); /* 170 */ -EXTERN int TclCheckInterpTraces(Tcl_Interp *interp, +TCLAPI int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ -EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, +TCLAPI int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 172 */ -EXTERN int TclInThreadExit(void); +TCLAPI int TclInThreadExit(void); /* 173 */ -EXTERN int TclUniCharMatch(const Tcl_UniChar *string, +TCLAPI int TclUniCharMatch(const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ -EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, +TCLAPI int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 176 */ -EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); +TCLAPI void TclCleanupVar(Var *varPtr, Var *arrayPtr); /* 177 */ -EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, +TCLAPI void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* Slot 178 is reserved */ @@ -460,136 +449,136 @@ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, /* Slot 196 is reserved */ /* Slot 197 is reserved */ /* 198 */ -EXTERN int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* Slot 199 is reserved */ /* 200 */ -EXTERN int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, +TCLAPI int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 201 */ -EXTERN int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, +TCLAPI int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 202 */ -EXTERN int TclpObjCreateDirectory(Tcl_Obj *pathPtr); +TCLAPI int TclpObjCreateDirectory(Tcl_Obj *pathPtr); /* 203 */ -EXTERN int TclpObjDeleteFile(Tcl_Obj *pathPtr); +TCLAPI int TclpObjDeleteFile(Tcl_Obj *pathPtr); /* 204 */ -EXTERN int TclpObjCopyFile(Tcl_Obj *srcPathPtr, +TCLAPI int TclpObjCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */ -EXTERN int TclpObjRenameFile(Tcl_Obj *srcPathPtr, +TCLAPI int TclpObjRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 206 */ -EXTERN int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +TCLAPI int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 207 */ -EXTERN int TclpObjAccess(Tcl_Obj *pathPtr, int mode); +TCLAPI int TclpObjAccess(Tcl_Obj *pathPtr, int mode); /* 208 */ -EXTERN Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* Slot 209 is reserved */ /* Slot 210 is reserved */ /* Slot 211 is reserved */ /* 212 */ -EXTERN void TclpFindExecutable(const char *argv0); +TCLAPI void TclpFindExecutable(const char *argv0); /* 213 */ -EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); +TCLAPI Tcl_Obj * TclGetObjNameOfExecutable(void); /* 214 */ -EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, +TCLAPI void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); /* 215 */ -EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); +TCLAPI void * TclStackAlloc(Tcl_Interp *interp, int numBytes); /* 216 */ -EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); +TCLAPI void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ -EXTERN int TclPushStackFrame(Tcl_Interp *interp, +TCLAPI int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 218 */ -EXTERN void TclPopStackFrame(Tcl_Interp *interp); +TCLAPI void TclPopStackFrame(Tcl_Interp *interp); /* Slot 219 is reserved */ /* Slot 220 is reserved */ /* Slot 221 is reserved */ /* Slot 222 is reserved */ /* Slot 223 is reserved */ /* 224 */ -EXTERN TclPlatformType * TclGetPlatform(void); +TCLAPI TclPlatformType * TclGetPlatform(void); /* 225 */ -EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, +TCLAPI Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 226 */ -EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); +TCLAPI int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ -EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, +TCLAPI void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ -EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, +TCLAPI int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 230 */ -EXTERN Var * TclObjLookupVar(Tcl_Interp *interp, +TCLAPI Var * TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 231 */ -EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp, +TCLAPI int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 232 */ -EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 233 */ -EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); +TCLAPI void TclGetSrcInfoForPc(CmdFrame *contextPtr); /* 234 */ -EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, +TCLAPI Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ -EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, +TCLAPI void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); /* Slot 236 is reserved */ /* 237 */ -EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); +TCLAPI int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ -EXTERN int TclNRInterpProc(ClientData clientData, +TCLAPI int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 239 */ -EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, +TCLAPI int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 240 */ -EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, +TCLAPI int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 241 */ -EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 242 */ -EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc, +TCLAPI int TclNREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 243 */ -EXTERN void TclDbDumpActiveObjects(FILE *outFile); +TCLAPI void TclDbDumpActiveObjects(FILE *outFile); /* 244 */ -EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); +TCLAPI Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); /* 245 */ -EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); +TCLAPI Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); /* 246 */ -EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp, +TCLAPI int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 247 */ -EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, +TCLAPI void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble); /* 248 */ -EXTERN int TclCopyChannel(Tcl_Interp *interp, +TCLAPI int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 249 */ -EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, +TCLAPI char * TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 250 */ -EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, +TCLAPI void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); typedef struct TclIntStubs { @@ -1270,7 +1259,4 @@ extern const TclIntStubs *tclIntStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLINTDECLS */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index c1531f3..80d6236 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -18,17 +18,6 @@ # define DIR void #endif -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -43,38 +32,38 @@ #if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 0 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, +TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 1 */ -EXTERN int TclpCloseFile(TclFile file); +TCLAPI int TclpCloseFile(TclFile file); /* 2 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, +TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, +TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* Slot 5 is reserved */ /* 6 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); +TCLAPI TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +TCLAPI TclFile TclpCreateTempFile(const char *contents); /* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +TCLAPI Tcl_DirEntry * TclpReaddir(DIR *dir); /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI char * TclpInetNtoa(struct in_addr addr); /* 14 */ -EXTERN int TclUnixCopyFile(const char *src, const char *dst, +TCLAPI int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* Slot 15 is reserved */ @@ -83,7 +72,7 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst, /* Slot 18 is reserved */ /* Slot 19 is reserved */ /* 20 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, +TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* Slot 21 is reserved */ @@ -95,136 +84,136 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 27 is reserved */ /* Slot 28 is reserved */ /* 29 */ -EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +TCLAPI int TclWinCPUID(unsigned int index, unsigned int *regs); #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN void TclWinConvertError(DWORD errCode); +TCLAPI void TclWinConvertError(DWORD errCode); /* Slot 1 is reserved */ /* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, +TCLAPI struct servent * TclWinGetServByName(const char *nm, const char *proto); /* 3 */ -EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, +TCLAPI int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen); /* 4 */ -EXTERN HINSTANCE TclWinGetTclInstance(void); +TCLAPI HINSTANCE TclWinGetTclInstance(void); /* 5 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +TCLAPI unsigned short TclWinNToHS(unsigned short ns); /* 7 */ -EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, +TCLAPI int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen); /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); +TCLAPI int TclpGetPid(Tcl_Pid pid); /* 9 */ -EXTERN int TclWinGetPlatformId(void); +TCLAPI int TclWinGetPlatformId(void); /* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +TCLAPI Tcl_DirEntry * TclpReaddir(DIR *dir); /* 11 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, +TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 12 */ -EXTERN int TclpCloseFile(TclFile file); +TCLAPI int TclpCloseFile(TclFile file); /* 13 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, +TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 14 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 15 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, +TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ -EXTERN int TclpIsAtty(int fd); +TCLAPI int TclpIsAtty(int fd); /* 17 */ -EXTERN int TclUnixCopyFile(const char *src, const char *dst, +TCLAPI int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 18 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); +TCLAPI TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ -EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); +TCLAPI void TclWinAddProcess(HANDLE hProcess, DWORD id); /* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI char * TclpInetNtoa(struct in_addr addr); /* 22 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +TCLAPI TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ -EXTERN char * TclWinNoBackslash(char *path); +TCLAPI char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ /* 26 */ -EXTERN void TclWinSetInterfaces(int wide); +TCLAPI void TclWinSetInterfaces(int wide); /* 27 */ -EXTERN void TclWinFlushDirtyChannels(void); +TCLAPI void TclWinFlushDirtyChannels(void); /* 28 */ -EXTERN void TclWinResetInterfaces(void); +TCLAPI void TclWinResetInterfaces(void); /* 29 */ -EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +TCLAPI int TclWinCPUID(unsigned int index, unsigned int *regs); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, +TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 1 */ -EXTERN int TclpCloseFile(TclFile file); +TCLAPI int TclpCloseFile(TclFile file); /* 2 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, +TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, +TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* Slot 5 is reserved */ /* 6 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); +TCLAPI TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +TCLAPI TclFile TclpCreateTempFile(const char *contents); /* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +TCLAPI Tcl_DirEntry * TclpReaddir(DIR *dir); /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI char * TclpInetNtoa(struct in_addr addr); /* 14 */ -EXTERN int TclUnixCopyFile(const char *src, const char *dst, +TCLAPI int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 15 */ -EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, +TCLAPI int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 16 */ -EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp, +TCLAPI int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 17 */ -EXTERN int TclMacOSXCopyFileAttributes(const char *src, +TCLAPI int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 18 */ -EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, +TCLAPI int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 19 */ -EXTERN void TclMacOSXNotifierAddRunLoopMode( +TCLAPI void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* 20 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, +TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* Slot 21 is reserved */ @@ -236,7 +225,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 27 is reserved */ /* Slot 28 is reserved */ /* 29 */ -EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +TCLAPI int TclWinCPUID(unsigned int index, unsigned int *regs); #endif /* MACOSX */ typedef struct TclIntPlatStubs { @@ -516,9 +505,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #if defined(__WIN32__) || defined(__CYGWIN__) # undef TclWinNToHS # define TclWinNToHS ntohs diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index e9b92fe..4e6f29fa 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -10,17 +10,6 @@ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -48,19 +37,19 @@ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, +TCLAPI TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); /* 1 */ -EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, +TCLAPI char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, +TCLAPI int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ -EXTERN int Tcl_MacOSXOpenVersionedBundleResources( +TCLAPI int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, @@ -112,9 +101,6 @@ extern const TclPlatStubs *tclPlatStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLPLATDECLS */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 7a10bef..07be9e9 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -42,16 +42,8 @@ * Declare external functions used in Windows tests. */ -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Tcltest_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -EXTERN int Tcltest_Init(Tcl_Interp *interp); -EXTERN int Tcltest_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Tcltest_Init(Tcl_Interp *interp); +DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index ea3abb1..2124378 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -19,7 +19,7 @@ library tcl interface tclTomMath # hooks {tclTomMathInt} -scspec EXTERN +scspec TCLAPI # Declare each of the functions in the Tcl tommath interface diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index ef22153..b6dec32 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -115,17 +115,6 @@ #define s_mp_sqr TclBN_s_mp_sqr #define s_mp_sub TclBN_s_mp_sub -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -139,142 +128,142 @@ */ /* 0 */ -EXTERN int TclBN_epoch(void); +TCLAPI int TclBN_epoch(void); /* 1 */ -EXTERN int TclBN_revision(void); +TCLAPI int TclBN_revision(void); /* 2 */ -EXTERN int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c); /* 3 */ -EXTERN int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c); +TCLAPI int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c); /* 4 */ -EXTERN int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c); /* 5 */ -EXTERN void TclBN_mp_clamp(mp_int *a); +TCLAPI void TclBN_mp_clamp(mp_int *a); /* 6 */ -EXTERN void TclBN_mp_clear(mp_int *a); +TCLAPI void TclBN_mp_clear(mp_int *a); /* 7 */ -EXTERN void TclBN_mp_clear_multi(mp_int *a, ...); +TCLAPI void TclBN_mp_clear_multi(mp_int *a, ...); /* 8 */ -EXTERN int TclBN_mp_cmp(const mp_int *a, const mp_int *b); +TCLAPI int TclBN_mp_cmp(const mp_int *a, const mp_int *b); /* 9 */ -EXTERN int TclBN_mp_cmp_d(const mp_int *a, mp_digit b); +TCLAPI int TclBN_mp_cmp_d(const mp_int *a, mp_digit b); /* 10 */ -EXTERN int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b); +TCLAPI int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b); /* 11 */ -EXTERN int TclBN_mp_copy(const mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_copy(const mp_int *a, mp_int *b); /* 12 */ -EXTERN int TclBN_mp_count_bits(const mp_int *a); +TCLAPI int TclBN_mp_count_bits(const mp_int *a); /* 13 */ -EXTERN int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, +TCLAPI int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 14 */ -EXTERN int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, +TCLAPI int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 15 */ -EXTERN int TclBN_mp_div_2(mp_int *a, mp_int *q); +TCLAPI int TclBN_mp_div_2(mp_int *a, mp_int *q); /* 16 */ -EXTERN int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, +TCLAPI int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r); /* 17 */ -EXTERN int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r); +TCLAPI int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r); /* 18 */ -EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); +TCLAPI void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ -EXTERN int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c); +TCLAPI int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c); /* 20 */ -EXTERN int TclBN_mp_grow(mp_int *a, int size); +TCLAPI int TclBN_mp_grow(mp_int *a, int size); /* 21 */ -EXTERN int TclBN_mp_init(mp_int *a); +TCLAPI int TclBN_mp_init(mp_int *a); /* 22 */ -EXTERN int TclBN_mp_init_copy(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_init_copy(mp_int *a, mp_int *b); /* 23 */ -EXTERN int TclBN_mp_init_multi(mp_int *a, ...); +TCLAPI int TclBN_mp_init_multi(mp_int *a, ...); /* 24 */ -EXTERN int TclBN_mp_init_set(mp_int *a, mp_digit b); +TCLAPI int TclBN_mp_init_set(mp_int *a, mp_digit b); /* 25 */ -EXTERN int TclBN_mp_init_size(mp_int *a, int size); +TCLAPI int TclBN_mp_init_size(mp_int *a, int size); /* 26 */ -EXTERN int TclBN_mp_lshd(mp_int *a, int shift); +TCLAPI int TclBN_mp_lshd(mp_int *a, int shift); /* 27 */ -EXTERN int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r); +TCLAPI int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r); /* 28 */ -EXTERN int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r); +TCLAPI int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r); /* 29 */ -EXTERN int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p); +TCLAPI int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p); /* 30 */ -EXTERN int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p); +TCLAPI int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p); /* 31 */ -EXTERN int TclBN_mp_mul_2(mp_int *a, mp_int *p); +TCLAPI int TclBN_mp_mul_2(mp_int *a, mp_int *p); /* 32 */ -EXTERN int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p); +TCLAPI int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p); /* 33 */ -EXTERN int TclBN_mp_neg(const mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_neg(const mp_int *a, mp_int *b); /* 34 */ -EXTERN int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c); /* 35 */ -EXTERN int TclBN_mp_radix_size(mp_int *a, int radix, int *size); +TCLAPI int TclBN_mp_radix_size(mp_int *a, int radix, int *size); /* 36 */ -EXTERN int TclBN_mp_read_radix(mp_int *a, const char *str, +TCLAPI int TclBN_mp_read_radix(mp_int *a, const char *str, int radix); /* 37 */ -EXTERN void TclBN_mp_rshd(mp_int *a, int shift); +TCLAPI void TclBN_mp_rshd(mp_int *a, int shift); /* 38 */ -EXTERN int TclBN_mp_shrink(mp_int *a); +TCLAPI int TclBN_mp_shrink(mp_int *a); /* 39 */ -EXTERN void TclBN_mp_set(mp_int *a, mp_digit b); +TCLAPI void TclBN_mp_set(mp_int *a, mp_digit b); /* 40 */ -EXTERN int TclBN_mp_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_sqr(mp_int *a, mp_int *b); /* 41 */ -EXTERN int TclBN_mp_sqrt(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_sqrt(mp_int *a, mp_int *b); /* 42 */ -EXTERN int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c); /* 43 */ -EXTERN int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c); +TCLAPI int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c); /* 44 */ -EXTERN int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b); +TCLAPI int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b); /* 45 */ -EXTERN int TclBN_mp_to_unsigned_bin_n(mp_int *a, +TCLAPI int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b, unsigned long *outlen); /* 46 */ -EXTERN int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, +TCLAPI int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen); /* 47 */ -EXTERN int TclBN_mp_unsigned_bin_size(mp_int *a); +TCLAPI int TclBN_mp_unsigned_bin_size(mp_int *a); /* 48 */ -EXTERN int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c); /* 49 */ -EXTERN void TclBN_mp_zero(mp_int *a); +TCLAPI void TclBN_mp_zero(mp_int *a); /* 50 */ -EXTERN void TclBN_reverse(unsigned char *s, int len); +TCLAPI void TclBN_reverse(unsigned char *s, int len); /* 51 */ -EXTERN int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, +TCLAPI int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs); /* 52 */ -EXTERN int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b); /* 53 */ -EXTERN int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, +TCLAPI int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c); /* 54 */ -EXTERN int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b); /* 55 */ -EXTERN int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c); /* 56 */ -EXTERN int TclBN_mp_toom_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_toom_sqr(mp_int *a, mp_int *b); /* 57 */ -EXTERN int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c); /* 58 */ -EXTERN int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, +TCLAPI int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs); /* 59 */ -EXTERN int TclBN_s_mp_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_s_mp_sqr(mp_int *a, mp_int *b); /* 60 */ -EXTERN int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c); /* 61 */ -EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i); +TCLAPI int TclBN_mp_init_set_int(mp_int *a, unsigned long i); /* 62 */ -EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i); +TCLAPI int TclBN_mp_set_int(mp_int *a, unsigned long i); /* 63 */ -EXTERN int TclBN_mp_cnt_lsb(const mp_int *a); +TCLAPI int TclBN_mp_cnt_lsb(const mp_int *a); typedef struct TclTomMathStubs { int magic; @@ -493,7 +482,4 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLINTDECLS */ diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 6ce4243..6e49519 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -1135,6 +1135,7 @@ proc genStubs::init {} { variable outDir variable interfaces +variable scspec if {[llength $argv] < 2} { puts stderr "usage: $argv0 outDir declFile ?declFile...?" exit 1 diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index c4d3f32..7e5d7d3 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -10,18 +10,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkga_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -124,7 +115,7 @@ Pkga_QuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkga_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index fe0d365..71b42e1 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgb_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +105,7 @@ Pkgb_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgb_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +142,7 @@ Pkgb_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgb_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 557f21b..4e3e174 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgc_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +105,7 @@ Pkgc_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +142,7 @@ Pkgc_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 6e114e9..4a1defa 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgd_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +105,7 @@ Pkgd_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +142,7 @@ Pkgd_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index d616352..36c8c1a 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -11,17 +11,8 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkge_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - /* *---------------------------------------------------------------------- @@ -40,7 +31,7 @@ *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkge_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 417bedb..2a38525 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgua_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -200,7 +191,7 @@ PkguaQuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -253,7 +244,7 @@ Pkgua_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -278,7 +269,7 @@ Pkgua_SafeInit( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Unload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ @@ -331,7 +322,7 @@ Pkgua_Unload( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_SafeUnload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index f73c164..4be3d7b 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -12,15 +12,6 @@ */ #include - -/* - * On some HP machines, dl.h defines EXTERN; remove that definition. - */ - -#ifdef EXTERN -# undef EXTERN -#endif - #include "tclInt.h" /* diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 5cf7d60..9b3872e 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -33,16 +33,6 @@ #endif /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init - * declaration is in the source file itself, which is only accessed when we - * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE - * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -134,8 +124,8 @@ static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int Dde_Init(Tcl_Interp *interp); -EXTERN int Dde_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Dde_Init(Tcl_Interp *interp); +DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- diff --git a/win/tclWinReg.c b/win/tclWinReg.c index dadfa2b..619d9df 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -49,15 +49,6 @@ #endif /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Registry_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The following macros convert between different endian ints. */ @@ -140,8 +131,8 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); -EXTERN int Registry_Init(Tcl_Interp *interp); -EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); +DLLEXPORT int Registry_Init(Tcl_Interp *interp); +DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); /* *---------------------------------------------------------------------- -- cgit v0.12 From b05600e60ad35cb737437061dd6142465741581d Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 21:03:06 +0000 Subject: Stop defining VOID. Demand C compilers that know the void keyword. --- generic/tcl.h | 52 +++++++++------------------------------------------- 1 file changed, 9 insertions(+), 43 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 786c64e..201a45b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -230,44 +230,10 @@ extern "C" { #endif /* - *---------------------------------------------------------------------------- - * The following code is copied from winnt.h. If we don't replicate it here, - * then can't be included after tcl.h, since tcl.h also defines - * VOID. This block is skipped under Cygwin and Mingw. - */ - -#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID) -#ifndef VOID -#define VOID void -typedef char CHAR; -typedef short SHORT; -typedef long LONG; -#endif -#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */ - -/* - * Macro to use instead of "void" for arguments that must have type "void *" - * in ANSI C; maps them to type "char *" in non-ANSI systems. - */ - -#ifndef NO_VOID -# define VOID void -#else -# define VOID char -#endif - -/* * Miscellaneous declarations. */ -#ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif -# define _CLIENTDATA -#endif +typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where @@ -2310,15 +2276,15 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ - ((VOID *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) + ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define ckfree(x) \ Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) # define ckrealloc(x,y) \ - ((VOID *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) # define attemptckalloc(x) \ - ((VOID *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) + ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define attemptckrealloc(x,y) \ - ((VOID *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) #else /* !TCL_MEM_DEBUG */ @@ -2329,15 +2295,15 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ # define ckalloc(x) \ - ((VOID *) Tcl_Alloc((unsigned)(x))) + ((void *) Tcl_Alloc((unsigned)(x))) # define ckfree(x) \ Tcl_Free((char *)(x)) # define ckrealloc(x,y) \ - ((VOID *) Tcl_Realloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) # define attemptckalloc(x) \ - ((VOID *) Tcl_AttemptAlloc((unsigned)(x))) + ((void *) Tcl_AttemptAlloc((unsigned)(x))) # define attemptckrealloc(x,y) \ - ((VOID *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory -- cgit v0.12 From b2ca802381bc6f87b8d9e5255941c3c6ce735240 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 21:25:52 +0000 Subject: Purge remnants of support for compilers ignorant of C keyword 'inline'. --- generic/tcl.h | 9 --------- generic/tclUtf.c | 4 ++-- 2 files changed, 2 insertions(+), 11 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 201a45b..33bf149 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -221,15 +221,6 @@ extern "C" { #endif /* - * Definitions that allow this header file to be used either with or without - * ANSI C features. - */ - -#ifndef INLINE -# define INLINE -#endif - -/* * Miscellaneous declarations. */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 4b5b37b..93ab34b 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -107,7 +107,7 @@ static int UtfCount(int ch); *--------------------------------------------------------------------------- */ -INLINE static int +inline static int UtfCount( int ch) /* The Tcl_UniChar whose size is returned. */ { @@ -152,7 +152,7 @@ UtfCount( *--------------------------------------------------------------------------- */ -INLINE int +inline int Tcl_UniCharToUtf( int ch, /* The Tcl_UniChar to be stored in the * buffer. */ -- cgit v0.12 From 388741b7d05e54a2dd6989f18100e2bb2aff85d0 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 21:28:24 +0000 Subject: Bug fix. Stop load-3.2 test failure. --- generic/tclLoad.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 61c763f..6f5b9cf 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -474,9 +474,8 @@ Tcl_LoadObjCmd( /* We have an Tcl 8.x extension with incompatible stub table. */ Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); Tcl_SetObjResult(interp, obj); - } else { - Tcl_TransferResult(target, code, interp); } + Tcl_TransferResult(target, code, interp); goto done; } -- cgit v0.12 From f52f05c3b18acb227195e67c74f3809f824a35fb Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 21:34:22 +0000 Subject: No string result -> no more need for TCL_RESULT_SIZE --- generic/tcl.h | 2 -- 1 file changed, 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index c7b9e6a..48b5d53 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -600,8 +600,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_BREAK 3 #define TCL_CONTINUE 4 -#define TCL_RESULT_SIZE 200 - /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): -- cgit v0.12 From 8e6efd70260d3e66cefce5a84f130d3d6f30c06d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 30 Nov 2012 15:55:03 +0000 Subject: After a Tcl_SetObjResult, don't do a Tcl_TransferResult to the same interpreter --- generic/tclLoad.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 6f5b9cf..61c763f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -474,8 +474,9 @@ Tcl_LoadObjCmd( /* We have an Tcl 8.x extension with incompatible stub table. */ Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); Tcl_SetObjResult(interp, obj); + } else { + Tcl_TransferResult(target, code, interp); } - Tcl_TransferResult(target, code, interp); goto done; } -- cgit v0.12 From 21e80b3a2597bf0fd3929581c7920833e2d26ab8 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 30 Nov 2012 16:10:20 +0000 Subject: Stop [glob] complaining about empty list result. Continue support for a no-op -nocomplain option, but don't document it. Old script support only. --- doc/glob.n | 5 ----- generic/tclFileName.c | 51 ++++++++++++++------------------------------------- generic/tclInt.h | 13 ------------- library/package.tcl | 3 +++ tests/fCmd.test | 8 ++++---- tests/fileName.test | 14 +++++++------- 6 files changed, 28 insertions(+), 66 deletions(-) diff --git a/doc/glob.n b/doc/glob.n index 7b71189..11cd952 100644 --- a/doc/glob.n +++ b/doc/glob.n @@ -44,11 +44,6 @@ The remaining pattern arguments, after option processing, are treated as a single pattern obtained by joining the arguments with directory separators. .TP -\fB\-nocomplain\fR -. -Allows an empty list to be returned without error; without this -switch an error is returned if the result list would be empty. -.TP \fB\-path\fR \fIpathPrefix\fR . Search for files with the given \fIpathPrefix\fR where the rest of the name diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5d4702b..a519f0e 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -37,6 +37,15 @@ static Tcl_Obj * SplitUnixPath(const char *path); static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, const char *separators, Tcl_Obj *pathPtr, int flags, char *pattern, Tcl_GlobTypeData *types); +static int TclGlob(Tcl_Interp *interp, char *pattern, + Tcl_Obj *pathPrefix, int globFlags, + Tcl_GlobTypeData *types); + +/* Flag values used by TclGlob() */ + +#define TCL_GLOBMODE_JOIN 2 +#define TCL_GLOBMODE_DIR 4 +#define TCL_GLOBMODE_TAILS 8 /* * When there is no support for getting the block size of a file in a stat() @@ -1270,7 +1279,10 @@ Tcl_GlobObjCmd( switch (index) { case GLOB_NOCOMPLAIN: /* -nocomplain */ - globFlags |= TCL_GLOBMODE_NO_COMPLAIN; + /* + * Do nothing; This is normal operations in Tcl 9. + * Keep accepting as a no-op option to accommodate old scripts. + */ break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { @@ -1620,41 +1632,6 @@ Tcl_GlobObjCmd( } } - if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) { - if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp), - &length) != TCL_OK) { - /* - * This should never happen. Maybe we should be more dramatic. - */ - - result = TCL_ERROR; - goto endOfGlob; - } - - if (length == 0) { - Tcl_Obj *errorMsg = - Tcl_ObjPrintf("no files matched glob pattern%s \"", - (join || (objc == 1)) ? "" : "s"); - - if (join) { - Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); - } else { - const char *sep = ""; - - for (i = 0; i < objc; i++) { - Tcl_AppendPrintfToObj(errorMsg, "%s%s", - sep, Tcl_GetString(objv[i])); - sep = " "; - } - } - Tcl_AppendToObj(errorMsg, "\"", -1); - Tcl_SetObjResult(interp, errorMsg); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", - NULL); - result = TCL_ERROR; - } - } - endOfGlob: if (join || (dir == PATH_GENERAL)) { Tcl_DStringFree(&prefix); @@ -1705,7 +1682,7 @@ Tcl_GlobObjCmd( */ /* ARGSUSED */ -int +static int TclGlob( Tcl_Interp *interp, /* Interpreter for returning error message or * appending list of matching file names. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index d548a16..8110248 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2592,16 +2592,6 @@ typedef struct TclFileAttrProcs { typedef struct TclFile_ *TclFile; -/* - * The "globParameters" argument of the function TclGlob is an or'ed - * combination of the following values: - */ - -#define TCL_GLOBMODE_NO_COMPLAIN 1 -#define TCL_GLOBMODE_JOIN 2 -#define TCL_GLOBMODE_DIR 4 -#define TCL_GLOBMODE_TAILS 8 - typedef enum Tcl_PathPart { TCL_PATH_DIRNAME, TCL_PATH_TAIL, @@ -2982,9 +2972,6 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr); -MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, - Tcl_Obj *unquotedPrefix, int globFlags, - Tcl_GlobTypeData *types); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, diff --git a/library/package.tcl b/library/package.tcl index c30431c..5b99a69 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -137,6 +137,9 @@ proc pkg_mkIndex {args} { } on error {msg opt} { return -options $opt $msg } + if {[llength $fileList] == 0} { + return -code error "no files matched glob pattern \"$patternList\"" + } foreach file $fileList { # For each file, figure out what commands and packages it provides. # To do this, create a child interpreter, load the file into the diff --git a/tests/fCmd.test b/tests/fCmd.test index 325b374..9fae2c5 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -745,12 +745,12 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { } -result {bad option "-tf1": must be -force or --} test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { cleanup -} -constraints {notRoot} -returnCodes error -body { +} -constraints {notRoot} -body { createfile -- createfile -force file delete -force -force -- -- -force glob -- -- -force -} -result {no files matched glob patterns "-- -force"} +} -result {} test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot knownBug} -body { @@ -938,9 +938,9 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { testchmod 444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] - list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ + list [glob tf*] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] +} -result [subst {{} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { diff --git a/tests/fileName.test b/tests/fileName.test index 51f00d1..2dac0df 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -696,9 +696,9 @@ test filename-10.24 {Tcl_TranslateFileName} -body { testtranslatefilename ~ouster/foo } -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename} -test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body { +test filename-11.1 {Tcl_GlobCmd} -body { glob -} -result {no files matched glob patterns ""} +} -result {} test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body { glob -gorp } -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --} @@ -714,9 +714,9 @@ test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body { test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body { glob ~xyqrszzz } -result {user "xyqrszzz" doesn't exist} -test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body { +test filename-11.7 {Tcl_GlobCmd} -body { glob -- -nocomplain -} -result {no files matched glob pattern "-nocomplain"} +} -result {} test filename-11.8 {Tcl_GlobCmd} -body { glob -nocomplain -- -nocomplain } -result {} @@ -1085,7 +1085,7 @@ test filename-12.1 {simple globbing} {unixOrPc} { } {.} test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body { glob -types f {} -} -returnCodes error -result {no files matched glob pattern ""} +} -result {} test filename-12.1.2 {simple globbing} {unixOrPc} { glob -types d {} } {.} @@ -1247,10 +1247,10 @@ test filename-14.20 {asterisks, question marks, and brackets} { } {} test filename-14.21 {asterisks, question marks, and brackets} -body { glob globTest/*/gorp -} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"} +} -result {} test filename-14.22 {asterisks, question marks, and brackets} -body { glob goo/* x*z foo?q -} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"} +} -result {} test filename-14.23 {slash globbing} {unix} { glob / } / -- cgit v0.12 From 1e6fd4531c4e31e4df741405eae3cc88980d6b83 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 30 Nov 2012 16:14:11 +0000 Subject: Re-fix failing load-3.2 test. The right way this time. --- generic/tclLoad.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 61c763f..5c47a6b 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -473,10 +473,9 @@ Tcl_LoadObjCmd( if (iPtr->result != NULL && iPtr->result[0] != '\0') { /* We have an Tcl 8.x extension with incompatible stub table. */ Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); - Tcl_SetObjResult(interp, obj); - } else { - Tcl_TransferResult(target, code, interp); + Tcl_SetObjResult(target, obj); } + Tcl_TransferResult(target, code, interp); goto done; } -- cgit v0.12 From ef0bb68bcb7408ec078badf8cacadd093cd1eac8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 3 Dec 2012 10:01:20 +0000 Subject: Initialize legacyFreeProc with invalid value: This will result in a crash immediately, when an extention tries to call it, in stead of crashing some time later.... Remove some more legacy regarding accessing interp->result --- doc/Interp.3 | 13 ------------- doc/SetResult.3 | 14 ++++---------- generic/tclBasic.c | 10 ++++------ generic/tclInt.h | 4 ++-- generic/tclLoad.c | 3 ++- generic/tclResult.c | 17 ----------------- generic/tclStubLib.c | 4 ++-- 7 files changed, 14 insertions(+), 51 deletions(-) diff --git a/doc/Interp.3 b/doc/Interp.3 index d908057..d5006f9 100644 --- a/doc/Interp.3 +++ b/doc/Interp.3 @@ -33,19 +33,6 @@ the pointer as described below is no longer supported. The supported public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead. .PP -For legacy programs and extensions no longer being maintained, compiles -against the Tcl 8.6 header files are only possible with the compiler -directives -.CS -#define USE_INTERP_RESULT -.CE -and/or -.CS -#define USE_INTERP_ERRORLINE -.CE -depending on which fields of the \fBTcl_Interp\fR struct are accessed. -These directives may be embedded in code or supplied via compiler options. -.PP The \fIresult\fR and \fIfreeProc\fR fields are used to return results or error messages from commands. This information is returned by command procedures back to \fBTcl_Eval\fR, diff --git a/doc/SetResult.3 b/doc/SetResult.3 index bbeedf1..c863c5a 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -199,17 +199,11 @@ change \fIinterp->result\fR or clear error state. is about to replace one result value with another. .SS "DIRECT ACCESS TO INTERP->RESULT" .PP -It used to be legal for programs to -directly read and write \fIinterp->result\fR -to manipulate the interpreter result. The Tcl headers no longer -permit this access by default, and C code still doing this must -be updated to use supported routines \fBTcl_GetObjResult\fR, +It used to be legal for programs to directly read and write +\fIinterp->result\fR to manipulate the interpreter result. +The Tcl headers no longer permit this access, and C code still +doing this must be updated to use supported routines \fBTcl_GetObjResult\fR, \fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR. -As a migration aid, access can be restored with the compiler directive -.CS -#define USE_INTERP_RESULT -.CE -but this is meant only to offer life support to otherwise dead code. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 24a1082..7202184 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -486,7 +486,11 @@ Tcl_CreateInterp(void) interp = (Tcl_Interp *) iPtr; iPtr->legacyResult = NULL; + /* Special invalid value: Any attempt to free the legacy result + * will cause a crash. */ + iPtr->legacyFreeProc = (void (*) (void))-1; iPtr->errorLine = 0; + iPtr->stubTable = &tclStubs; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); @@ -681,12 +685,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 5192688..0efb1b6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1811,8 +1811,8 @@ typedef struct Interp { * that one undisturbed. */ - char *legacyResult; - Tcl_FreeProc *legacyFreeProc; + const char *legacyResult; + void (*legacyFreeProc) (void); int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 80efdd8..75e513d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -470,7 +470,7 @@ Tcl_LoadObjCmd( if (code != TCL_OK) { Interp *iPtr = (Interp *) target; - if (iPtr->legacyResult != NULL) { + if (iPtr->legacyResult && !iPtr->legacyFreeProc) { /* * A call to Tcl_InitStubs() determined the caller extension and * this interp are incompatible in their stubs mechanisms, and @@ -478,6 +478,7 @@ Tcl_LoadObjCmd( */ Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); iPtr->legacyResult = NULL; + iPtr->legacyFreeProc = (void (*) (void))-1; } Tcl_TransferResult(target, code, interp); goto done; diff --git a/generic/tclResult.c b/generic/tclResult.c index b8f9c92..618b7d8 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -474,23 +474,6 @@ Tcl_AppendResultVA( } Tcl_AppendStringsToObjVA(objPtr, argList); Tcl_SetObjResult(interp, objPtr); - - /* - * Strictly we should call Tcl_GetStringResult(interp) here to make sure - * that interp->result is correct according to the old contract, but that - * makes the performance of much code (e.g. in Tk) absolutely awful. So we - * leave it out; code that really wants interp->result can just insert the - * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion] - */ - -#ifdef USE_INTERP_RESULT - /* - * Ensure that the interp->result is legal so old Tcl 7.* code still - * works. There's still embarrasingly much of it about... - */ - - (void) Tcl_GetStringResult(interp); -#endif /* USE_INTERP_RESULT */ } /* diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 501072c..9a2e063 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -47,8 +47,8 @@ HasStubSupport( return iPtr->stubTable; } iPtr->legacyResult - = (char *) "interpreter uses an incompatible stubs mechanism"; - iPtr->legacyFreeProc = TCL_STATIC; + = "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } -- cgit v0.12 From 3ff398393a61d9fe1b2b7465c1d88404dbf0fe76 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 3 Dec 2012 13:02:08 +0000 Subject: Remove obsolete functions Tcl_GetDefaultEncodingDir and Tcl_SetDefaultEncodingDir --- doc/Encoding.3 | 19 ++-------------- generic/tcl.decls | 16 +++++++------ generic/tclDecls.h | 16 +++++-------- generic/tclEncoding.c | 62 --------------------------------------------------- generic/tclStubInit.c | 4 ++-- unix/tclUnixTest.c | 48 ++++++++++++++++++++++++++------------- 6 files changed, 51 insertions(+), 114 deletions(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 7bcb285..8432d61 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -8,7 +8,7 @@ .TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings +Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include \fR @@ -62,12 +62,6 @@ Tcl_Obj * .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) -.sp -const char * -\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR) -.sp -void -\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR) .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in @@ -325,7 +319,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned. \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by -\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the +\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP @@ -440,15 +434,6 @@ are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. -.PP -\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR -are obsolete interfaces best replaced with calls to -\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR. -They are called to access and set the first element of the \fIsearchPath\fR -list. Since Tcl searches \fIsearchPath\fR for encoding data files in -list order, these routines establish the -.QW default -directory in which to find encoding data files. .SH "ENCODING FILES" Space would prohibit precompiling into Tcl every possible encoding algorithm, so many encodings are stored on disk as dynamically-loadable diff --git a/generic/tcl.decls b/generic/tcl.decls index ec7864d..ad725f5 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -515,7 +515,7 @@ declare 142 { declare 143 { void Tcl_Finalize(void) } -# Removed in 9.0: +# Removed (from stubtable only) in 9.0: #declare 144 { # void Tcl_FindExecutable(const char *argv0) #} @@ -1217,12 +1217,14 @@ declare 339 { declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -declare 341 { - const char *Tcl_GetDefaultEncodingDir(void) -} -declare 342 { - void Tcl_SetDefaultEncodingDir(const char *path) -} +# Removed in 9.0 +#declare 341 { +# const char *Tcl_GetDefaultEncodingDir(void) +#} +# Removed in 9.0 +#declare 342 { +# void Tcl_SetDefaultEncodingDir(const char *path) +#} declare 343 { void Tcl_AlertNotifier(ClientData clientData) } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1b7cf99..d38296d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -964,10 +964,8 @@ TCLAPI int Tcl_WriteChars(Tcl_Channel chan, const char *src, TCLAPI int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ TCLAPI char * Tcl_GetString(Tcl_Obj *objPtr); -/* 341 */ -TCLAPI const char * Tcl_GetDefaultEncodingDir(void); -/* 342 */ -TCLAPI void Tcl_SetDefaultEncodingDir(const char *path); +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ /* 343 */ TCLAPI void Tcl_AlertNotifier(ClientData clientData); /* 344 */ @@ -2146,8 +2144,8 @@ typedef struct TclStubs { int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ - const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ - void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ + void (*reserved341)(void); + void (*reserved342)(void); void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ @@ -3142,10 +3140,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ -#define Tcl_GetDefaultEncodingDir \ - (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ -#define Tcl_SetDefaultEncodingDir \ - (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 7a55724..d2c7bc8 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -672,68 +672,6 @@ TclFinalizeEncodingSubsystem(void) /* *------------------------------------------------------------------------- * - * Tcl_GetDefaultEncodingDir -- - * - * Legacy public interface to retrieve first directory in the encoding - * searchPath. - * - * Results: - * The directory pathname, as a string, or NULL for an empty encoding - * search path. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -const char * -Tcl_GetDefaultEncodingDir(void) -{ - int numDirs; - Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); - - Tcl_ListObjLength(NULL, searchPath, &numDirs); - if (numDirs == 0) { - return NULL; - } - Tcl_ListObjIndex(NULL, searchPath, 0, &first); - - return Tcl_GetString(first); -} - -/* - *------------------------------------------------------------------------- - * - * Tcl_SetDefaultEncodingDir -- - * - * Legacy public interface to set the first directory in the encoding - * search path. - * - * Results: - * None. - * - * Side effects: - * Modifies the encoding search path. - * - *------------------------------------------------------------------------- - */ - -void -Tcl_SetDefaultEncodingDir( - const char *path) -{ - Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); - Tcl_Obj *directory = Tcl_NewStringObj(path, -1); - - searchPath = Tcl_DuplicateObj(searchPath); - Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); - Tcl_SetEncodingSearchPath(searchPath); -} - -/* - *------------------------------------------------------------------------- - * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7106d3d..6718ef8 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -983,8 +983,8 @@ const TclStubs tclStubs = { Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ - Tcl_GetDefaultEncodingDir, /* 341 */ - Tcl_SetDefaultEncodingDir, /* 342 */ + 0, /* 341 */ + 0, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 46fc972..c0c05f0 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -67,10 +67,10 @@ static Tcl_CmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_CmdProc TestgetdefencdirCmd; +static Tcl_ObjCmdProc TestgetdefencdirCmd; static Tcl_CmdProc TestgetopenfileCmd; static Tcl_CmdProc TestgotsigCmd; -static Tcl_CmdProc TestsetdefencdirCmd; +static Tcl_ObjCmdProc TestsetdefencdirCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); @@ -105,9 +105,9 @@ TclplatformtestInit( NULL, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, + Tcl_CreateObjCommand(interp, "testgetdefenc", TestgetdefencdirCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, + Tcl_CreateObjCommand(interp, "testsetdefenc", TestsetdefencdirCmd, NULL, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); @@ -514,16 +514,22 @@ static int TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " defaultDir\"", NULL); + Tcl_Obj *searchPath; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); return TCL_ERROR; } - Tcl_SetDefaultEncodingDir(argv[1]); + searchPath = Tcl_GetEncodingSearchPath(); + + searchPath = Tcl_DuplicateObj(searchPath); + Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &objv[1]); + Tcl_SetEncodingSearchPath(searchPath); + return TCL_OK; } @@ -548,15 +554,25 @@ static int TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { - if (argc != 1) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); - return TCL_ERROR; + int numDirs; + Tcl_Obj *first, *searchPath; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + searchPath = Tcl_GetEncodingSearchPath(); + Tcl_ListObjLength(interp, searchPath, &numDirs); + if (numDirs == 0) { + return TCL_ERROR; } + Tcl_ListObjIndex(NULL, searchPath, 0, &first); - Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL); + Tcl_SetObjResult(interp, first); return TCL_OK; } -- cgit v0.12 From 949c30336f1aea82abdd123ddbdf9d66161c2c56 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Dec 2012 05:01:04 +0000 Subject: Rename the memory routines so that Tcl_Alloc/Tcl_Free/etc become the recommended things for extensions and embedders to call, instead of ckalloc/ckfree/etc. Tcl_Alloc, etc. are macros that can be configured for memory debuggin, as ckalloc, etc. have been and continue to be. --- generic/tcl.decls | 10 +++++----- generic/tcl.h | 18 ++++++++++++------ generic/tclCkalloc.c | 30 ++++++++++++++---------------- generic/tclDecls.h | 40 ++++++++++++++++++++-------------------- generic/tclInt.h | 6 +++--- generic/tclInterp.c | 2 +- generic/tclStubInit.c | 16 ++++++++-------- win/tclAppInit.c | 2 +- 8 files changed, 64 insertions(+), 60 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index ad725f5..88567e3 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -40,13 +40,13 @@ declare 2 { void Tcl_Panic(const char *format, ...) } declare 3 { - char *Tcl_Alloc(unsigned int size) + char *Tcl_MemAlloc(unsigned int size) } declare 4 { - void Tcl_Free(char *ptr) + void Tcl_MemFree(char *ptr) } declare 5 { - char *Tcl_Realloc(char *ptr, unsigned int size) + char *Tcl_MemRealloc(char *ptr, unsigned int size) } declare 6 { char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) @@ -1527,13 +1527,13 @@ declare 427 { int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 { - char *Tcl_AttemptAlloc(unsigned int size) + char *Tcl_AttemptMemAlloc(unsigned int size) } declare 429 { char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) } declare 430 { - char *Tcl_AttemptRealloc(char *ptr, unsigned int size) + char *Tcl_AttemptMemRealloc(char *ptr, unsigned int size) } declare 431 { char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, diff --git a/generic/tcl.h b/generic/tcl.h index 162983b..121ab5c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2255,6 +2255,12 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * defined in tclCkalloc.c. */ +#define Tcl_Alloc(x) ckalloc(x) +#define Tcl_Free(x) ckfree(x) +#define Tcl_Realloc(x, y) ckrealloc(x, y) +#define Tcl_AttemptAlloc(x) attemptckalloc(x) +#define Tcl_AttemptRealloc(x, y) attemptckrealloc(x, y) + #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ @@ -2271,21 +2277,21 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #else /* !TCL_MEM_DEBUG */ /* - * If we are not using the debugging allocator, we should call the Tcl_Alloc, + * If we are not using the debugging allocator, we should call the Tcl_MemAlloc, * et al. routines in order to guarantee that every module is using the same * memory allocator both inside and outside of the Tcl library. */ # define ckalloc(x) \ - ((void *) Tcl_Alloc((unsigned)(x))) + ((void *) Tcl_MemAlloc((unsigned)(x))) # define ckfree(x) \ - Tcl_Free((char *)(x)) + Tcl_MemFree((char *)(x)) # define ckrealloc(x,y) \ - ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_MemRealloc((char *)(x), (unsigned)(y))) # define attemptckalloc(x) \ - ((void *) Tcl_AttemptAlloc((unsigned)(x))) + ((void *) Tcl_AttemptMemAlloc((unsigned)(x))) # define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_AttemptMemRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index ab977cb..71dc45d 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -20,11 +20,9 @@ #define FALSE 0 #define TRUE 1 -#undef Tcl_Alloc -#undef Tcl_Free -#undef Tcl_Realloc -#undef Tcl_AttemptAlloc -#undef Tcl_AttemptRealloc +#undef Tcl_MemFree +#undef Tcl_AttemptMemAlloc +#undef Tcl_AttemptMemRealloc #ifdef TCL_MEM_DEBUG @@ -747,35 +745,35 @@ Tcl_AttemptDbCkrealloc( */ char * -Tcl_Alloc( +Tcl_MemAlloc( unsigned int size) { return Tcl_DbCkalloc(size, "unknown", 0); } char * -Tcl_AttemptAlloc( +Tcl_AttemptMemAlloc( unsigned int size) { return Tcl_AttemptDbCkalloc(size, "unknown", 0); } void -Tcl_Free( +Tcl_MemFree( char *ptr) { Tcl_DbCkfree(ptr, "unknown", 0); } char * -Tcl_Realloc( +Tcl_MemRealloc( char *ptr, unsigned int size) { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } char * -Tcl_AttemptRealloc( +Tcl_AttemptMemRealloc( char *ptr, unsigned int size) { @@ -1038,7 +1036,7 @@ Tcl_InitMemory( /* *---------------------------------------------------------------------- * - * Tcl_Alloc -- + * Tcl_MemAlloc -- * * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check * that memory was actually allocated. @@ -1047,7 +1045,7 @@ Tcl_InitMemory( */ char * -Tcl_Alloc( +Tcl_MemAlloc( unsigned int size) { char *result; @@ -1099,7 +1097,7 @@ Tcl_DbCkalloc( */ char * -Tcl_AttemptAlloc( +Tcl_AttemptMemAlloc( unsigned int size) { char *result; @@ -1132,7 +1130,7 @@ Tcl_AttemptDbCkalloc( */ char * -Tcl_Realloc( +Tcl_MemRealloc( char *ptr, unsigned int size) { @@ -1176,7 +1174,7 @@ Tcl_DbCkrealloc( */ char * -Tcl_AttemptRealloc( +Tcl_AttemptMemRealloc( char *ptr, unsigned int size) { @@ -1212,7 +1210,7 @@ Tcl_AttemptDbCkrealloc( */ void -Tcl_Free( +Tcl_MemFree( char *ptr) { TclpFree(ptr); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d38296d..cf75bb6 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -35,11 +35,11 @@ TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp, /* 2 */ TCLAPI void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -TCLAPI char * Tcl_Alloc(unsigned int size); +TCLAPI char * Tcl_MemAlloc(unsigned int size); /* 4 */ -TCLAPI void Tcl_Free(char *ptr); +TCLAPI void Tcl_MemFree(char *ptr); /* 5 */ -TCLAPI char * Tcl_Realloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_MemRealloc(char *ptr, unsigned int size); /* 6 */ TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file, int line); @@ -1201,12 +1201,12 @@ TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ -TCLAPI char * Tcl_AttemptAlloc(unsigned int size); +TCLAPI char * Tcl_AttemptMemAlloc(unsigned int size); /* 429 */ TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line); /* 430 */ -TCLAPI char * Tcl_AttemptRealloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_AttemptMemRealloc(char *ptr, unsigned int size); /* 431 */ TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line); @@ -1782,9 +1782,9 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ - char * (*tcl_Alloc) (unsigned int size); /* 3 */ - void (*tcl_Free) (char *ptr); /* 4 */ - char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ + char * (*tcl_MemAlloc) (unsigned int size); /* 3 */ + void (*tcl_MemFree) (char *ptr); /* 4 */ + char * (*tcl_MemRealloc) (char *ptr, unsigned int size); /* 5 */ char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ 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 */ @@ -2231,9 +2231,9 @@ typedef struct TclStubs { ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ - char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */ + char * (*tcl_AttemptMemAlloc) (unsigned int size); /* 428 */ char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ - char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */ + char * (*tcl_AttemptMemRealloc) (char *ptr, unsigned int size); /* 430 */ char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ @@ -2456,12 +2456,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_PkgRequireEx) /* 1 */ #define Tcl_Panic \ (tclStubsPtr->tcl_Panic) /* 2 */ -#define Tcl_Alloc \ - (tclStubsPtr->tcl_Alloc) /* 3 */ -#define Tcl_Free \ - (tclStubsPtr->tcl_Free) /* 4 */ -#define Tcl_Realloc \ - (tclStubsPtr->tcl_Realloc) /* 5 */ +#define Tcl_MemAlloc \ + (tclStubsPtr->tcl_MemAlloc) /* 3 */ +#define Tcl_MemFree \ + (tclStubsPtr->tcl_MemFree) /* 4 */ +#define Tcl_MemRealloc \ + (tclStubsPtr->tcl_MemRealloc) /* 5 */ #define Tcl_DbCkalloc \ (tclStubsPtr->tcl_DbCkalloc) /* 6 */ #define Tcl_DbCkfree \ @@ -3311,12 +3311,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_TraceCommand) /* 426 */ #define Tcl_UntraceCommand \ (tclStubsPtr->tcl_UntraceCommand) /* 427 */ -#define Tcl_AttemptAlloc \ - (tclStubsPtr->tcl_AttemptAlloc) /* 428 */ +#define Tcl_AttemptMemAlloc \ + (tclStubsPtr->tcl_AttemptMemAlloc) /* 428 */ #define Tcl_AttemptDbCkalloc \ (tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */ -#define Tcl_AttemptRealloc \ - (tclStubsPtr->tcl_AttemptRealloc) /* 430 */ +#define Tcl_AttemptMemRealloc \ + (tclStubsPtr->tcl_AttemptMemRealloc) /* 430 */ #define Tcl_AttemptDbCkrealloc \ (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 0efb1b6..eeb685a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4776,9 +4776,9 @@ typedef struct NRE_callback { #include "tclTomMathDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc(size) TclpAlloc(size) -#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size)) -#define Tcl_Free(ptr) TclpFree(ptr) +#define Tcl_AttemptMemAlloc(size) TclpAlloc(size) +#define Tcl_AttemptMemRealloc(ptr, size) TclpRealloc((ptr), (size)) +#define Tcl_MemFree(ptr) TclpFree(ptr) #endif #endif /* _TCLINT */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0b0f652..f1faccd 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3466,7 +3466,7 @@ Tcl_LimitAddHandler( */ if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) { - deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free; + deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_MemFree; } if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) { deleteProc = NULL; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index c836f45..d78d7f1 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -22,9 +22,9 @@ * Remove macros that will interfere with the definitions below. */ -#undef Tcl_Alloc -#undef Tcl_Free -#undef Tcl_Realloc +#undef Tcl_MemAlloc +#undef Tcl_MemFree +#undef Tcl_MemRealloc #undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj @@ -625,9 +625,9 @@ const TclStubs tclStubs = { Tcl_PkgProvideEx, /* 0 */ Tcl_PkgRequireEx, /* 1 */ Tcl_Panic, /* 2 */ - Tcl_Alloc, /* 3 */ - Tcl_Free, /* 4 */ - Tcl_Realloc, /* 5 */ + Tcl_MemAlloc, /* 3 */ + Tcl_MemFree, /* 4 */ + Tcl_MemRealloc, /* 5 */ Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ @@ -1074,9 +1074,9 @@ const TclStubs tclStubs = { Tcl_CommandTraceInfo, /* 425 */ Tcl_TraceCommand, /* 426 */ Tcl_UntraceCommand, /* 427 */ - Tcl_AttemptAlloc, /* 428 */ + Tcl_AttemptMemAlloc, /* 428 */ Tcl_AttemptDbCkalloc, /* 429 */ - Tcl_AttemptRealloc, /* 430 */ + Tcl_AttemptMemRealloc, /* 430 */ Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 5ecebea..917cf00 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -255,7 +255,7 @@ setargv( } /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ - #undef Tcl_Alloc + #undef Tcl_MemAlloc #undef Tcl_DbCkalloc argSpace = ckalloc(size * sizeof(char *) -- cgit v0.12 From 26f4ba76ca7de932401313aa8bb90cc386861083 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Dec 2012 10:21:55 +0000 Subject: allow novem to use installed Tcl8 .tm packages, such as tcltest and msgcat remove some dead code (already planned to be removed in Tcl9) --- generic/tcl.decls | 3 --- generic/tclIOCmd.c | 14 -------------- generic/tclMain.c | 18 +----------------- library/tm.tcl | 23 +++++++++++++++++++++++ 4 files changed, 24 insertions(+), 34 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index ad725f5..198228b 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2374,9 +2374,6 @@ declare 1 macosx { # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 2b3e805..f738b1a 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -416,25 +416,11 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if TCL_MAJOR_VERSION < 9 - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { -#endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if TCL_MAJOR_VERSION < 9 - } - newline = 1; -#endif } } diff --git a/generic/tclMain.c b/generic/tclMain.c index 73989ef..6c71fbb 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -284,7 +284,7 @@ Tcl_SourceRCFile( /*---------------------------------------------------------------------- * - * Tcl_Main, Tcl_MainEx -- + * Tcl_MainEx -- * * Main program for tclsh and most other Tcl-based applications. * @@ -632,22 +632,6 @@ Tcl_MainEx( Tcl_Exit(exitCode); } - -#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE) -#undef Tcl_Main -extern DLLEXPORT void -Tcl_Main( - int argc, /* Number of arguments. */ - char **argv, /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc) - /* Application-specific initialization - * function to call after most initialization - * but before starting to execute commands. */ -{ - Tcl_FindExecutable(argv[0]); - Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); -} -#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */ #ifndef TCL_ASCII_MAIN diff --git a/library/tm.tcl b/library/tm.tcl index ce8a013..4288658 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -330,6 +330,19 @@ proc ::tcl::tm::Defaults {} { } } } + if {$major == 8} return + for {set n 7} {$n >= 0} {incr n -1} { + foreach ev [::list \ + TCL8.${n}_TM_PATH \ + TCL8_${n}_TM_PATH \ + ] { + if {![info exists env($ev)]} continue + foreach p [split $env($ev) $sep] { + path add $p + } + } + } + } return } @@ -358,6 +371,16 @@ proc ::tcl::tm::roots {paths} { set px [file join $p site-tcl] if {![interp issafe]} {set px [file normalize $px]} path add $px + if {$major == 8} continue + set p [file join $pa tcl8] + for {set n 7} {$n >= 0} {incr n -1} { + set px [file join $p 8.${n}] + if {![interp issafe]} {set px [file normalize $px]} + path add $px + } + set px [file join $p site-tcl] + if {![interp issafe]} {set px [file normalize $px]} + path add $px } return } -- cgit v0.12 From 88eafacc822a9e546b2d075195d179e223a32296 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Dec 2012 21:21:10 +0000 Subject: More memory API changes, mainly char* -> void* and unsigned -> size_t --- generic/tcl.decls | 20 +++++++-------- generic/tcl.h | 52 +++++++++++++++++++------------------- generic/tclBinary.c | 2 +- generic/tclCkalloc.c | 66 ++++++++++++++++++++++++------------------------ generic/tclDecls.h | 42 +++++++++++++++--------------- generic/tclIO.c | 2 +- generic/tclIO.h | 2 +- generic/tclIORChan.c | 2 +- generic/tclInt.decls | 6 ++--- generic/tclInt.h | 10 ++++---- generic/tclIntDecls.h | 12 ++++----- generic/tclObj.c | 4 +-- generic/tclTest.c | 15 ++++++----- generic/tclThreadAlloc.c | 16 ++++++------ generic/tclThreadTest.c | 8 +++--- win/tclWin32Dll.c | 2 +- 16 files changed, 131 insertions(+), 130 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 88567e3..87106ef 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -40,22 +40,22 @@ declare 2 { void Tcl_Panic(const char *format, ...) } declare 3 { - char *Tcl_MemAlloc(unsigned int size) + void *Tcl_MemAlloc(size_t size) } declare 4 { - void Tcl_MemFree(char *ptr) + void Tcl_MemFree(void *ptr) } declare 5 { - char *Tcl_MemRealloc(char *ptr, unsigned int size) + void *Tcl_MemRealloc(void *ptr, size_t size) } declare 6 { - char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) + void *Tcl_DbCkalloc(size_t size, const char *file, int line) } declare 7 { - void Tcl_DbCkfree(char *ptr, const char *file, int line) + void Tcl_DbCkfree(void *ptr, const char *file, int line) } declare 8 { - char *Tcl_DbCkrealloc(char *ptr, unsigned int size, + void *Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line) } @@ -1527,16 +1527,16 @@ declare 427 { int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 { - char *Tcl_AttemptMemAlloc(unsigned int size) + void *Tcl_AttemptMemAlloc(size_t size) } declare 429 { - char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) + void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line) } declare 430 { - char *Tcl_AttemptMemRealloc(char *ptr, unsigned int size) + void *Tcl_AttemptMemRealloc(void *ptr, size_t size) } declare 431 { - char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, + void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line) } declare 432 { diff --git a/generic/tcl.h b/generic/tcl.h index 121ab5c..e46fccf 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -568,16 +568,16 @@ typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); -typedef void (Tcl_EncodingFreeProc) (ClientData clientData); typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); -typedef void (Tcl_ExitProc) (ClientData clientData); typedef void (Tcl_FileProc) (ClientData clientData, int mask); -typedef void (Tcl_FileFreeProc) (ClientData clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (char *blockPtr); +typedef void (Tcl_FreeProc) (void *blockPtr); +#define Tcl_EncodingFreeProc Tcl_FreeProc +#define Tcl_ExitProc Tcl_FreeProc +#define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); @@ -1511,7 +1511,7 @@ typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, ClientData *clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); -typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData); +#define Tcl_FSFreeInternalRepProc Tcl_FreeProc typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); @@ -1917,7 +1917,7 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ - Tcl_EncodingFreeProc *freeProc; + Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ ClientData clientData; /* Arbitrary value associated with encoding @@ -2255,24 +2255,24 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * defined in tclCkalloc.c. */ -#define Tcl_Alloc(x) ckalloc(x) -#define Tcl_Free(x) ckfree(x) -#define Tcl_Realloc(x, y) ckrealloc(x, y) -#define Tcl_AttemptAlloc(x) attemptckalloc(x) -#define Tcl_AttemptRealloc(x, y) attemptckrealloc(x, y) +#define Tcl_Alloc ckalloc +#define Tcl_Free ckfree +#define Tcl_Realloc ckrealloc +#define Tcl_AttemptAlloc attemptckalloc +#define Tcl_AttemptRealloc attemptckrealloc #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ - ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) + (Tcl_DbCkalloc((x), __FILE__, __LINE__)) # define ckfree(x) \ - Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) + Tcl_DbCkfree((x), __FILE__, __LINE__) # define ckrealloc(x,y) \ - ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__)) # define attemptckalloc(x) \ - ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) + (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__)) # define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)) #else /* !TCL_MEM_DEBUG */ @@ -2282,16 +2282,16 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * memory allocator both inside and outside of the Tcl library. */ -# define ckalloc(x) \ - ((void *) Tcl_MemAlloc((unsigned)(x))) -# define ckfree(x) \ - Tcl_MemFree((char *)(x)) -# define ckrealloc(x,y) \ - ((void *) Tcl_MemRealloc((char *)(x), (unsigned)(y))) -# define attemptckalloc(x) \ - ((void *) Tcl_AttemptMemAlloc((unsigned)(x))) -# define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptMemRealloc((char *)(x), (unsigned)(y))) +# define ckalloc \ + Tcl_MemAlloc +# define ckfree \ + Tcl_MemFree +# define ckrealloc \ + Tcl_MemRealloc +# define attemptckalloc \ + Tcl_AttemptMemAlloc +# define attemptckrealloc \ + Tcl_AttemptMemRealloc # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 5c33308..caa5db7 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -178,7 +178,7 @@ typedef struct ByteArray { } ByteArray; #define BYTEARRAY_SIZE(len) \ - ((unsigned) (TclOffset(ByteArray, bytes) + (len))) + ((TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.otherValuePtr) #define SET_BYTEARRAY(objPtr, baPtr) \ diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 71dc45d..ca26b7f 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1044,11 +1044,11 @@ Tcl_InitMemory( *---------------------------------------------------------------------- */ -char * +void * Tcl_MemAlloc( - unsigned int size) + size_t size) { - char *result; + void *result; result = TclpAlloc(size); @@ -1068,15 +1068,15 @@ Tcl_MemAlloc( return result; } -char * +void * Tcl_DbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpAlloc(size); + result = TclpAlloc(size); if ((result == NULL) && size) { fflush(stdout); @@ -1096,25 +1096,25 @@ Tcl_DbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptMemAlloc( - unsigned int size) + size_t size) { - char *result; + void *result; result = TclpAlloc(size); return result; } -char * +void * Tcl_AttemptDbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpAlloc(size); + result = TclpAlloc(size); return result; } @@ -1129,10 +1129,10 @@ Tcl_AttemptDbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_MemRealloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { char *result; @@ -1144,16 +1144,16 @@ Tcl_MemRealloc( return result; } -char * +void * Tcl_DbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpRealloc(ptr, size); + result = TclpRealloc(ptr, size); if ((result == NULL) && size) { fflush(stdout); @@ -1173,27 +1173,27 @@ Tcl_DbCkrealloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptMemRealloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { - char *result; + void *result; result = TclpRealloc(ptr, size); return result; } -char * +void * Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpRealloc(ptr, size); + result = TclpRealloc(ptr, size); return result; } @@ -1211,14 +1211,14 @@ Tcl_AttemptDbCkrealloc( void Tcl_MemFree( - char *ptr) + void *ptr) { TclpFree(ptr); } void Tcl_DbCkfree( - char *ptr, + void *ptr, const char *file, int line) { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index cf75bb6..fc3cf96 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -35,18 +35,18 @@ TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp, /* 2 */ TCLAPI void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -TCLAPI char * Tcl_MemAlloc(unsigned int size); +TCLAPI void * Tcl_MemAlloc(size_t size); /* 4 */ -TCLAPI void Tcl_MemFree(char *ptr); +TCLAPI void Tcl_MemFree(void *ptr); /* 5 */ -TCLAPI char * Tcl_MemRealloc(char *ptr, unsigned int size); +TCLAPI void * Tcl_MemRealloc(void *ptr, size_t size); /* 6 */ -TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file, +TCLAPI void * Tcl_DbCkalloc(size_t size, const char *file, int line); /* 7 */ -TCLAPI void Tcl_DbCkfree(char *ptr, const char *file, int line); +TCLAPI void Tcl_DbCkfree(void *ptr, const char *file, int line); /* 8 */ -TCLAPI char * Tcl_DbCkrealloc(char *ptr, unsigned int size, +TCLAPI void * Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line); #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ @@ -1201,14 +1201,14 @@ TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ -TCLAPI char * Tcl_AttemptMemAlloc(unsigned int size); +TCLAPI void * Tcl_AttemptMemAlloc(size_t size); /* 429 */ -TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size, - const char *file, int line); +TCLAPI void * Tcl_AttemptDbCkalloc(size_t size, const char *file, + int line); /* 430 */ -TCLAPI char * Tcl_AttemptMemRealloc(char *ptr, unsigned int size); +TCLAPI void * Tcl_AttemptMemRealloc(void *ptr, size_t size); /* 431 */ -TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, +TCLAPI void * Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line); /* 432 */ TCLAPI int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); @@ -1782,12 +1782,12 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ - char * (*tcl_MemAlloc) (unsigned int size); /* 3 */ - void (*tcl_MemFree) (char *ptr); /* 4 */ - char * (*tcl_MemRealloc) (char *ptr, unsigned int size); /* 5 */ - char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ - 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 */ + void * (*tcl_MemAlloc) (size_t size); /* 3 */ + void (*tcl_MemFree) (void *ptr); /* 4 */ + void * (*tcl_MemRealloc) (void *ptr, size_t size); /* 5 */ + void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */ + void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ + void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ @@ -2231,10 +2231,10 @@ typedef struct TclStubs { ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ - char * (*tcl_AttemptMemAlloc) (unsigned int size); /* 428 */ - char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ - char * (*tcl_AttemptMemRealloc) (char *ptr, unsigned int size); /* 430 */ - char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ + void * (*tcl_AttemptMemAlloc) (size_t size); /* 428 */ + void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ + void * (*tcl_AttemptMemRealloc) (void *ptr, size_t size); /* 430 */ + void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 0568d77..24e7823 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2717,7 +2717,7 @@ CloseChannel( if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { - ckfree(statePtr->channelName); + ckfree((char *)statePtr->channelName); statePtr->channelName = NULL; } diff --git a/generic/tclIO.h b/generic/tclIO.h index 1e89878..956ed15 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -156,7 +156,7 @@ typedef struct Channel { */ typedef struct ChannelState { - const char *channelName; /* The name of the channel instance in Tcl + char *channelName; /* The name of the channel instance in Tcl * commands. Storage is owned by the generic * IO code, is dynamically allocated. */ int flags; /* ORed combination of the flags defined diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index cb0282a..85d9a46 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2303,7 +2303,7 @@ FreeReflectedChannel( * Delete a cloned ChannelType structure. */ - ckfree(chanPtr->typePtr); + ckfree((void *) chanPtr->typePtr); chanPtr->typePtr = NULL; } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8c46e55..57040a9 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -291,7 +291,7 @@ declare 64 { # int TclpAccess(const char *path, int mode) #} declare 69 { - char *TclpAlloc(unsigned int size) + void *TclpAlloc(size_t size) } #declare 70 { # int TclpCopyFile(const char *source, const char *dest) @@ -307,7 +307,7 @@ declare 69 { # int TclpDeleteFile(const char *path) #} declare 74 { - void TclpFree(char *ptr) + void TclpFree(void *ptr) } declare 75 { unsigned long TclpGetClicks(void) @@ -334,7 +334,7 @@ declare 76 { # char *modeString, int permissions) #} declare 81 { - char *TclpRealloc(char *ptr, unsigned int size) + void *TclpRealloc(void *ptr, size_t size) } #declare 82 { # int TclpRemoveDirectory(const char *path, int recursive, diff --git a/generic/tclInt.h b/generic/tclInt.h index eeb685a..d6b1320 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4103,7 +4103,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ + (objPtr)->bytes = ckalloc((unsigned) ((len) + 1)); \ memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ @@ -4553,9 +4553,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #ifdef offsetof -#define TclOffset(type, field) ((int) offsetof(type, field)) +#define TclOffset(type, field) (offsetof(type, field)) #else -#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) +#define TclOffset(type, field) (((char *) &((type *) 0)->field)) #endif /* @@ -4761,8 +4761,8 @@ typedef struct NRE_callback { #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ - (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) -#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr)) + (ptr = (ckalloc(sizeof(NRE_callback)))) +#define TCLNR_FREE(interp, ptr) ckfree(ptr) #endif #if NRE_ENABLE_ASSERTS diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 65b1888..8db3831 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -187,13 +187,13 @@ TCLAPI int TclObjInvoke(Tcl_Interp *interp, int objc, /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -TCLAPI char * TclpAlloc(unsigned int size); +TCLAPI void * TclpAlloc(size_t size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ -TCLAPI void TclpFree(char *ptr); +TCLAPI void TclpFree(void *ptr); /* 75 */ TCLAPI unsigned long TclpGetClicks(void); /* 76 */ @@ -203,7 +203,7 @@ TCLAPI unsigned long TclpGetSeconds(void); /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -TCLAPI char * TclpRealloc(char *ptr, unsigned int size); +TCLAPI void * TclpRealloc(void *ptr, size_t size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -654,19 +654,19 @@ typedef struct TclIntStubs { void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); - char * (*tclpAlloc) (unsigned int size); /* 69 */ + void * (*tclpAlloc) (size_t size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); - void (*tclpFree) (char *ptr); /* 74 */ + void (*tclpFree) (void *ptr); /* 74 */ unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*tclpGetSeconds) (void); /* 76 */ void (*reserved77)(void); void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); - char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */ + void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); diff --git a/generic/tclObj.c b/generic/tclObj.c index 74cb29e..0bbb08d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -97,7 +97,7 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; -static void ContLineLocFree(char *clientData); +static void ContLineLocFree(void *clientData); static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); @@ -840,7 +840,7 @@ TclThreadFinalizeContLines( static void ContLineLocFree( - char *clientData) + void *clientData) { ckfree(clientData); } diff --git a/generic/tclTest.c b/generic/tclTest.c index 9b958dd..d69e04c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -200,7 +200,7 @@ static int ObjTraceProc(ClientData clientData, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(ClientData clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); -static void SpecialFree(char *blockPtr); +static void SpecialFree(void *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); @@ -309,7 +309,7 @@ static void TestregexpXflags(const char *string, static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static void TestsaveresultFree(char *blockPtr); +static void TestsaveresultFree(void *blockPtr); static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, @@ -893,7 +893,8 @@ AsyncHandlerProc( { TestAsyncHandler *asyncPtr; int id = PTR2INT(clientData); - const char *listArgv[4], *cmd; + const char *listArgv[4]; + char *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); @@ -1839,9 +1840,9 @@ TestdstringCmd( */ static void SpecialFree(blockPtr) - char *blockPtr; /* Block to free. */ + void *blockPtr; /* Block to free. */ { - ckfree(blockPtr - 16); + ckfree(((char *)blockPtr) - 16); } /* @@ -4364,7 +4365,7 @@ TestpanicCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - const char *argString; + char *argString; /* * Put the arguments into a var args structure @@ -4960,7 +4961,7 @@ TestsaveresultCmd( static void TestsaveresultFree( - char *blockPtr) + void *blockPtr) { /* empty... */ } diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index e4261d6..09826cb 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -306,9 +306,9 @@ TclFreeAllocCache( *---------------------------------------------------------------------- */ -char * +void * TclpAlloc( - unsigned int reqSize) + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -321,7 +321,7 @@ TclpAlloc( const size_t zero = 0; const size_t max = ~zero; - if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { + if (reqSize > max - sizeof(Block) - RCHECK) { /* Requested allocation exceeds memory */ return NULL; } @@ -385,7 +385,7 @@ TclpAlloc( void TclpFree( - char *ptr) + void *ptr) { Cache *cachePtr; Block *blockPtr; @@ -439,10 +439,10 @@ TclpFree( *---------------------------------------------------------------------- */ -char * +void * TclpRealloc( - char *ptr, - unsigned int reqSize) + void *ptr, + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -460,7 +460,7 @@ TclpRealloc( const size_t zero = 0; const size_t max = ~zero; - if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { + if ((reqSize) > max - sizeof(Block) - RCHECK) { /* Requested allocation exceeds memory */ return NULL; } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index c1828bb..3a006db 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -62,7 +62,7 @@ static ThreadSpecificData *threadList = NULL; */ typedef struct ThreadCtrl { - const char *script; /* The Tcl command this thread should + char *script; /* The Tcl command this thread should * execute */ int flags; /* Initial value of the "flags" field in the * ThreadSpecificData structure for the new @@ -122,7 +122,7 @@ TCL_DECLARE_MUTEX(threadMutex) static int ThreadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ThreadCreate(Tcl_Interp *interp, const char *script, +static int ThreadCreate(Tcl_Interp *interp, char *script, int joinable); static int ThreadList(Tcl_Interp *interp); static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, @@ -276,7 +276,7 @@ ThreadObjCmd( return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags); } case THREAD_CREATE: { - const char *script; + char *script; int joinable, len; if (objc == 2) { @@ -496,7 +496,7 @@ ThreadObjCmd( static int ThreadCreate( Tcl_Interp *interp, /* Current interpreter. */ - const char *script, /* Script to execute */ + char *script, /* Script to execute */ int joinable) /* Flag, joinable thread or not */ { ThreadCtrl ctrl; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 019d76f..ae025e8 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -66,7 +66,7 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - const TCHAR *volumeName; /* Native wide string volume name. */ + TCHAR *volumeName; /* Native wide string volume name. */ TCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; -- cgit v0.12 From e00ad288cc9b6a7e9f95f74fd040d9ea8d21fe55 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 17 Dec 2012 12:45:19 +0000 Subject: remove deprecated functions Tcl_VarEval and Tcl_VarEvalVA --- doc/AllowExc.3 | 3 +- doc/CrtInterp.3 | 4 +-- doc/Eval.3 | 20 +------------ generic/tcl.decls | 16 ++++++----- generic/tclBasic.c | 80 --------------------------------------------------- generic/tclDecls.h | 16 ++++------- generic/tclIOCmd.c | 14 +++++---- generic/tclStubInit.c | 4 +-- 8 files changed, 30 insertions(+), 127 deletions(-) diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index 0477c88..5a757ae 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -29,8 +29,7 @@ terminates with a completion code other than \fBTCL_OK\fR, \fBTCL_ERROR\fR or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR return with an appropriate message. The particular script evaluation procedures of Tcl that act in the manner are -\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR, -\fBTcl_VarEval\fR and \fBTcl_VarEvalVA\fR. +\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR. .PP However, if \fBTcl_AllowExceptions\fR is invoked immediately before calling one of those a procedures, then arbitrary completion diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index d8ee2cc..aac3a1d 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -107,7 +107,7 @@ uses. \fBInterpreter Creation And Deletion\fR . When a new interpreter is created and used in a call to \fBTcl_Eval\fR, -\fBTcl_VarEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of calls +\fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all uses of the interpreter. Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR has been called. To ensure that the interpreter is @@ -120,7 +120,7 @@ code. . When an interpreter is retrieved from a data structure (e.g. the client data of a callback) for use in one of the evaluation functions -(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_EvalObjv\fR etc.) or variable +(\fBTcl_Eval\fR, \fBTcl_EvalObjv\fR etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, \fBTcl_SetVar2Ex\fR, etc.), a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all uses of the interpreter; it is unsafe to reuse the diff --git a/doc/Eval.3 b/doc/Eval.3 index f1c7c46..d060338 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -10,7 +10,7 @@ .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include \fR @@ -26,12 +26,6 @@ int .sp int \fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR) -.sp -int -\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR) -.sp -int -\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in @@ -108,18 +102,6 @@ executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR. \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes additional arguments \fInumBytes\fR and \fIflags\fR. \fBTcl_EvalEx\fR is generally preferred over \fBTcl_Eval\fR. -.PP -\fBTcl_VarEval\fR takes any number of string arguments -of any length, concatenates them into a single string, -then calls \fBTcl_Eval\fR to execute that string as a Tcl command. -It returns the result of the command and also modifies -\fIinterp->result\fR in the same way as \fBTcl_Eval\fR. -The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end -of arguments. \fBTcl_VarEval\fR is now deprecated. -.PP -\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that -instead of taking a variable number of arguments it takes an argument -list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated. .SH "FLAG BITS" .PP diff --git a/generic/tcl.decls b/generic/tcl.decls index 76d5298..fe1d763 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -635,7 +635,7 @@ declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -# Removed in Tcl 9.0 +# Removed in 9.0 #declare 177 { # int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) #} @@ -923,9 +923,10 @@ declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) } -declare 260 { - int Tcl_VarEval(Tcl_Interp *interp, ...) -} +# Removed in 9.0 +#declare 260 { +# int Tcl_VarEval(Tcl_Interp *interp, ...) +#} declare 261 { ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) @@ -983,9 +984,10 @@ declare 274 { declare 275 { void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) } -declare 276 { - int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) -} +# Removed in 9.0 +#declare 276 { +# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) +#} declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7202184..4f70cee 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6357,86 +6357,6 @@ Tcl_AddObjErrorInfo( } /* - *--------------------------------------------------------------------------- - * - * Tcl_VarEvalVA -- - * - * Given a variable number of string arguments, concatenate them all - * together and execute the result as a Tcl command. - * - * Results: - * A standard Tcl return result. An error message or other result may be - * left in the interp's result. - * - * Side effects: - * Depends on what was done by the command. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_VarEvalVA( - Tcl_Interp *interp, /* Interpreter in which to evaluate command */ - va_list argList) /* Variable argument list. */ -{ - Tcl_DString buf; - char *string; - int result; - - /* - * Copy the strings one after the other into a single larger string. Use - * stack-allocated space for small commands, but if the command gets too - * large than call ckalloc to create the space. - */ - - Tcl_DStringInit(&buf); - while (1) { - string = va_arg(argList, char *); - if (string == NULL) { - break; - } - Tcl_DStringAppend(&buf, string, -1); - } - - result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); - Tcl_DStringFree(&buf); - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_VarEval -- - * - * Given a variable number of string arguments, concatenate them all - * together and execute the result as a Tcl command. - * - * Results: - * A standard Tcl return result. An error message or other result may be - * left in the interp. - * - * Side effects: - * Depends on what was done by the command. - * - *---------------------------------------------------------------------- - */ - /* ARGSUSED */ -int -Tcl_VarEval( - Tcl_Interp *interp, - ...) -{ - va_list argList; - int result; - - va_start(argList, interp); - result = Tcl_VarEvalVA(interp, argList); - va_end(argList); - - return result; -} - -/* *---------------------------------------------------------------------- * * Tcl_SetRecursionLimit -- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 5c206aa..0770e98 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -747,8 +747,7 @@ TCLAPI int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, TCLAPI int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); -/* 260 */ -TCLAPI int Tcl_VarEval(Tcl_Interp *interp, ...); +/* Slot 260 is reserved */ /* 261 */ TCLAPI ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, @@ -795,8 +794,7 @@ TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, /* 275 */ TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList); -/* 276 */ -TCLAPI int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); +/* Slot 276 is reserved */ /* 277 */ TCLAPI Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); /* 278 */ @@ -2063,7 +2061,7 @@ typedef struct TclStubs { void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ - int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ + void (*reserved260)(void); ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ @@ -2079,7 +2077,7 @@ typedef struct TclStubs { int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ - int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ + void (*reserved276)(void); Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ @@ -2979,8 +2977,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UpVar) /* 258 */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ -#define Tcl_VarEval \ - (tclStubsPtr->tcl_VarEval) /* 260 */ +/* Slot 260 is reserved */ #define Tcl_VarTraceInfo \ (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ #define Tcl_VarTraceInfo2 \ @@ -3011,8 +3008,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_PkgRequire) /* 274 */ #define Tcl_SetErrorCodeVA \ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ -#define Tcl_VarEvalVA \ - (tclStubsPtr->tcl_VarEvalVA) /* 276 */ +/* Slot 276 is reserved */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ #define Tcl_PanicVA \ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index f738b1a..27f156f 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -1324,11 +1324,11 @@ AcceptCallbackProc( if (acceptCallbackPtr->interp != NULL) { char portBuf[TCL_INTEGER_SPACE]; - char *script = acceptCallbackPtr->script; + Tcl_Obj *script = Tcl_NewStringObj(acceptCallbackPtr->script, -1); Tcl_Interp *interp = acceptCallbackPtr->interp; int result; - Tcl_Preserve(script); + Tcl_IncrRefCount(script); Tcl_Preserve(interp); TclFormatInt(portBuf, port); @@ -1341,8 +1341,12 @@ AcceptCallbackProc( Tcl_RegisterChannel(NULL, chan); - result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan), - " ", address, " ", portBuf, NULL); + result = Tcl_ListObjAppendElement(interp, script, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + if (result == TCL_OK) { + Tcl_ListObjAppendElement(NULL, script, Tcl_NewStringObj(address, -1)); + Tcl_ListObjAppendElement(NULL, script, Tcl_NewStringObj(portBuf, -1)); + result = Tcl_EvalObjEx(interp, script, 0); + } if (result != TCL_OK) { Tcl_BackgroundException(interp, result); Tcl_UnregisterChannel(interp, chan); @@ -1356,7 +1360,7 @@ AcceptCallbackProc( Tcl_UnregisterChannel(NULL, chan); Tcl_Release(interp); - Tcl_Release(script); + Tcl_DecrRefCount(script); } else { /* * The interpreter has been deleted, so there is no useful way to use diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 30c2b76..50fc6de 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -930,7 +930,7 @@ const TclStubs tclStubs = { Tcl_UpdateLinkedVar, /* 257 */ Tcl_UpVar, /* 258 */ Tcl_UpVar2, /* 259 */ - Tcl_VarEval, /* 260 */ + 0, /* 260 */ Tcl_VarTraceInfo, /* 261 */ Tcl_VarTraceInfo2, /* 262 */ Tcl_Write, /* 263 */ @@ -946,7 +946,7 @@ const TclStubs tclStubs = { TclPkgProvide, /* 273 */ Tcl_PkgRequire, /* 274 */ Tcl_SetErrorCodeVA, /* 275 */ - Tcl_VarEvalVA, /* 276 */ + 0, /* 276 */ Tcl_WaitPid, /* 277 */ Tcl_PanicVA, /* 278 */ Tcl_GetVersion, /* 279 */ -- cgit v0.12 From 2acbdb04938db272c3e0bfcedbd3d78d788a9833 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 18 Dec 2012 13:47:08 +0000 Subject: Remove all VA functions Tcl_AppendResultVA, Tcl_AppendStringsToObjVA, Tcl_SetErrorCodeVA, Tcl_PanicVA, and dependancy of tcl.h on . TIP required. --- doc/AddErrInfo.3 | 7 +--- doc/Panic.3 | 8 +--- doc/SetResult.3 | 7 +--- doc/StringObj.3 | 9 +---- generic/tcl.decls | 28 ++++++++------ generic/tcl.h | 12 ------ generic/tclDecls.h | 35 ++++++----------- generic/tclInt.h | 1 + generic/tclPanic.c | 43 +++++---------------- generic/tclResult.c | 103 ++++++++++++++----------------------------------- generic/tclStringObj.c | 40 ++++--------------- generic/tclStubInit.c | 8 ++-- 12 files changed, 81 insertions(+), 220 deletions(-) diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index b9c6a63..169cc48 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -9,7 +9,7 @@ .TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options +Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options .SH SYNOPSIS .nf \fB#include \fR @@ -30,8 +30,6 @@ int .sp \fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR) .sp -\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR) -.sp \fBTcl_GetErrorLine\fR(\fIinterp\fR) .sp \fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR) @@ -245,9 +243,6 @@ The procedure \fBTcl_SetErrorCode\fR is also used to set the record instead of a value. Otherwise, it is similar to \fBTcl_SetObjErrorCode\fR in behavior. .PP -\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that -instead of taking a variable number of arguments it takes an argument list. -.PP The procedure \fBTcl_GetErrorLine\fR is used to read the integer value of the \fB\-errorline\fR return option without the overhead of a full call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR diff --git a/doc/Panic.3 b/doc/Panic.3 index 48aed2b..38a85b1 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -7,7 +7,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort +Tcl_Panic, Tcl_SetPanicProc \- report fatal error and abort .SH SYNOPSIS .nf \fB#include \fR @@ -16,9 +16,6 @@ void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp void -\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) -.sp -void \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp .SH ARGUMENTS @@ -80,9 +77,6 @@ the Tcl library, \fBTcl_Panic\fR is a public function and may be called by any extension or application that wishes to abort the process and have a panic message displayed the same way that panic messages from Tcl will be displayed. -.PP -\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of -taking a variable number of arguments it takes an argument list. .SH "SEE ALSO" abort(3), printf(3), exec(n), format(n) .SH KEYWORDS diff --git a/doc/SetResult.3 b/doc/SetResult.3 index c863c5a..2cdd21d 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -9,7 +9,7 @@ .TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result +Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result .SH SYNOPSIS .nf \fB#include \fR @@ -26,8 +26,6 @@ const char * .sp \fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR) .sp -\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR) -.sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp .VS 8.6 @@ -152,9 +150,6 @@ extensions. Any number of \fIresult\fR arguments may be passed in a single call; the last argument in the list must be a NULL pointer. .PP -\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that -instead of taking a variable number of arguments it takes an argument list. -.PP .VS 8.6 \fBTcl_TransferResult\fR moves a result from one interpreter to another, optionally (dependent on the \fIresult\fR parameter) including the error diff --git a/doc/StringObj.3 b/doc/StringObj.3 index e6f9d32..cdc48da 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -8,7 +8,7 @@ .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings +Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings .SH SYNOPSIS .nf \fB#include \fR @@ -59,9 +59,6 @@ void \fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR) .sp void -\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR) -.sp -void \fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR) .sp Tcl_Obj * @@ -246,10 +243,6 @@ values may contain internal null characters). Any number of \fIstring\fR arguments may be provided, but the last argument must be a NULL pointer to indicate the end of the list. .PP -\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR -except that instead of taking a variable number of arguments it takes an -argument list. -.PP \fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR except that it imposes a limit on how many bytes are appended. This can be handy when the string to be appended might be diff --git a/generic/tcl.decls b/generic/tcl.decls index fe1d763..e9ab7c0 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -949,12 +949,14 @@ declare 265 { declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } -declare 267 { - void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) -} -declare 268 { - void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) -} +# Removed in 9.0 +#declare 267 { +# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) +#} +# Removed in 9.0 +#declare 268 { +# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) +#} declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } @@ -981,9 +983,10 @@ declare 274 { const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact) } -declare 275 { - void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) -} +# Removed in 9.0 +#declare 275 { +# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) +#} # Removed in 9.0 #declare 276 { # int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) @@ -991,9 +994,10 @@ declare 275 { declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } -declare 278 { - void Tcl_PanicVA(const char *format, va_list argList) -} +# Removed in 9.0 +#declare 278 { +# void Tcl_PanicVA(const char *format, va_list argList) +#} declare 279 { void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type) } diff --git a/generic/tcl.h b/generic/tcl.h index 09191df..98736ea 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -123,18 +123,6 @@ extern "C" { #include -/* - *---------------------------------------------------------------------------- - * Support for functions with a variable number of arguments. - * - * The following TCL_VARARGS* macros are to support old extensions - * written for older versions of Tcl where the macros permitted - * support for the varargs.h system as well as stdarg.h . - * - * New code should just directly be written to use stdarg.h conventions. - */ - -#include #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) #else diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0770e98..6d6a03c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -767,12 +767,8 @@ TCLAPI void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, TCLAPI int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ TCLAPI void Tcl_ValidateAllMemory(const char *file, int line); -/* 267 */ -TCLAPI void Tcl_AppendResultVA(Tcl_Interp *interp, - va_list argList); -/* 268 */ -TCLAPI void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, - va_list argList); +/* Slot 267 is reserved */ +/* Slot 268 is reserved */ /* 269 */ TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ @@ -791,14 +787,11 @@ TCLAPI int TclPkgProvide(Tcl_Interp *interp, const char *name, /* 274 */ TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact); -/* 275 */ -TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp, - va_list argList); +/* Slot 275 is reserved */ /* Slot 276 is reserved */ /* 277 */ TCLAPI Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); -/* 278 */ -TCLAPI void Tcl_PanicVA(const char *format, va_list argList); +/* Slot 278 is reserved */ /* 279 */ TCLAPI void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); @@ -2068,18 +2061,18 @@ typedef struct TclStubs { void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */ - void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ - void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ + void (*reserved267)(void); + void (*reserved268)(void); char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ - void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ + void (*reserved275)(void); void (*reserved276)(void); Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ - void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ + void (*reserved278)(void); void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */ @@ -2990,10 +2983,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ -#define Tcl_AppendResultVA \ - (tclStubsPtr->tcl_AppendResultVA) /* 267 */ -#define Tcl_AppendStringsToObjVA \ - (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ +/* Slot 267 is reserved */ +/* Slot 268 is reserved */ #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ @@ -3006,13 +2997,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclPkgProvide) /* 273 */ #define Tcl_PkgRequire \ (tclStubsPtr->tcl_PkgRequire) /* 274 */ -#define Tcl_SetErrorCodeVA \ - (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ +/* Slot 275 is reserved */ /* Slot 276 is reserved */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ -#define Tcl_PanicVA \ - (tclStubsPtr->tcl_PanicVA) /* 278 */ +/* Slot 278 is reserved */ #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #define Tcl_InitMemory \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 742d957..8a78b94 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -40,6 +40,7 @@ #include #include +#include #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else diff --git a/generic/tclPanic.c b/generic/tclPanic.c index b87a8df..3dd7649 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -59,7 +59,7 @@ Tcl_SetPanicProc( /* *---------------------------------------------------------------------- * - * Tcl_PanicVA -- + * Tcl_Panic -- * * Print an error message and kill the process. * @@ -72,16 +72,19 @@ Tcl_SetPanicProc( *---------------------------------------------------------------------- */ + /* ARGSUSED */ void -Tcl_PanicVA( - const char *format, /* Format string, suitable for passing to - * fprintf. */ - va_list argList) /* Variable argument list. */ +Tcl_Panic( + const char *format, + ...) { + va_list argList; char *arg1, *arg2, *arg3; /* Additional arguments (variable in number) * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; + + va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); arg3 = va_arg(argList, char *); @@ -90,6 +93,7 @@ Tcl_PanicVA( arg6 = va_arg(argList, char *); arg7 = va_arg(argList, char *); arg8 = va_arg(argList, char *); + va_end (argList); if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); @@ -122,35 +126,6 @@ Tcl_PanicVA( } /* - *---------------------------------------------------------------------- - * - * Tcl_Panic -- - * - * Print an error message and kill the process. - * - * Results: - * None. - * - * Side effects: - * The process dies, entering the debugger if possible. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -void -Tcl_Panic( - const char *format, - ...) -{ - va_list argList; - - va_start(argList, format); - Tcl_PanicVA(format, argList); - va_end (argList); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclResult.c b/generic/tclResult.c index 618b7d8..ad45c41 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -444,41 +444,6 @@ Tcl_GetObjResult( /* *---------------------------------------------------------------------- * - * Tcl_AppendResultVA -- - * - * Append a variable number of strings onto the interpreter's result. - * - * Results: - * None. - * - * Side effects: - * The result of the interpreter given by the first argument is extended - * by the strings in the va_list (up to a terminating NULL argument). - * - * If the string result is non-empty, the object result forced to be a - * duplicate of it first. There will be a string result afterwards. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendResultVA( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return value. */ - va_list argList) /* Variable argument list. */ -{ - Tcl_Obj *objPtr = Tcl_GetObjResult(interp); - - if (Tcl_IsShared(objPtr)) { - objPtr = Tcl_DuplicateObj(objPtr); - } - Tcl_AppendStringsToObjVA(objPtr, argList); - Tcl_SetObjResult(interp, objPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_AppendResult -- * * Append a variable number of strings onto the interpreter's result. @@ -502,9 +467,23 @@ Tcl_AppendResult( Tcl_Interp *interp, ...) { va_list argList; + Tcl_Obj *objPtr; va_start(argList, interp); - Tcl_AppendResultVA(interp, argList); + objPtr = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(objPtr)) { + objPtr = Tcl_DuplicateObj(objPtr); + } + while (1) { + const char *bytes = va_arg(argList, char *); + + if (bytes == NULL) { + break; + } + Tcl_AppendToObj(objPtr, bytes, -1); + } + Tcl_SetObjResult(interp, objPtr); va_end(argList); } @@ -684,7 +663,7 @@ ResetObjResult( /* *---------------------------------------------------------------------- * - * Tcl_SetErrorCodeVA -- + * Tcl_SetErrorCode -- * * This function is called to record machine-readable information about * an error that is about to be returned. @@ -701,11 +680,19 @@ ResetObjResult( */ void -Tcl_SetErrorCodeVA( - Tcl_Interp *interp, /* Interpreter in which to set errorCode */ - va_list argList) /* Variable argument list. */ +Tcl_SetErrorCode( + Tcl_Interp *interp, ...) { - Tcl_Obj *errorObj = Tcl_NewObj(); + va_list argList; + Tcl_Obj *errorObj; + + /* + * Scan through the arguments one at a time, appending them to the + * errorCode field as list elements. + */ + + va_start(argList, interp); + errorObj = Tcl_NewObj(); /* * Scan through the arguments one at a time, appending them to the @@ -721,40 +708,6 @@ Tcl_SetErrorCodeVA( Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); } Tcl_SetObjErrorCode(interp, errorObj); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetErrorCode -- - * - * This function is called to record machine-readable information about - * an error that is about to be returned. - * - * Results: - * None. - * - * Side effects: - * The errorCode field of the interp is modified to hold all of the - * arguments to this function, in a list form with each argument becoming - * one element of the list. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetErrorCode( - Tcl_Interp *interp, ...) -{ - va_list argList; - - /* - * Scan through the arguments one at a time, appending them to the - * errorCode field as list elements. - */ - - va_start(argList, interp); - Tcl_SetErrorCodeVA(interp, argList); va_end(argList); } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 04cf4ee..b38f521 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1613,7 +1613,7 @@ AppendUtfToUtfRep( /* *---------------------------------------------------------------------- * - * Tcl_AppendStringsToObjVA -- + * Tcl_AppendStringsToObj -- * * This function appends one or more null-terminated strings to an * object. @@ -1629,10 +1629,13 @@ AppendUtfToUtfRep( */ void -Tcl_AppendStringsToObjVA( - Tcl_Obj *objPtr, /* Points to the object to append to. */ - va_list argList) /* Variable argument list. */ +Tcl_AppendStringsToObj( + Tcl_Obj *objPtr, + ...) { + va_list argList; + + va_start(argList, objPtr); if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } @@ -1645,35 +1648,6 @@ Tcl_AppendStringsToObjVA( } Tcl_AppendToObj(objPtr, bytes, -1); } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AppendStringsToObj -- - * - * This function appends one or more null-terminated strings to an - * object. - * - * Results: - * None. - * - * Side effects: - * The contents of all the string arguments are appended to the string - * representation of objPtr. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendStringsToObj( - Tcl_Obj *objPtr, - ...) -{ - va_list argList; - - va_start(argList, objPtr); - Tcl_AppendStringsToObjVA(objPtr, argList); va_end(argList); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 50fc6de..39d1262 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -937,18 +937,18 @@ const TclStubs tclStubs = { Tcl_WrongNumArgs, /* 264 */ Tcl_DumpActiveMemory, /* 265 */ Tcl_ValidateAllMemory, /* 266 */ - Tcl_AppendResultVA, /* 267 */ - Tcl_AppendStringsToObjVA, /* 268 */ + 0, /* 267 */ + 0, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ Tcl_PkgPresent, /* 271 */ Tcl_PkgPresentEx, /* 272 */ TclPkgProvide, /* 273 */ Tcl_PkgRequire, /* 274 */ - Tcl_SetErrorCodeVA, /* 275 */ + 0, /* 275 */ 0, /* 276 */ Tcl_WaitPid, /* 277 */ - Tcl_PanicVA, /* 278 */ + 0, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ -- cgit v0.12 From 0dc45b9fe32757b2732fb96074bc20110b636a0d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 29 Dec 2012 15:24:24 +0000 Subject: fix tm.tcl to include tcl8 locations, and fix corresponding test-cases --- library/tm.tcl | 1 - tests/tm.test | 5 +++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/library/tm.tcl b/library/tm.tcl index 4288658..2eff644 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -342,7 +342,6 @@ proc ::tcl::tm::Defaults {} { } } } - } return } diff --git a/tests/tm.test b/tests/tm.test index 73e8261..42352e9 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -202,6 +202,11 @@ proc genpaths {base} { set base [file normalize $base] foreach {major minor} [split [info tclversion] .] break set results {} + set base8 [file join $base tcl8] + lappend results [file join $base8 site-tcl] + for {set i 0} {$i <= 7} {incr i} { + lappend results [file join $base8 8.$i] + } set base [file join $base tcl$major] lappend results [file join $base site-tcl] for {set i 0} {$i <= $minor} {incr i} { -- cgit v0.12 From aef36bf11d4ad79a6f2e6691f132fd4c444822df Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 29 Dec 2012 18:12:45 +0000 Subject: two more places where refCount was assumed to be a signed value. In Tcl9 that will probably be not true any more. --- generic/tclObj.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 03141e4..7841bcf 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3784,7 +3784,7 @@ Tcl_DbDecrRefCount( * If the Tcl_Obj is going to be deleted, remove the entry. */ - if ((objPtr->refCount - 1) <= 0) { + if (objPtr->refCount < 2) { ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { @@ -3797,7 +3797,7 @@ Tcl_DbDecrRefCount( # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ - if (--(objPtr)->refCount <= 0) { + if ((objPtr)->refCount-- < 2) { TclFreeObj(objPtr); } } -- cgit v0.12 From 342be44f4da2cc09411fd0dc070ddcab26d87355 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 3 Jan 2013 10:17:14 +0000 Subject: don't use iPtr->legacyResult for Tcl >= 8.1, because it doesn't work. Use Tcl_AppendResult in stead. --- generic/tclStubLib.c | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index fc07c26..fb9c132 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -108,8 +108,18 @@ TclInitStubs( * This is quicker to check for than calling Tcl_GetVersion() */ if (sizeof(size_t) != sizeof(int)) { if (stubsPtr->reserved77 != NULL) { - iPtr->legacyResult = "incompatible stub library: have 9, need 8"; - iPtr->legacyFreeProc = 0; /* TCL_STATIC */ + /* Accessing iPtr->legacyResult doesn't work here as Tcl 8 doesn't + * check this field after the Xxx_Init call. */ + char stripped[32]; /* Requested version stripped starting with '-' */ + char *p = stripped; + + while (*version && (*version != '-')) { + *p++ = *version++; + } + *p = '\0'; + stubsPtr->tcl_ResetResult(interp); + stubsPtr->tcl_AppendResult(interp, "incompatible stub library: have ", + tclversion, ", need ", stripped, NULL); return NULL; } } -- cgit v0.12 From 75194c3206055ace1e071ed1c4ec3e6dc6248844 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 8 Jan 2013 17:10:04 +0000 Subject: The Tcl*(Scan|Convert)*Element() routines only need chars, not ints, to hold their flags. Reduce waste now that interface freedom permits it. --- generic/tcl.decls | 8 ++++---- generic/tclDecls.h | 16 ++++++++-------- generic/tclDictObj.c | 4 ++-- generic/tclIndexObj.c | 3 ++- generic/tclInt.h | 4 ++-- generic/tclListObj.c | 4 ++-- generic/tclUtil.c | 32 ++++++++++++++++---------------- 7 files changed, 36 insertions(+), 35 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index fe1d763..1084144 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -310,11 +310,11 @@ declare 83 { char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { - int Tcl_ConvertElement(const char *src, char *dst, int flags) + int Tcl_ConvertElement(const char *src, char *dst, char flags) } declare 85 { int Tcl_ConvertCountedElement(const char *src, int length, char *dst, - int flags) + char flags) } declare 86 { int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, @@ -778,10 +778,10 @@ declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 { - int Tcl_ScanElement(const char *src, int *flagPtr) + int Tcl_ScanElement(const char *src, char *flagPtr) } declare 219 { - int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) + int Tcl_ScanCountedElement(const char *src, int length, char *flagPtr) } # Removed in Tcl 9 #declare 220 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0770e98..e6c63b3 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -257,10 +257,10 @@ TCLAPI int Tcl_CommandComplete(const char *cmd); TCLAPI char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ TCLAPI int Tcl_ConvertElement(const char *src, char *dst, - int flags); + char flags); /* 85 */ TCLAPI int Tcl_ConvertCountedElement(const char *src, - int length, char *dst, int flags); + int length, char *dst, char flags); /* 86 */ TCLAPI int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, @@ -625,10 +625,10 @@ TCLAPI void Tcl_Release(ClientData clientData); /* 217 */ TCLAPI void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -TCLAPI int Tcl_ScanElement(const char *src, int *flagPtr); +TCLAPI int Tcl_ScanElement(const char *src, char *flagPtr); /* 219 */ TCLAPI int Tcl_ScanCountedElement(const char *src, int length, - int *flagPtr); + char *flagPtr); /* Slot 220 is reserved */ /* 221 */ TCLAPI int Tcl_ServiceAll(void); @@ -1877,8 +1877,8 @@ typedef struct TclStubs { int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ - int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ - int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ + int (*tcl_ConvertElement) (const char *src, char *dst, char flags); /* 84 */ + int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, char flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ @@ -2019,8 +2019,8 @@ typedef struct TclStubs { void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ - int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ - int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ + int (*tcl_ScanElement) (const char *src, char *flagPtr); /* 218 */ + int (*tcl_ScanCountedElement) (const char *src, int length, char *flagPtr); /* 219 */ void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 170e744..25124a1 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -488,7 +488,7 @@ UpdateStringOfDict( Tcl_Obj *dictPtr) { #define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr = NULL; + char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict = dictPtr->internalRep.otherValuePtr; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; @@ -520,7 +520,7 @@ UpdateStringOfDict( } else if (numElems > maxFlags) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { - flagPtr = ckalloc(numElems * sizeof(int)); + flagPtr = ckalloc(numElems * sizeof(char)); } for (i=0,cPtr=dict->entryChainHead; inextPtr) { /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 512f5ba..7b85481 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -873,7 +873,8 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen, flags; + int i, len, elemLen; + char flags; Interp *iPtr = (Interp *) interp; const char *elementStr; diff --git a/generic/tclInt.h b/generic/tclInt.h index f8d9b08..eb16dd5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2880,7 +2880,7 @@ MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); MODULE_SCOPE int TclConvertElement(const char *src, int length, - char *dst, int flags); + char *dst, char flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, @@ -3085,7 +3085,7 @@ MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr); MODULE_SCOPE int TclScanElement(const char *string, int length, - int *flagPtr); + char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 85737d5..63db812 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1924,7 +1924,7 @@ UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { # define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr = NULL; + char localFlags[LOCAL_SIZE], *flagPtr = NULL; List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; int i, length, bytesNeeded = 0; @@ -1961,7 +1961,7 @@ UpdateStringOfList( * We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = ckalloc(numElems * sizeof(int)); + flagPtr = ckalloc(numElems * sizeof(char)); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index df257e8..c8cb75c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -871,9 +871,9 @@ Tcl_SplitList( int Tcl_ScanElement( - register const char *src, /* String to convert to list element. */ - register int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + const char *src, /* String to convert to list element. */ + char *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } @@ -905,10 +905,10 @@ int Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ - int *flagPtr) /* Where to store information to guide + char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { - int flags = CONVERT_ANY; + char flags = CONVERT_ANY; int numBytes = TclScanElement(src, length, &flags); *flagPtr = flags; @@ -949,7 +949,7 @@ int TclScanElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ - int *flagPtr) /* Where to store information to guide + char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; @@ -1234,9 +1234,9 @@ TclScanElement( int Tcl_ConvertElement( - register const char *src, /* Source information for list element. */ - register char *dst, /* Place to put list-ified element. */ - register int flags) /* Flags produced by Tcl_ScanElement. */ + const char *src, /* Source information for list element. */ + char *dst, /* Place to put list-ified element. */ + char flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1267,7 +1267,7 @@ Tcl_ConvertCountedElement( register const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ - int flags) /* Flags produced by Tcl_ScanElement. */ + char flags) /* Flags produced by Tcl_ScanElement. */ { int numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; @@ -1300,9 +1300,9 @@ TclConvertElement( register const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ - int flags) /* Flags produced by Tcl_ScanElement. */ + char flags) /* Flags produced by Tcl_ScanElement. */ { - int conversion = flags & CONVERT_MASK; + char conversion = flags & CONVERT_MASK; char *p = dst; /* @@ -1482,9 +1482,9 @@ Tcl_Merge( const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr = NULL; + char localFlags[LOCAL_SIZE]; int i, bytesNeeded = 0; - char *result, *dst; + char *result, *dst, *flagPtr = NULL; const int maxFlags = UINT_MAX / sizeof(int); /* @@ -1519,7 +1519,7 @@ Tcl_Merge( Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { - flagPtr = ckalloc(argc * sizeof(int)); + flagPtr = ckalloc(argc * sizeof(char)); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); @@ -2597,7 +2597,7 @@ Tcl_DStringAppendElement( { char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); - int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; + char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; int newSize = dsPtr->length + needSpace + TclScanElement(element, -1, &flags); -- cgit v0.12 From 361141a857edbcd93e6181ea1ce037de9042984c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 8 Jan 2013 21:42:23 +0000 Subject: remove some unused static functions/variables --- unix/tclUnixTime.c | 80 ------------------------------------------------------ 1 file changed, 80 deletions(-) diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 6e8c5f4..27b6a58 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -16,26 +16,10 @@ #include #endif -#define TM_YEAR_BASE 1900 -#define IsLeapYear(x) (((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0)) - -/* - * If we fall back on the thread-unsafe versions of gmtime and localtime, use - * this mutex to try to protect them. - */ - -TCL_DECLARE_MUTEX(tmMutex) - -static char *lastTZ = NULL; /* Holds the last setting of the TZ - * environment variable, or an empty string if - * the variable was not set. */ - /* * Static functions declared in this file. */ -static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, @@ -350,70 +334,6 @@ NativeGetTime( timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } -/* - *---------------------------------------------------------------------- - * - * SetTZIfNecessary -- - * - * Determines whether a call to 'tzset' is needed prior to the next call - * to 'localtime' or examination of the 'timezone' variable. - * - * Results: - * None. - * - * Side effects: - * If 'tzset' has never been called in the current process, or if the - * value of the environment variable TZ has changed since the last call - * to 'tzset', then 'tzset' is called again. - * - *---------------------------------------------------------------------- - */ - -static void -SetTZIfNecessary(void) -{ - const char *newTZ = getenv("TZ"); - - Tcl_MutexLock(&tmMutex); - if (newTZ == NULL) { - newTZ = ""; - } - if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { - tzset(); - if (lastTZ == NULL) { - Tcl_CreateExitHandler(CleanupMemory, NULL); - } else { - Tcl_Free(lastTZ); - } - lastTZ = ckalloc(strlen(newTZ) + 1); - strcpy(lastTZ, newTZ); - } - Tcl_MutexUnlock(&tmMutex); -} - -/* - *---------------------------------------------------------------------- - * - * CleanupMemory -- - * - * Releases the private copy of the TZ environment variable upon exit - * from Tcl. - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -CleanupMemory( - ClientData ignored) -{ - ckfree(lastTZ); -} /* * Local Variables: -- cgit v0.12 From 0481e3ca74a06381151d36ed72e32d8c12c7c29d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 Jan 2013 10:30:00 +0000 Subject: New function Tcl_InitSubsystems, still to be TIP'ed --- doc/FindExec.3 | 54 ++++++++++++++++++++++++++++++++++++++++++++-- doc/InitStubs.3 | 4 ++++ generic/tcl.h | 10 ++++++++- generic/tclEncoding.c | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++- generic/tclStubLib.c | 55 +++++++++++++++++++++++++--------------------- 5 files changed, 154 insertions(+), 29 deletions(-) diff --git a/doc/FindExec.3 b/doc/FindExec.3 index e4b4ed0..216588c 100644 --- a/doc/FindExec.3 +++ b/doc/FindExec.3 @@ -8,7 +8,7 @@ .TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application +Tcl_FindExecutable, Tcl_GetNameOfExecutable, Tcl_InitSubsystems \- identify or return the name of the binary file containing the application .SH SYNOPSIS .nf \fB#include \fR @@ -18,11 +18,18 @@ void .sp const char * \fBTcl_GetNameOfExecutable\fR() +.sp +Tcl_Interp * +\fBTcl_InitSubsystems\fR(\fIflags\fR, \fI...\fR) .SH ARGUMENTS .AS char *argv0 .AP char *argv0 in The first command-line argument to the program, which gives the application's name. +.AP int flags in +Any combination of TCL_INIT_PANIC or TCL_INIT_CREATE, which indicate +whether a custom panicProc is registered and/or a real interpreter is created. +The value 0 can be used if Tcl is used as utility library only. .BE .SH DESCRIPTION @@ -58,6 +65,49 @@ internal full path name of the executable file as computed by equivalent to the \fBinfo nameofexecutable\fR command. NULL is returned if the internal full path name has not been computed or unknown. - +.PP +The \fBTcl_InitSubsystems\fR can be used as alternative to +\fBTcl_FindExecutable\fR, when more flexibility is required. +Its flags control exactly what is initialized. +.PP +The call \fBTcl_InitSubsystems(0)\fR does the same as +\fBTcl_FindExecutable(NULL)\fR, except that a Tcl_Interp * +is returned which can be used only by \fBTcl_InitStubs\fR +to initialize the stub table. This opens up the Tcl Stub +technology for Tcl embedders, which now can dynamically +load the Tcl shared library and use functions in it +without ever creating an interpreter. E.g. the +following code can be compiled with -DUSE_TCL_STUBS: +.CS + handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL); + initSubSystems = dlsym(handle, "Tcl_InitSubsystems"); + interp = initSubSystems(0); /* not a real interpreter */ + Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */ + interp = Tcl_CreateInterp(); /* now we have a real interpreter */ +.CE +The function \fBTcl_CreateInterp\fR, or any other Tcl function you +would like to call, no longer needs to be searched for in the +shared library. It can be called directly though the stub table. +.PP +If you supply the flag TCL_INIT_PANIC to \fBTcl_InitSubsystems\fR, +the function expects an additional argument, a custom panicProc. +This is equivalent to calling \fBTcl_SetPanicProc\fR immediately +before \fBTcl_InitSubsystems\fR. +.PP +If you supply the flag TCL_INIT_CREATE to \fBTcl_InitSubsystems\fR, +the function gets two additional parameters, argc and argv. A real +Tcl interpreter will be created and if argc > 0 then the variables +"argc" and "argv" will be set in this interpreter. So, the above +example code could be simplified to: +.CS + handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL); + initSubSystems = dlsym(handle, "Tcl_InitSubsystems"); + interp = initSubSystems(TCL_INIT_CREATE, 0, NULL); /* real interpreter */ + Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */ +.CE +.PP +The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to +any other function than Tcl_InitStubs(). Tcl functions with an "interp" +argument can only be called if this function supports passing NULL. .SH KEYWORDS binary, executable file diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 4dc62c6..8188b0b 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -83,6 +83,10 @@ non-zero means that only the specified \fIversion\fR is acceptable. \fBTcl_InitStubs\fR returns a string containing the actual version of Tcl satisfying the request, or NULL if the Tcl version is not acceptable, does not support stubs, or any other error condition occurred. +.PP +If \fBTcl_InitStubs\fR is called with as first argument the +pseudo interpreter returned by \fBTcl_InitSubsystems(0)\fR, then +the \fIversion\fR and \fIexact\fR parameters have no effect. .SH "SEE ALSO" Tk_InitStubs .SH KEYWORDS diff --git a/generic/tcl.h b/generic/tcl.h index 3003abf..8a7911b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2409,13 +2409,21 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, * TODO - tommath stubs export goes here! */ +/* Tcl_InitSubsystems, see TIP ??? */ + +#define TCL_INIT_PANIC (1) /* Set Panic proc */ +#define TCL_INIT_CREATE (4) /* Call Tcl_CreateInterp(), and set argc/argv */ + +EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...); + /* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) + Tcl_InitSubsystems(TCL_INIT_CREATE, argc, argv)) +// (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 7a55724..9a64f10 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1411,7 +1411,7 @@ Tcl_UtfToExternal( /* *--------------------------------------------------------------------------- * - * Tcl_FindExecutable -- + * Tcl_InitSubsystems/Tcl_FindExecutable -- * * This function computes the absolute path name of the current * application, given its argv[0] value. @@ -1425,6 +1425,64 @@ Tcl_UtfToExternal( * *--------------------------------------------------------------------------- */ +MODULE_SCOPE const TclStubs tclStubs; + +/* Dummy const structure returned by Tcl_InitSubsystems, + * which looks like an Tcl_Interp, but in reality is not. + * It contains just enough for Tcl_InitStubs to be able + * to initialize the stub table. */ +static const struct { + const char *version; /* a real interpreter has interp->result here. */ + void (*unused2) (void); /* a real interpreter has interp->freeProc here. */ + int magic; /* a real interpreter has interp->errorLine here. */ + const struct TclStubs *stubTable; +} dummyInterp = { + TCL_PATCH_LEVEL, 0, TCL_STUB_MAGIC, &tclStubs +}; + +Tcl_Interp * +Tcl_InitSubsystems(int flags, ...) +{ + va_list argList; + + int argc = 0; + char **argv = NULL; + + va_start(argList, flags); + if (flags & TCL_INIT_PANIC) { + Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *)); + } + if (flags & TCL_INIT_CREATE) { + argc = va_arg(argList, int); + argv = va_arg(argList, char **); + } + va_end (argList); + + TclInitSubsystems(); + TclpSetInitialEncodings(); + TclpFindExecutable(argv ? argv[0] : NULL); + if (flags & TCL_INIT_CREATE) { + Tcl_Interp *interp = Tcl_CreateInterp(); + if (argc > 0) { + Tcl_Obj *argvPtr; + argc--; + argv++; + + Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); + argvPtr = Tcl_NewListObj(argc, NULL); + while (argc--) { + Tcl_DString ds; + + Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); + Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds)); + } + Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); + } + return interp; + } + return (Tcl_Interp *) &dummyInterp; +} + #undef Tcl_FindExecutable void Tcl_FindExecutable( diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 859cbf9..c5c0d92 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -73,37 +73,42 @@ Tcl_InitStubs( return NULL; } - actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); - if (actualVersion == NULL) { - return NULL; - } - if (exact) { - const char *p = version; - int count = 0; - - while (*p) { - count += !isDigit(*p++); + if(iPtr->errorLine == TCL_STUB_MAGIC) { + actualVersion = iPtr->result; + tclStubsPtr = stubsPtr; + } else { + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); + if (actualVersion == NULL) { + return NULL; } - if (count == 1) { - const char *q = actualVersion; + if (exact) { + const char *p = version; + int count = 0; - p = version; - while (*p && (*p == *q)) { - p++; q++; - } - if (*p || isDigit(*q)) { - /* Construct error message */ - stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); - return NULL; + while (*p) { + count += !isDigit(*p++); } - } else { - actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); - if (actualVersion == NULL) { - return NULL; + if (count == 1) { + const char *q = actualVersion; + + p = version; + while (*p && (*p == *q)) { + p++; q++; + } + if (*p || isDigit(*q)) { + /* Construct error message */ + stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + return NULL; + } + } else { + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + if (actualVersion == NULL) { + return NULL; + } } } + tclStubsPtr = (const TclStubs *)pkgData; } - tclStubsPtr = (TclStubs *)pkgData; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; -- cgit v0.12 From 051f9006efbeea4b577bcdc748351ed3604964ce Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 Jan 2013 12:33:45 +0000 Subject: Restore API compatibility with public Tcl_*Scan and Tcl_*Convert functions (changes in private functions are OK) Increase LOCAL_SIZE to 64, and remove two Panic's which cannot occur any more as a result of the improvements. --- generic/tcl.decls | 8 ++++---- generic/tclDecls.h | 16 ++++++++-------- generic/tclDictObj.c | 7 ++----- generic/tclListObj.c | 4 ++-- generic/tclUtil.c | 32 +++++++------------------------- 5 files changed, 23 insertions(+), 44 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 1084144..fe1d763 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -310,11 +310,11 @@ declare 83 { char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { - int Tcl_ConvertElement(const char *src, char *dst, char flags) + int Tcl_ConvertElement(const char *src, char *dst, int flags) } declare 85 { int Tcl_ConvertCountedElement(const char *src, int length, char *dst, - char flags) + int flags) } declare 86 { int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, @@ -778,10 +778,10 @@ declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 { - int Tcl_ScanElement(const char *src, char *flagPtr) + int Tcl_ScanElement(const char *src, int *flagPtr) } declare 219 { - int Tcl_ScanCountedElement(const char *src, int length, char *flagPtr) + int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } # Removed in Tcl 9 #declare 220 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index e6c63b3..0770e98 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -257,10 +257,10 @@ TCLAPI int Tcl_CommandComplete(const char *cmd); TCLAPI char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ TCLAPI int Tcl_ConvertElement(const char *src, char *dst, - char flags); + int flags); /* 85 */ TCLAPI int Tcl_ConvertCountedElement(const char *src, - int length, char *dst, char flags); + int length, char *dst, int flags); /* 86 */ TCLAPI int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, @@ -625,10 +625,10 @@ TCLAPI void Tcl_Release(ClientData clientData); /* 217 */ TCLAPI void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -TCLAPI int Tcl_ScanElement(const char *src, char *flagPtr); +TCLAPI int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ TCLAPI int Tcl_ScanCountedElement(const char *src, int length, - char *flagPtr); + int *flagPtr); /* Slot 220 is reserved */ /* 221 */ TCLAPI int Tcl_ServiceAll(void); @@ -1877,8 +1877,8 @@ typedef struct TclStubs { int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ - int (*tcl_ConvertElement) (const char *src, char *dst, char flags); /* 84 */ - int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, char flags); /* 85 */ + int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ + int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ @@ -2019,8 +2019,8 @@ typedef struct TclStubs { void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ - int (*tcl_ScanElement) (const char *src, char *flagPtr); /* 218 */ - int (*tcl_ScanCountedElement) (const char *src, int length, char *flagPtr); /* 219 */ + int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ + int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 25124a1..2bc5f81 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -487,7 +487,7 @@ static void UpdateStringOfDict( Tcl_Obj *dictPtr) { -#define LOCAL_SIZE 20 +#define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict = dictPtr->internalRep.otherValuePtr; ChainEntry *cPtr; @@ -495,7 +495,6 @@ UpdateStringOfDict( int i, length, bytesNeeded = 0; const char *elem; char *dst; - const int maxFlags = UINT_MAX / sizeof(int); /* * This field is the most useful one in the whole hash structure, and it @@ -517,10 +516,8 @@ UpdateStringOfDict( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; - } else if (numElems > maxFlags) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { - flagPtr = ckalloc(numElems * sizeof(char)); + flagPtr = ckalloc(numElems); } for (i=0,cPtr=dict->entryChainHead; inextPtr) { /* diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 63db812..6cbb10f 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1923,7 +1923,7 @@ static void UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { -# define LOCAL_SIZE 20 +# define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; @@ -1961,7 +1961,7 @@ UpdateStringOfList( * We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = ckalloc(numElems * sizeof(char)); + flagPtr = ckalloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index c8cb75c..c6dd464 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -872,7 +872,7 @@ Tcl_SplitList( int Tcl_ScanElement( const char *src, /* String to convert to list element. */ - char *flagPtr) /* Where to store information to guide + int *flagPtr) /* Where to store information to guide * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); @@ -905,7 +905,7 @@ int Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ - char *flagPtr) /* Where to store information to guide + int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { char flags = CONVERT_ANY; @@ -1236,7 +1236,7 @@ int Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ - char flags) /* Flags produced by Tcl_ScanElement. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1267,7 +1267,7 @@ Tcl_ConvertCountedElement( register const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ - char flags) /* Flags produced by Tcl_ScanElement. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { int numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; @@ -1481,11 +1481,10 @@ Tcl_Merge( int argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { -#define LOCAL_SIZE 20 +#define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE]; int i, bytesNeeded = 0; char *result, *dst, *flagPtr = NULL; - const int maxFlags = UINT_MAX / sizeof(int); /* * Handle empty list case first, so logic of the general case can be @@ -1504,33 +1503,16 @@ Tcl_Merge( if (argc <= LOCAL_SIZE) { flagPtr = localFlags; - } else if (argc > maxFlags) { - /* - * We cannot allocate a large enough flag array to format this list in - * one pass. We could imagine converting this routine to a multi-pass - * implementation, but for sizeof(int) == 4, the limit is a max of - * 2^30 list elements and since each element is at least one byte - * formatted, and requires one byte space between it and the next one, - * that a minimum space requirement of 2^31 bytes, which is already - * INT_MAX. If we tried to format a list of > maxFlags elements, we're - * just going to overflow the size limits on the formatted string - * anyway, so just issue that same panic early. - */ - - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { - flagPtr = ckalloc(argc * sizeof(char)); + flagPtr = ckalloc(argc); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]); - if (bytesNeeded < 0) { + if ((bytesNeeded < 0) || (bytesNeeded > INT_MAX - argc + 1)) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } - if (bytesNeeded > INT_MAX - argc + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } bytesNeeded += argc; /* -- cgit v0.12 From 1c58938f2cff44bd2447ac657f8451c385097def Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 Jan 2013 15:37:27 +0000 Subject: Restore panic check at and of the loop. Thanks! Don for noticing this. --- generic/tclUtil.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index c6dd464..68567b0 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1509,10 +1509,13 @@ Tcl_Merge( for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]); - if ((bytesNeeded < 0) || (bytesNeeded > INT_MAX - argc + 1)) { + if (bytesNeeded < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } + if (bytesNeeded > INT_MAX - argc + 1) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } bytesNeeded += argc; /* -- cgit v0.12 From c260fedf0cabb7390681f57498d6a4212c1018d1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Jan 2013 09:55:55 +0000 Subject: Turn Tcl_PkgPresent/Tcl_PkgRequire into a macro. Make sure that extensions which are compiled using Tcl version 9.0 alpha/beta headers only run with the exact same Tcl version (9.0a0), so they cannot accidently be used in production. Idea 'stolen' from iTcl 4.0, which did that during alpha/beta Dde/Registry: eliminate usage of some older API, which might be removed/deprecated in the future. --- generic/tcl.decls | 18 +++++++++------- generic/tcl.h | 9 ++++++-- generic/tclDecls.h | 22 +++++++++---------- generic/tclPkg.c | 44 +++++++------------------------------- generic/tclStubInit.c | 4 ++-- generic/tclTest.c | 2 +- generic/tclTestProcBodyObj.c | 2 +- generic/tclZlib.c | 2 +- unix/dltest/pkga.c | 4 ++-- unix/dltest/pkgb.c | 4 ++++ unix/dltest/pkgc.c | 8 +++---- unix/dltest/pkgd.c | 8 +++---- unix/dltest/pkge.c | 2 +- unix/dltest/pkgua.c | 4 ++-- win/tclWinDde.c | 51 +++++++++++++++++++------------------------- win/tclWinReg.c | 39 +++++++++++++++++---------------- 16 files changed, 100 insertions(+), 123 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index fe1d763..6f46e61 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -962,10 +962,11 @@ declare 270 { const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr) } -declare 271 { - const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} +# Removed in 9.0, converted to macro +#declare 271 { +# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} declare 272 { const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, @@ -977,10 +978,11 @@ declare 273 { const char *version) } # TIP #268: The internally used new Require function is in slot 573. -declare 274 { - const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} +# Removed in 9.0, converted to macro +#declare 274 { +# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} declare 275 { void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) } diff --git a/generic/tcl.h b/generic/tcl.h index cc3efaf..11c77d8 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2207,8 +2207,13 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, */ #ifdef USE_TCL_STUBS -#define Tcl_InitStubs(interp, version, exact) \ - TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC) +#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE +# define Tcl_InitStubs(interp, version, exact) \ + TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC) +#else +# define Tcl_InitStubs(interp, version, exact) \ + TclInitStubs(interp, TCL_PATCH_LEVEL, 1, TCL_VERSION, TCL_STUB_MAGIC) +#endif #else #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0770e98..cfabbd4 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -778,9 +778,7 @@ TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr); -/* 271 */ -TCLAPI const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact); +/* Slot 271 is reserved */ /* 272 */ TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, @@ -788,9 +786,7 @@ TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp, /* 273 */ TCLAPI int TclPkgProvide(Tcl_Interp *interp, const char *name, const char *version); -/* 274 */ -TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, - const char *version, int exact); +/* Slot 274 is reserved */ /* 275 */ TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList); @@ -2072,10 +2068,10 @@ typedef struct TclStubs { void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ - const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ + void (*reserved271)(void); const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ - const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ + void (*reserved274)(void); void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ void (*reserved276)(void); Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ @@ -2998,14 +2994,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ -#define Tcl_PkgPresent \ - (tclStubsPtr->tcl_PkgPresent) /* 271 */ +/* Slot 271 is reserved */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ #define TclPkgProvide \ (tclStubsPtr->tclPkgProvide) /* 273 */ -#define Tcl_PkgRequire \ - (tclStubsPtr->tcl_PkgRequire) /* 274 */ +/* Slot 274 is reserved */ #define Tcl_SetErrorCodeVA \ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ /* Slot 276 is reserved */ @@ -3740,7 +3734,11 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif +#define Tcl_PkgPresent(interp, name, version, exact) \ + Tcl_PkgPresentEx(interp, name, version, exact, NULL) #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) +#define Tcl_PkgRequire(interp, name, version, exact) \ + Tcl_PkgRequireEx(interp, name, version, exact, NULL) #endif /* _TCLDECLS */ diff --git a/generic/tclPkg.c b/generic/tclPkg.c index f67135d..ec5d0e6 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -88,7 +88,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, /* *---------------------------------------------------------------------- * - * Tcl_PkgProvide / Tcl_PkgProvideEx -- + * Tcl_PkgProvideEx -- * * This function is invoked to declare that a particular version of a * particular package is now present in an interpreter. There must not be @@ -154,7 +154,7 @@ Tcl_PkgProvideEx( /* *---------------------------------------------------------------------- * - * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc -- + * Tcl_PkgRequireEx / Tcl_PkgRequireProc -- * * This function is called by code that depends on a particular version * of a particular package. If the package is not already provided in the @@ -179,20 +179,6 @@ Tcl_PkgProvideEx( */ const char * -Tcl_PkgRequire( - Tcl_Interp *interp, /* Interpreter in which package is now - * available. */ - const char *name, /* Name of desired package. */ - const char *version, /* Version string for desired version; NULL - * means use the latest version available. */ - int exact) /* Non-zero means that only the particular - * version given is acceptable. Zero means use - * the latest compatible version. */ -{ - return Tcl_PkgRequireEx(interp, name, version, exact, NULL); -} - -const char * Tcl_PkgRequireEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ @@ -642,7 +628,7 @@ PkgRequireCore( /* *---------------------------------------------------------------------- * - * Tcl_PkgPresent / Tcl_PkgPresentEx -- + * Tcl_PkgPresentEx -- * * Checks to see whether the specified package is present. If it is not * then no additional action is taken. @@ -661,20 +647,6 @@ PkgRequireCore( */ const char * -Tcl_PkgPresent( - Tcl_Interp *interp, /* Interpreter in which package is now - * available. */ - const char *name, /* Name of desired package. */ - const char *version, /* Version string for desired version; NULL - * means use the latest version available. */ - int exact) /* Non-zero means that only the particular - * version given is acceptable. Zero means use - * the latest compatible version. */ -{ - return Tcl_PkgPresentEx(interp, name, version, exact, NULL); -} - -const char * Tcl_PkgPresentEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ @@ -936,7 +908,7 @@ Tcl_PackageObjCmd( version = TclGetString(objv[3]); } } - Tcl_PkgPresent(interp, name, version, exact); + Tcl_PkgPresentEx(interp, name, version, exact, NULL); return TCL_ERROR; break; } @@ -961,7 +933,7 @@ Tcl_PackageObjCmd( if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } - return Tcl_PkgProvide(interp, argv2, argv3); + return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); case PKG_REQUIRE: require: if (objc < 3) { @@ -1880,7 +1852,7 @@ Tcl_PkgInitStubsCheck( const char * version, int exact) { - const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); + const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL); if (exact && actualVersion) { const char *p = version; @@ -1892,11 +1864,11 @@ Tcl_PkgInitStubsCheck( if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ - Tcl_PkgPresent(interp, "Tcl", version, 1); + Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); return NULL; } } else { - return Tcl_PkgPresent(interp, "Tcl", version, 1); + return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); } } return actualVersion; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 50fc6de..9a5dee2 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -941,10 +941,10 @@ const TclStubs tclStubs = { Tcl_AppendStringsToObjVA, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ - Tcl_PkgPresent, /* 271 */ + 0, /* 271 */ Tcl_PkgPresentEx, /* 272 */ TclPkgProvide, /* 273 */ - Tcl_PkgRequire, /* 274 */ + 0, /* 274 */ Tcl_SetErrorCodeVA, /* 275 */ 0, /* 276 */ Tcl_WaitPid, /* 277 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index dcfe8b0..80a845a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -521,7 +521,7 @@ Tcltest_Init( } /* TIP #268: Full patchlevel instead of just major.minor */ - if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 3324b98..234b270 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -185,7 +185,7 @@ ProcBodyTestInitInternal( } } - return Tcl_PkgProvide(interp, packageName, packageVersion); + return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); } /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 9c1176e..5a693fc 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3871,7 +3871,7 @@ TclZlibInit( * Formally provide the package as a Tcl built-in. */ - return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); + return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL); } /* diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index 7e5d7d3..afa346a 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -122,10 +122,10 @@ Pkga_Init( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkga", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkga", "1.0", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 35f691a..b32092c 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -41,6 +41,10 @@ static int Pkgb_DemoObjCmd(ClientData clientData, *---------------------------------------------------------------------- */ +#ifndef Tcl_GetErrorLine +# define Tcl_GetErrorLine(interp) ((interp)->errorLine) +#endif + static int Pkgb_SubObjCmd( ClientData dummy, /* Not used. */ diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 4e3e174..c76c2d2 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -112,10 +112,10 @@ Pkgc_Init( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } @@ -149,10 +149,10 @@ Pkgc_SafeInit( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 4a1defa..ae9ff93 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -112,10 +112,10 @@ Pkgd_Init( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } @@ -149,10 +149,10 @@ Pkgd_SafeInit( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index 36c8c1a..a36ac30 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -38,7 +38,7 @@ Pkge_Init( { static const char script[] = "if 44 {open non_existent}"; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } return Tcl_Eval(interp, script); diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 2a38525..b92b320 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -199,7 +199,7 @@ Pkgua_Init( int code, cmdIndex = 0; Tcl_Command *cmdTokens; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } @@ -210,7 +210,7 @@ Pkgua_Init( PkguaInitTokensHashTable(); - code = Tcl_PkgProvide(interp, "Pkgua", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkgua", "1.0", NULL); if (code != TCL_OK) { return code; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index b4a4fde..013b320 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -147,20 +147,13 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } -#ifdef UNICODE - if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Win32s and Windows 9x are not supported platforms", -1)); - return TCL_ERROR; - } -#endif Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); + return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* @@ -385,9 +378,12 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; Tcl_DString ds; + const char *nameStr; + int len; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + nameStr = Tcl_GetStringFromObj(namePtr, &len); + Tcl_WinUtfToTChar(nameStr, len, &ds); if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); @@ -746,7 +742,7 @@ DdeServerProc( } else { returnString = (char *) Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); - len = sizeof(TCHAR) * len + 1; + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -767,7 +763,7 @@ DdeServerProc( } else { returnString = (char *) Tcl_GetUnicodeFromObj( variableObjPtr, &len); - len = sizeof(TCHAR) * len + 1; + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -1298,16 +1294,16 @@ DdeObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], ddeCommands, + sizeof(char *), "command", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, - "option", 0, &argIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeSrvOptions, + sizeof(char *), "option", 0, &argIndex) != TCL_OK) { /* * If it is the last argument, it might be a server name * instead of a bad argument. @@ -1355,8 +1351,8 @@ DdeObjCmd( } else if (objc >= 6 && objc <= 7) { firstArg = objc - 3; for (i = 2; i < firstArg; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, - "option", 0, &argIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeExecOptions, + sizeof(char *), "option", 0, &argIndex) != TCL_OK) { goto wrongDdeExecuteArgs; } if (argIndex == DDE_EXEC_ASYNC) { @@ -1376,8 +1372,8 @@ DdeObjCmd( if (objc == 6) { firstArg = 2; break; - } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + } else if ((objc == 7) && (Tcl_GetIndexFromObjStruct(NULL, objv[2], + ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; @@ -1394,8 +1390,8 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + } else if ((objc == 6) && (Tcl_GetIndexFromObjStruct(NULL, objv[2], + ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; @@ -1422,8 +1418,8 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", - 0, &argIndex) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeEvalOptions, + sizeof(char *), "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } @@ -1745,8 +1741,7 @@ DdeObjCmd( objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (objPtr) { - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); } objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, @@ -1841,9 +1836,7 @@ DdeObjCmd( Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } - length = -1; - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 619d9df..643bd06 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -156,14 +156,14 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.0"); + return Tcl_PkgProvideEx(interp, "registry", "1.3.0", NULL); } /* @@ -281,9 +281,9 @@ RegistryObjCmd( return TCL_ERROR; } - if (Tcl_GetString(objv[n])[0] == '-') { - if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, - &index) != TCL_OK) { + if (Tcl_GetStringFromObj(objv[n], NULL)[0] == '-') { + if (Tcl_GetIndexFromObjStruct(interp, objv[n++], modes, + sizeof(char *), "mode", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -299,8 +299,8 @@ RegistryObjCmd( } } - if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[n++], subcommands, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -520,7 +520,8 @@ DeleteValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(valueNameObj, NULL), + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -568,7 +569,7 @@ GetKeyNames( Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ if (patternObj) { - pattern = Tcl_GetString(patternObj); + pattern = Tcl_GetStringFromObj(patternObj, NULL); } else { pattern = NULL; } @@ -597,7 +598,7 @@ GetKeyNames( } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to enumerate subkeys of \"%s\": ", - Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); result = TCL_ERROR; } @@ -680,7 +681,8 @@ GetType( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get type of value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(valueNameObj, NULL), + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -774,7 +776,8 @@ GetValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(valueNameObj, NULL), + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -878,7 +881,7 @@ GetValueNames( result = TCL_OK; if (patternObj) { - pattern = Tcl_GetString(patternObj); + pattern = Tcl_GetStringFromObj(patternObj, NULL); } else { pattern = NULL; } @@ -1118,8 +1121,8 @@ ParseKeyName( */ rootObj = Tcl_NewStringObj(rootName, -1); - result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name", - TCL_EXACT, &index); + result = Tcl_GetIndexFromObjStruct(interp, rootObj, rootKeyNames, + sizeof(char *), "root name", TCL_EXACT, &index); Tcl_DecrRefCount(rootObj); if (result != TCL_OK) { return TCL_ERROR; @@ -1254,8 +1257,8 @@ SetValue( if (typeObj == NULL) { type = REG_SZ; - } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", - 0, (int *) &type) != TCL_OK) { + } else if (Tcl_GetIndexFromObjStruct(interp, typeObj, typeNames, + sizeof(char *), "type", 0, (int *) &type) != TCL_OK) { if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { return TCL_ERROR; } @@ -1408,7 +1411,7 @@ BroadcastValue( * Use the ignore the result. */ - result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE, + result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); objPtr = Tcl_NewObj(); -- cgit v0.12 From 3e3a85339f40295cf53962b0744236cc33f10d7f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Jan 2013 11:45:08 +0000 Subject: Remove TclWinNToHS, it is not used anywhere any more. --- generic/tclInt.decls | 7 ++++--- generic/tclIntPlatDecls.h | 13 ++++--------- generic/tclStubInit.c | 10 +--------- 3 files changed, 9 insertions(+), 21 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8c46e55..d23d61a 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1046,9 +1046,10 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -declare 6 win { - unsigned short TclWinNToHS(unsigned short ns) -} +# Removed in 8.1: +#declare 6 win { +# unsigned short TclWinNToHS(unsigned short ns) +#} declare 7 win { int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index f7eb442..010fe88 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -101,8 +101,7 @@ TCLAPI int TclWinGetSockOpt(SOCKET s, int level, int optname, TCLAPI HINSTANCE TclWinGetTclInstance(void); /* 5 */ TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); -/* 6 */ -TCLAPI unsigned short TclWinNToHS(unsigned short ns); +/* Slot 6 is reserved */ /* 7 */ TCLAPI int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen); @@ -278,7 +277,7 @@ typedef struct TclIntPlatStubs { int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ + void (*reserved6)(void); int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ @@ -412,8 +411,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ +/* Slot 6 is reserved */ #define TclWinSetSockOpt \ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ #define TclpGetPid \ @@ -518,10 +516,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* !END!: Do not edit above this line. */ -#if defined(__WIN32__) || defined(__CYGWIN__) -# undef TclWinNToHS -# define TclWinNToHS ntohs -#else +#if !defined(__WIN32__) && !defined(__CYGWIN__) # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) #endif diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 9a5dee2..66dadb8 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -66,14 +66,6 @@ static int TclPkgProvide( return TCL_ERROR; } -#if defined(_WIN32) || defined(__CYGWIN__) -#undef TclWinNToHS -#define TclWinNToHS winNToHS -static unsigned short TclWinNToHS(unsigned short ns) { - return ntohs(ns); -} -#endif - #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 @@ -494,7 +486,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - TclWinNToHS, /* 6 */ + 0, /* 6 */ TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ -- cgit v0.12 From ad5f7e54641391f59816162a8a53b2375e7222a0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Jan 2013 22:28:38 +0000 Subject: Convert Tcl_Eval and Tcl_GlobalEval to a macro --- generic/tcl.decls | 15 +++++++----- generic/tcl.h | 8 ------- generic/tclBasic.c | 56 -------------------------------------------- generic/tclDecls.h | 31 ++++++++++++------------ generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 45 ----------------------------------- generic/tclInterp.c | 10 ++++---- generic/tclOO.c | 4 ++-- generic/tclStubInit.c | 4 ++-- generic/tclTest.c | 18 +++++++------- generic/tclTestProcBodyObj.c | 2 +- generic/tclThreadTest.c | 2 +- generic/tclTrace.c | 4 ++-- generic/tclZlib.c | 4 ++-- unix/Makefile.in | 4 ++-- unix/dltest/pkge.c | 2 +- win/Makefile.in | 4 ++-- 17 files changed, 54 insertions(+), 161 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 6f46e61..2f1d4ac 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -467,16 +467,18 @@ declare 127 { declare 128 { const char *Tcl_ErrnoMsg(int err) } -declare 129 { - int Tcl_Eval(Tcl_Interp *interp, const char *script) -} +# Removed in 9.0: +#declare 129 { +# int Tcl_Eval(Tcl_Interp *interp, const char *script) +#} # Removed in 9.0: #declare 130 { # int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) #} -declare 131 { - int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in 9.0: +#declare 131 { +# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 132 { void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc) } @@ -639,6 +641,7 @@ declare 176 { #declare 177 { # int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) #} +# Removed in 9.0 #declare 178 { # int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) #} diff --git a/generic/tcl.h b/generic/tcl.h index c2ea113..5ae5f5d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2411,14 +2411,6 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #define Tcl_ConditionFinalize(condPtr) #endif /* TCL_THREADS */ -/* - *---------------------------------------------------------------------------- - * Deprecated Tcl functions: - */ - -#ifndef TCL_NO_DEPRECATED -#endif /* !TCL_NO_DEPRECATED */ - #endif /* RC_INVOKED */ /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c15d3c1..3427dff 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5341,62 +5341,6 @@ TclArgumentGet( /* *---------------------------------------------------------------------- * - * Tcl_Eval -- - * - * Execute a Tcl command in a string. This function executes the script - * directly, rather than compiling it to bytecodes. Before the arrival of - * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used - * for executing Tcl commands, but nowadays it isn't used much. - * - * Results: - * The return value is one of the return codes defined in tcl.h (such as - * TCL_OK), and interp's result contains a value to supplement the return - * code. The value of the result will persist only until the next call to - * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it! - * - * Side effects: - * Can be almost arbitrary, depending on the commands in the script. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_Eval( - Tcl_Interp *interp, /* Token for command interpreter (returned by - * previous call to Tcl_CreateInterp). */ - const char *script) /* Pointer to TCL command to execute. */ -{ - return Tcl_EvalEx(interp, script, -1, 0); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalObj -- - * - * These functions are deprecated but we keep them around for backwards - * compatibility reasons. - * - * Results: - * See the functions they call. - * - * Side effects: - * See the functions they call. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_EvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, 0); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are diff --git a/generic/tclDecls.h b/generic/tclDecls.h index f28069b..b824e76 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -385,11 +385,9 @@ TCLAPI int Tcl_Eof(Tcl_Channel chan); TCLAPI const char * Tcl_ErrnoId(void); /* 128 */ TCLAPI const char * Tcl_ErrnoMsg(int err); -/* 129 */ -TCLAPI int Tcl_Eval(Tcl_Interp *interp, const char *script); +/* Slot 129 is reserved */ /* Slot 130 is reserved */ -/* 131 */ -TCLAPI int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +/* Slot 131 is reserved */ /* 132 */ TCLAPI void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc); @@ -1918,9 +1916,9 @@ typedef struct TclStubs { int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ const char * (*tcl_ErrnoId) (void); /* 127 */ const char * (*tcl_ErrnoMsg) (int err); /* 128 */ - int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ + void (*reserved129)(void); void (*reserved130)(void); - int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ + void (*reserved131)(void); void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ @@ -2712,11 +2710,9 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ -#define Tcl_Eval \ - (tclStubsPtr->tcl_Eval) /* 129 */ +/* Slot 129 is reserved */ /* Slot 130 is reserved */ -#define Tcl_EvalObj \ - (tclStubsPtr->tcl_EvalObj) /* 131 */ +/* Slot 131 is reserved */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ @@ -3740,17 +3736,20 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, Tcl_PkgProvideEx(interp, name, version, NULL) #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) +#define Tcl_Eval(interp,objPtr) \ + Tcl_EvalEx((interp),(objPtr),-1,0) +#define Tcl_GlobalEval(interp,objPtr) \ + Tcl_EvalEx((interp),(objPtr),-1,TCL_EVAL_GLOBAL) /* * Deprecated Tcl procedures: */ -#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) -# undef Tcl_EvalObj + +#ifndef TCL_NO_DEPRECATED # define Tcl_EvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),0) -# undef Tcl_GlobalEvalObj + Tcl_EvalObjEx((interp),(objPtr),0) # define Tcl_GlobalEvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) -#endif + Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) +#endif /* !TCL_NO_DEPRECATED */ #endif /* _TCLDECLS */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 5f97a60..b840d04 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -746,7 +746,7 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -# TIP 338 made these public - now declared in tcl.h too +# TIP 338 made these public - now declared in tcl.h #declare 178 { # void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) #} diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 2c6ab11..26b168f 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -1209,49 +1209,4 @@ extern const TclIntStubs *tclIntStubsPtr; /* !END!: Do not edit above this line. */ -#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED) -# undef Tcl_SetStartupScript -# define Tcl_SetStartupScript \ - (tclStubsPtr->tcl_SetStartupScript) /* 622 */ -# undef Tcl_GetStartupScript -# define Tcl_GetStartupScript \ - (tclStubsPtr->tcl_GetStartupScript) /* 623 */ -# undef Tcl_CreateNamespace -# define Tcl_CreateNamespace \ - (tclStubsPtr->tcl_CreateNamespace) /* 506 */ -# undef Tcl_DeleteNamespace -# define Tcl_DeleteNamespace \ - (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ -# undef Tcl_AppendExportList -# define Tcl_AppendExportList \ - (tclStubsPtr->tcl_AppendExportList) /* 508 */ -# undef Tcl_Export -# define Tcl_Export \ - (tclStubsPtr->tcl_Export) /* 509 */ -# undef Tcl_Import -# define Tcl_Import \ - (tclStubsPtr->tcl_Import) /* 510 */ -# undef Tcl_ForgetImport -# define Tcl_ForgetImport \ - (tclStubsPtr->tcl_ForgetImport) /* 511 */ -# undef Tcl_GetCurrentNamespace -# define Tcl_GetCurrentNamespace \ - (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ -# undef Tcl_GetGlobalNamespace -# define Tcl_GetGlobalNamespace \ - (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ -# undef Tcl_FindNamespace -# define Tcl_FindNamespace \ - (tclStubsPtr->tcl_FindNamespace) /* 514 */ -# undef Tcl_FindCommand -# define Tcl_FindCommand \ - (tclStubsPtr->tcl_FindCommand) /* 515 */ -# undef Tcl_GetCommandFromObj -# define Tcl_GetCommandFromObj \ - (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ -# undef Tcl_GetCommandFullName -# define Tcl_GetCommandFullName \ - (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ -#endif - #endif /* _TCLINTDECLS */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 2b93ab0..8b7a5a4 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -299,7 +299,7 @@ Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { + if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) { return TCL_ERROR; } } @@ -345,7 +345,7 @@ Tcl_Init( * alternate tclInit command before calling Tcl_Init(). */ - return Tcl_Eval(interp, + return Tcl_EvalEx(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" " global tcl_libPath tcl_library env tclDefaultLibrary\n" @@ -407,7 +407,7 @@ Tcl_Init( " error $msg\n" " }\n" "}\n" -"tclInit"); +"tclInit", -1, 0); } /* @@ -3141,8 +3141,8 @@ Tcl_MakeSafe( * Assume these functions all work. [Bug 2895741] */ - (void) Tcl_Eval(interp, - "namespace eval ::tcl {namespace eval mathfunc {}}"); + (void) Tcl_EvalEx(interp, + "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master, "::tcl::mathfunc::min", 0, NULL); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master, diff --git a/generic/tclOO.c b/generic/tclOO.c index d6d2d6a..f5e1f20 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -267,7 +267,7 @@ TclOOInit( * to be fully provided. */ - if (Tcl_Eval(interp, initScript) != TCL_OK) { + if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) { return TCL_ERROR; } @@ -458,7 +458,7 @@ InitFoundation( if (TclOODefineSlots(fPtr) != TCL_OK) { return TCL_ERROR; } - return Tcl_Eval(interp, slotScript); + return Tcl_EvalEx(interp, slotScript, -1, 0); } /* diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 3dd0b48..eb9cd95 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -783,9 +783,9 @@ const TclStubs tclStubs = { Tcl_Eof, /* 126 */ Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ - Tcl_Eval, /* 129 */ + 0, /* 129 */ 0, /* 130 */ - Tcl_EvalObj, /* 131 */ + 0, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ Tcl_ExposeCommand, /* 134 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index eb54dd7..0168a3d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -916,7 +916,7 @@ AsyncHandlerProc( listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); if (interp != NULL) { - code = Tcl_Eval(interp, cmd); + code = Tcl_EvalEx(interp, cmd, -1, 0); } else { /* * this should not happen, but by definition of how async handlers are @@ -1199,7 +1199,7 @@ TestcmdtraceCmd( if (strcmp(argv[1], "tracetest") == 0) { Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1215,13 +1215,13 @@ TestcmdtraceCmd( */ cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL); - Tcl_Eval(interp, argv[2]); + Tcl_EvalEx(interp, argv[2], -1, 0); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1239,7 +1239,7 @@ TestcmdtraceCmd( cmdTrace = Tcl_CreateObjTrace(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, (ClientData) &deleteCalled, ObjTraceDeleteProc); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC); @@ -1253,7 +1253,7 @@ TestcmdtraceCmd( Tcl_DStringInit(&buffer); t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer); t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1582,7 +1582,7 @@ DelDeleteProc( { DelCmd *dPtr = clientData; - Tcl_Eval(dPtr->interp, dPtr->deleteCmd); + Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); ckfree(dPtr); @@ -4918,7 +4918,7 @@ TestsaveresultCmd( if (((enum options) index) == RESULT_OBJECT) { result = Tcl_EvalObjEx(interp, objv[2], 0); } else { - result = Tcl_Eval(interp, Tcl_GetString(objv[2])); + result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0); } if (discard) { @@ -6014,7 +6014,7 @@ TestReport( } Tcl_DStringEndSublist(&ds); Tcl_SaveResult(interp, &savedResult); - Tcl_Eval(interp, Tcl_DStringValue(&ds)); + Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0); Tcl_DStringFree(&ds); Tcl_RestoreResult(interp, &savedResult); } diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 234b270..be510fc 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -143,7 +143,7 @@ RegisterCommand( if (cmdTablePtr->exportIt) { sprintf(buf, "namespace eval %s { namespace export %s }", namespace, cmdTablePtr->cmdName); - if (Tcl_Eval(interp, buf) != TCL_OK) { + if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { return TCL_ERROR; } } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index e718d34..ab0a169 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -613,7 +613,7 @@ NewTestThread( */ Tcl_Preserve(tsdPtr->interp); - result = Tcl_Eval(tsdPtr->interp, threadEvalScript); + result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 2dfd893..79bf0f8 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1885,7 +1885,7 @@ TraceExecutionProc( * interpreter. */ - traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), -1, 0); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; /* @@ -1975,7 +1975,7 @@ TraceVarProc( int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* - * We might call Tcl_Eval() below, and that might evaluate [trace vdelete] + * We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete] * which might try to free tvarPtr. We want to use tvarPtr until the end * of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure * it is not freed while we still need it. diff --git a/generic/tclZlib.c b/generic/tclZlib.c index e2cb3ea..ea3b9cc 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -763,7 +763,7 @@ Tcl_ZlibStreamInit( */ if (interp != NULL) { - if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) { + if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); @@ -3847,7 +3847,7 @@ TclZlibInit( * commands. */ - Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}"); + Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0); /* * Create the public scripted interface to this file's functionality. diff --git a/unix/Makefile.in b/unix/Makefile.in index ee31282..f57d0ce 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -139,8 +139,8 @@ TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@ # To compile without backward compatibility and deprecated code uncomment the # following -NO_DEPRECATED_FLAGS = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +#NO_DEPRECATED_FLAGS = +NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # Some versions of make, like SGI's, use the following variable to determine # which shell to use for executing commands: diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index a36ac30..c3380a7 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -41,5 +41,5 @@ Pkge_Init( if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - return Tcl_Eval(interp, script); + return Tcl_EvalEx(interp, script, -1, 0); } diff --git a/win/Makefile.in b/win/Makefile.in index 8582600..d061df2 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -84,8 +84,8 @@ CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE # To compile without backward compatibility and deprecated code uncomment the # following -NO_DEPRECATED_FLAGS = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +#NO_DEPRECATED_FLAGS = +NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # To enable compilation debugging reverse the comment characters on one of the # following lines. -- cgit v0.12 From 2c02c2ae5d892599247538f12315b137dbdeba59 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 Jan 2013 11:45:17 +0000 Subject: Eliminate some unneeded usages of Tcl_SetResult, Tcl_AddObjErrorInfo Fix "make test-packages" on cygwin --- generic/tclAssembly.c | 9 ++++----- generic/tclEnsemble.c | 2 +- generic/tclExecute.c | 4 ++-- generic/tclOO.c | 2 +- generic/tclResult.c | 2 +- generic/tclThreadTest.c | 2 +- generic/tclTrace.c | 2 +- generic/tclVar.c | 4 ++-- unix/Makefile.in | 2 +- unix/tclUnixTest.c | 10 +++++----- win/tclWinTest.c | 2 +- 11 files changed, 20 insertions(+), 21 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 7833105..99bdf43 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -798,12 +798,11 @@ TclNRAssembleObjCmd( if (codePtr == NULL) { Tcl_AddErrorInfo(interp, "\n (\""); - Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0])); + Tcl_AppendObjToErrorInfo(interp, objv[0]); Tcl_AddErrorInfo(interp, "\" body, line "); backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp)); Tcl_IncrRefCount(backtrace); - Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace)); - Tcl_DecrRefCount(backtrace); + Tcl_AppendObjToErrorInfo(interp, backtrace); Tcl_AddErrorInfo(interp, ")"); return TCL_ERROR; } @@ -4270,11 +4269,11 @@ AddBasicBlockRangeToErrorInfo( Tcl_AddErrorInfo(interp, "\n in assembly code between lines "); lineNo = Tcl_NewIntObj(bbPtr->startLine); Tcl_IncrRefCount(lineNo); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 88de9f3..f392cad 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2196,7 +2196,7 @@ EnsembleUnknownCallback( } Tcl_AddErrorInfo(interp, "\n result of " "ensemble unknown subcommand handler: "); - Tcl_AddErrorInfo(interp, TclGetString(unknownCmd)); + Tcl_AppendObjToErrorInfo(interp, unknownCmd); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT", NULL); } else { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8a68e9b..479ab86 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3464,8 +3464,8 @@ TEBCresume( varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (!varPtr) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); + Tcl_AddErrorInfo(interp, + "\n (reading value of variable to increment)"); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); Tcl_DecrRefCount(incrPtr); goto gotError; diff --git a/generic/tclOO.c b/generic/tclOO.c index d6d2d6a..cb22de6 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -843,7 +843,7 @@ ObjectRenamedTrace( result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 0, NULL); if (result != TCL_OK) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_RestoreInterpState(interp, state); TclOODeleteContext(contextPtr); diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..07f6819 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1587,7 +1587,7 @@ Tcl_GetReturnOptions( } if (result == TCL_ERROR) { - Tcl_AddObjErrorInfo(interp, "", -1); + Tcl_AddErrorInfo(interp, ""); Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index b90e33d..1115ff0 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -926,7 +926,7 @@ ThreadSend( ckfree(resultPtr->errorInfo); } } - Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC); + Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 519f201..0f297a4 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1322,7 +1322,7 @@ TraceCommandProc( Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ - /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/ + /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/ } Tcl_DStringFree(&cmd); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 9b8527c..2d1479d 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -2036,8 +2036,8 @@ TclIncrObjVar2( varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", 1, 1, &arrayPtr); if (varPtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); + Tcl_AddErrorInfo(interp, + "\n (reading value of variable to increment)"); return NULL; } return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, diff --git a/unix/Makefile.in b/unix/Makefile.in index ee31282..f8dd67c 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1718,7 +1718,7 @@ install-packages: packages fi; \ done -test-packages: tcltest packages +test-packages: ${TCLTEST_EXE} packages @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 46fc972..c10225d 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -200,7 +200,7 @@ TestfilehandlerCmd( return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", @@ -217,8 +217,8 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK); fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else - Tcl_SetResult(interp, "can't make pipes non-blocking", - TCL_STATIC); + Tcl_AppendResult(interp, "can't make pipes non-blocking", + NULL); return TCL_ERROR; #endif } @@ -281,7 +281,7 @@ TestfilehandlerCmd( memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(argv[1], "wait") == 0) { @@ -390,7 +390,7 @@ TestfilewaitCmd( if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (ClientData*) &data) != TCL_OK) { - Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC); + Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } fd = PTR2INT(data); diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 136c4db..b83c0ba 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -211,7 +211,7 @@ TestvolumetypeCmd( TclWinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_SetResult(interp, volType, TCL_VOLATILE); + Tcl_AppendResult(interp, volType, NULL); return TCL_OK; #undef VOL_BUF_SIZE } -- cgit v0.12 From 4796adf5cb7dda39555411ea4941ab630f2eabec Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 Jan 2013 13:07:06 +0000 Subject: Another memory leak, and one Tcl_Free -> ckfree --- generic/tclThreadTest.c | 1 + unix/tclUnixTime.c | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 1115ff0..8708f9a 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -930,6 +930,7 @@ ThreadSend( Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; + ckfree(resultPtr->result); ckfree(resultPtr); return code; diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index c7921fe..926e8f4 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -503,7 +503,7 @@ SetTZIfNecessary(void) if (lastTZ == NULL) { Tcl_CreateExitHandler(CleanupMemory, NULL); } else { - Tcl_Free(lastTZ); + ckfree(lastTZ); } lastTZ = ckalloc(strlen(newTZ) + 1); strcpy(lastTZ, newTZ); -- cgit v0.12 From 1d5118fd6cf705d79ec670284492d9eff6637965 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 26 Jan 2013 16:11:33 +0000 Subject: macros for Tcl_GetString and Tcl_GetStringFromObj --- generic/tclCkalloc.c | 10 +++--- generic/tclDecls.h | 10 ++++++ generic/tclEncoding.c | 10 +++--- generic/tclInt.h | 6 ++-- generic/tclObj.c | 3 +- generic/tclUtil.c | 82 +++++++++++++++++++++++++------------------------- generic/tclZlib.c | 15 +++++---- macosx/tclMacOSXFCmd.c | 6 ++-- unix/dltest/pkga.c | 2 +- unix/dltest/pkgua.c | 2 +- unix/tclUnixFCmd.c | 27 +++++++++++------ unix/tclUnixFile.c | 17 ++++++----- unix/tclUnixInit.c | 7 +++-- unix/tclUnixSock.c | 46 ++++++++++++++-------------- win/tclWinDde.c | 52 +++++++++----------------------- win/tclWinFCmd.c | 14 ++++----- win/tclWinFile.c | 25 ++++++++------- win/tclWinInit.c | 15 ++++----- win/tclWinPipe.c | 7 ++--- win/tclWinReg.c | 70 ++++++++++++++++++++++++------------------ win/tclWinSock.c | 4 +-- 21 files changed, 221 insertions(+), 209 deletions(-) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index c25ed11..800e272 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1067,7 +1067,7 @@ Tcl_MemAlloc( */ if ((result == NULL) && size) { - Tcl_Panic("unable to alloc %u bytes", size); + Tcl_Panic("unable to alloc %" TCL_LL_MODIFIER "u bytes", (Tcl_WideInt)size); } return result; } @@ -1084,7 +1084,8 @@ Tcl_DbCkalloc( if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to alloc %" TCL_LL_MODIFIER "u bytes, %s line %d", + (Tcl_WideInt)size, file, line); } return result; } @@ -1143,7 +1144,7 @@ Tcl_MemRealloc( result = TclpRealloc(ptr, size); if ((result == NULL) && size) { - Tcl_Panic("unable to realloc %u bytes", size); + Tcl_Panic("unable to realloc %" TCL_LL_MODIFIER "u bytes", (Tcl_WideInt)size); } return result; } @@ -1161,7 +1162,8 @@ Tcl_DbCkrealloc( if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to realloc %" TCL_LL_MODIFIER "u bytes, %s line %d", + (Tcl_WideInt)size, file, line); } return result; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ca3d5c6..6821a4e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3749,4 +3749,14 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, # define Tcl_GlobalEvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif /* !TCL_NO_DEPRECATED */ + +#if defined(USE_TCL_STUBS) && !defined(TCL_COMPAT_8) +# undef Tcl_GetString +# define Tcl_GetString(obj) \ + ((obj)->bytes?(obj)->bytes:tclStubsPtr->tcl_GetString(obj)) +# undef Tcl_GetStringFromObj +# define Tcl_GetStringFromObj(obj, lengthPtr) \ + (Tcl_GetString(obj),(*(lengthPtr) = (obj)->length), (obj)->bytes) +#endif + #endif /* _TCLDECLS */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 757f771..a5b4d74 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3473,11 +3473,12 @@ unilen( static void InitializeEncodingSearchPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; - int i, numDirs, numBytes; + int i, numDirs; + size_t numBytes; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; TclNewLiteralStringObj(encodingObj, "encoding"); @@ -3507,11 +3508,12 @@ InitializeEncodingSearchPath( if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } - bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes); + bytes = Tcl_GetString(searchPathObj); + numBytes = searchPathObj->length; *lengthPtr = numBytes; *valuePtr = ckalloc(numBytes + 1); - memcpy(*valuePtr, bytes, (size_t) numBytes + 1); + memcpy(*valuePtr, bytes, numBytes + 1); Tcl_DecrRefCount(searchPathObj); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 0f862e8..1afda26 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2597,7 +2597,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -2611,7 +2611,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr, typedef struct ProcessGlobalValue { int epoch; /* Epoch counter to detect changes in the * master value. */ - int numBytes; /* Length of the master string. */ + size_t numBytes; /* Length of the master string. */ char *value; /* The master string value. */ Tcl_Encoding encoding; /* system encoding when master string was * initialized. */ @@ -3042,7 +3042,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - int *lengthPtr, Tcl_Encoding *encodingPtr); + size_t *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); diff --git a/generic/tclObj.c b/generic/tclObj.c index 5f653a4..1eaf54a 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1664,7 +1664,6 @@ Tcl_GetString( *---------------------------------------------------------------------- */ -#undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should @@ -1676,7 +1675,7 @@ Tcl_GetStringFromObj( (void) TclGetString(objPtr); if (lengthPtr != NULL) { - *lengthPtr = objPtr->length; + *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; } return objPtr->bytes; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 68567b0..98c7c65 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -81,7 +81,7 @@ static ProcessGlobalValue executableName = { * in other cases this means an overestimate of the * required size. * - * For more details, see the comments on the Tcl*Scan*Element and + * For more details, see the comments on the Tcl*Scan*Element and * Tcl*Convert*Element routines. */ @@ -175,7 +175,7 @@ const Tcl_ObjType tclEndOffsetType = { * * NOTE: This means that if and when backslash substitution rules ever change * for command parsing, the interpretation of strings as lists also changes. - * + * * Backslash substitution replaces an "escape sequence" of one or more * characters starting with * \u005c \ BACKSLASH @@ -188,7 +188,7 @@ const Tcl_ObjType tclEndOffsetType = { * * * If the first character of a formatted substring is * \u007b { OPEN BRACE - * then the end of the substring is the matching + * then the end of the substring is the matching * \u007d } CLOSE BRACE * character, where matching is determined by counting nesting levels, and * not including any brace characters that are contained within a backslash @@ -210,7 +210,7 @@ const Tcl_ObjType tclEndOffsetType = { * includes an unbalanced brace not in a backslash escape sequence, and any * value that ends with a backslash not itself in a backslash escape * sequence. - * + * * * If the first character of a formatted substring is * \u0022 " QUOTE * then the end of the substring is the next QUOTE character, not counting @@ -337,7 +337,7 @@ const Tcl_ObjType tclEndOffsetType = { * directives. This makes it easy to experiment with eliminating this * formatting mode simply with "#define COMPAT 0" above. I believe this is * worth considering. - * + * * Another consideration is the treatment of QUOTE characters in list * elements. TclConvertElement() must have the ability to produce the escape * sequence \" so that when a list element begins with a QUOTE we do not @@ -397,7 +397,7 @@ TclMaxListLength( * No list element before leading white space. */ - count += 1 - TclIsSpaceProc(*bytes); + count += 1 - TclIsSpaceProc(*bytes); /* * Count white space runs as potential element separators. @@ -433,7 +433,7 @@ TclMaxListLength( * No list element following trailing white space. */ - count -= TclIsSpaceProc(bytes[-1]); + count -= TclIsSpaceProc(bytes[-1]); done: if (endPtr) { @@ -501,7 +501,7 @@ TclFindElement( * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal list element and therefore - * does not/does require a call to + * does not/does require a call to * TclCopyAndCollapse() by the caller. */ { const char *p = list; @@ -968,7 +968,7 @@ TclScanElement( int preferBrace = 0; /* CONVERT_MASK mode. */ int braceCount = 0; /* Count of all braces '{' '}' seen. */ #endif /* COMPAT */ - + if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) { /* * Empty string element must be brace quoted. @@ -1046,7 +1046,7 @@ TclScanElement( * Final backslash. Cannot format with brace quoting. */ - requireEscape = 1; + requireEscape = 1; break; } if (p[1] == '\n') { @@ -1440,7 +1440,7 @@ TclConvertElement( return p - dst; } - /* + /* * If we reach this point, there's an embedded NULL in the string * range being processed, which should not happen when the * encoding rules for Tcl strings are properly followed. If the @@ -1768,7 +1768,7 @@ Tcl_Concat( for (p = result, i = 0; i < argc; i++) { int trim, elemLength; const char *element; - + element = argv[i]; elemLength = strlen(argv[i]); @@ -1835,7 +1835,8 @@ Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { - int i, elemLength, needSpace = 0, bytesNeeded = 0; + int i, needSpace = 0; + size_t bytesNeeded = 0, elemLength; const char *element; Tcl_Obj *objPtr, *resPtr; @@ -1846,13 +1847,14 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - int length; + size_t length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } - Tcl_GetStringFromObj(objPtr, &length); + Tcl_GetString(objPtr); + length = objPtr->length; if (length > 0) { break; } @@ -1884,11 +1886,9 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - element = TclGetStringFromObj(objv[i], &elemLength); + element = TclGetString(objv[i]); + elemLength = objv[i]->length; bytesNeeded += elemLength; - if (bytesNeeded < 0) { - break; - } } /* @@ -1902,9 +1902,10 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int trim; - - element = TclGetStringFromObj(objv[i], &elemLength); + size_t trim; + + element = TclGetString(objv[i]); + elemLength = objv[i]->length; /* * Trim away the leading whitespace. @@ -2541,10 +2542,9 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - int length; - char *bytes = Tcl_GetStringFromObj(objPtr, &length); + char *bytes = Tcl_GetString(objPtr); - return Tcl_DStringAppend(dsPtr, bytes, length); + return Tcl_DStringAppend(dsPtr, bytes, objPtr->length); } char * @@ -2776,11 +2776,11 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { - int length; - char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); + Tcl_Obj *obj = Tcl_GetObjResult(interp); + char *bytes = Tcl_GetString(obj); Tcl_DStringFree(dsPtr); - Tcl_DStringAppend(dsPtr, bytes, length); + Tcl_DStringAppend(dsPtr, bytes, obj->length); Tcl_ResetResult(interp); } @@ -2819,7 +2819,7 @@ TclDStringToObj( /* * Static buffer, so must copy. */ - + TclNewStringObj(result, dsPtr->string, dsPtr->length); } } else { @@ -2937,7 +2937,7 @@ Tcl_PrintDouble( /* * Handle NaN. */ - + if (TclIsNaN(value)) { TclFormatNaN(value, dst); return; @@ -2946,12 +2946,12 @@ Tcl_PrintDouble( /* * Handle infinities. */ - + if (TclIsInfinite(value)) { /* * Remember to copy the terminating NUL too. */ - + if (value < 0) { memcpy(dst, "-Inf", 5); } else { @@ -2963,7 +2963,7 @@ Tcl_PrintDouble( /* * Ordinary (normal and denormal) values. */ - + if (*precisionPtr == 0) { digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, &exponent, &signum, &end); @@ -3008,7 +3008,7 @@ Tcl_PrintDouble( */ digits = TclDoubleDigits(value, *precisionPtr, - TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, + TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, &exponent, &signum, &end); } if (signum) { @@ -3019,7 +3019,7 @@ Tcl_PrintDouble( /* * E format for numbers < 1e-3 or >= 1e17. */ - + *dst++ = *p++; c = *p; if (c != '\0') { @@ -3044,7 +3044,7 @@ Tcl_PrintDouble( /* * F format for others. */ - + if (exponent < 0) { *dst++ = '0'; } @@ -3720,7 +3720,8 @@ TclSetProcessGlobalValue( } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } - bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes); + bytes = Tcl_GetString(newValue); + pgvPtr->numBytes = newValue->length; pgvPtr->value = ckalloc(pgvPtr->numBytes + 1); memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1); if (pgvPtr->encoding) { @@ -3914,11 +3915,10 @@ TclGetObjNameOfExecutable(void) const char * Tcl_GetNameOfExecutable(void) { - int numBytes; - const char *bytes = - Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes); + Tcl_Obj *obj = TclGetObjNameOfExecutable(); + const char *bytes = Tcl_GetString(obj); - if (numBytes == 0) { + if (obj->length == 0) { return NULL; } return bytes; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index ea3b9cc..2c9c923 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -438,8 +438,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = Tcl_GetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = Tcl_GetString(value); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); headerPtr->nativeCommentBuf[len] = '\0'; @@ -459,8 +459,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = Tcl_GetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = Tcl_GetString(value); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL, headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); headerPtr->nativeFilenameBuf[len] = '\0'; headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; @@ -1535,7 +1535,7 @@ Tcl_ZlibDeflate( if (!interp) { return TCL_ERROR; } - + /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. @@ -3338,10 +3338,9 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, ""); } } else { - int len; - const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len); + const char *str = Tcl_GetString(cd->compDictObj); - Tcl_DStringAppend(dsPtr, str, len); + Tcl_DStringAppend(dsPtr, str, cd->compDictObj->length); } } diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index f266443..12459bc 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -636,12 +636,12 @@ SetOSTypeFromAny( Tcl_Obj *objPtr) /* Pointer to the object to convert */ { const char *string; - int length, result = TCL_OK; + int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_UtfToExternalDString(encoding, string, length, &ds); + string = Tcl_GetString(objPtr); + Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index afa346a..6081e7b 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -48,7 +48,7 @@ Pkga_EqObjCmd( { int result; const char *str1, *str2; - int len1, len2; + size_t len1, len2; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index b92b320..0fdf81d 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -124,7 +124,7 @@ PkguaEqObjCmd( { int result; const char *str1, *str2; - int len1, len2; + size_t len1, len2; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index d9952b9..0e87cba 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1476,9 +1476,10 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; - int length; + size_t length; - string = Tcl_GetStringFromObj(attributePtr, &length); + string = Tcl_GetString(attributePtr); + length = attributePtr->length; native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ @@ -1543,9 +1544,10 @@ SetOwnerAttribute( Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; - int length; + size_t length; - string = Tcl_GetStringFromObj(attributePtr, &length); + string = Tcl_GetString(attributePtr); + length = attributePtr->length; native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ @@ -1915,15 +1917,16 @@ TclpObjNormalizePath( int nextCheckpoint) { const char *currentPathEndPosition; - int pathLen; + size_t pathLen; char cur; - const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); + const char *path = Tcl_GetString(pathPtr); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH char normPath[MAXPATHLEN]; #endif + pathLen = pathPtr->length; /* * We add '1' here because if nextCheckpoint is zero we know that '/' * exists, and if it isn't zero, it must point at a directory separator @@ -2146,14 +2149,16 @@ TclUnixOpenTemporaryFile( { Tcl_DString template, tmp; const char *string; - int len, fd; + size_t len; + int fd; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { - string = Tcl_GetStringFromObj(dirObj, &len); + string = Tcl_GetString(dirObj); + len = dirObj->length; Tcl_UtfToExternalDString(NULL, string, len, &template); } else { Tcl_DStringInit(&template); @@ -2163,7 +2168,8 @@ TclUnixOpenTemporaryFile( TclDStringAppendLiteral(&template, "/"); if (basenameObj) { - string = Tcl_GetStringFromObj(basenameObj, &len); + string = Tcl_GetString(basenameObj); + len = basenameObj->length; Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); Tcl_DStringFree(&tmp); @@ -2175,7 +2181,8 @@ TclUnixOpenTemporaryFile( #ifdef HAVE_MKSTEMPS if (extensionObj) { - string = Tcl_GetStringFromObj(extensionObj, &len); + string = Tcl_GetString(extensionObj); + len = extensionObj->length; Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 5bfe5d9..a687731 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -259,14 +259,15 @@ TclpMatchInDirectory( DIR *d; Tcl_DirEntry *entryPtr; const char *dirName; - int dirLength, nativeDirLen; + size_t dirLength, nativeDirLen; int matchHidden, matchHiddenPat; Tcl_StatBuf statBuf; Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetString(fileNamePtr); + dirLength = fileNamePtr->length; Tcl_DStringAppend(&dsOrig, dirName, dirLength); /* @@ -934,7 +935,7 @@ TclpObjLink( */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - int targetLen; + size_t targetLen; Tcl_DString ds; Tcl_Obj *transPtr; @@ -948,7 +949,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = Tcl_GetStringFromObj(transPtr, &targetLen); + target = Tcl_GetString(transPtr); + targetLen = transPtr->length; target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); Tcl_DecrRefCount(transPtr); @@ -1077,7 +1079,7 @@ TclNativeCreateNativeRep( const char *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - int len; + size_t len; if (TclFSCwdIsNative()) { /* @@ -1102,12 +1104,13 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = Tcl_GetStringFromObj(validPathPtr, &len); + str = Tcl_GetString(validPathPtr); + len = validPathPtr->length; Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); Tcl_DecrRefCount(validPathPtr); nativePathPtr = ckalloc(len); - memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); + memcpy(nativePathPtr, Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); return nativePathPtr; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 39be160..1d81310 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -458,7 +458,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 @@ -547,9 +547,10 @@ TclpInitLibraryPath( Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = Tcl_GetStringFromObj(pathPtr, lengthPtr); + str = Tcl_GetString(pathPtr); + *lengthPtr = pathPtr->length; *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, str, (*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 528f009..a964653 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -180,7 +180,7 @@ static ProcessGlobalValue hostName = static void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; @@ -249,7 +249,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = strlen(native); *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, native, (*lengthPtr)+1); } /* @@ -545,7 +545,7 @@ TcpCloseProc( * handlers are already deleted in the generic IO channel closing code * that called this function, so we do not have to delete them here. */ - + for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { if (fds->fd < 0) { continue; @@ -554,7 +554,7 @@ TcpCloseProc( if (close(fds->fd) < 0) { errorCode = errno; } - + } fds = statePtr->fds.next; while (fds != NULL) { @@ -858,7 +858,7 @@ TcpWatchProc( */ return; } - + if (statePtr->flags & TCP_ASYNC_CONNECT) { /* Async sockets use a FileHandler internally while connecting, so we * need to cache this request until the connection has succeeded. */ @@ -974,7 +974,7 @@ CreateClientSocket( for (state->myaddr = state->myaddrlist; state->myaddr != NULL; state->myaddr = state->myaddr->ai_next) { int reuseaddr; - + /* * No need to try combinations of local and remote addresses of * different families. @@ -1003,15 +1003,15 @@ CreateClientSocket( * Set the close-on-exec flag so that the socket will not get * inherited by child processes. */ - + fcntl(state->fds.fd, F_SETFD, FD_CLOEXEC); - + /* * Set kernel space buffering */ - + TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE); - + if (async) { status = TclUnixSetBlockingMode(state->fds.fd, TCL_MODE_NONBLOCKING); @@ -1035,7 +1035,7 @@ CreateClientSocket( * will set up a file handler on the socket if she is interested * in being informed when the connect completes. */ - + status = connect(state->fds.fd, state->addr->ai_addr, state->addr->ai_addrlen); if (status < 0 && errno == EINPROGRESS) { @@ -1305,28 +1305,28 @@ Tcl_OpenTcpServer( } continue; } - + /* * Set the close-on-exec flag so that the socket will not get * inherited by child processes. */ - + fcntl(sock, F_SETFD, FD_CLOEXEC); - + /* * Set kernel space buffering */ - + TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE); - + /* * Set up to reuse server addresses automatically and bind to the * specified port. */ - + (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &reuseaddr, sizeof(reuseaddr)); - + /* * Make sure we use the same port number when opening two server * sockets for IPv4 and IPv6 on a random port. @@ -1355,7 +1355,7 @@ Tcl_OpenTcpServer( if (howfar < BIND) { howfar = BIND; my_errno = errno; - } + } close(sock); continue; } @@ -1385,7 +1385,7 @@ Tcl_OpenTcpServer( /* * Allocate a new TcpState for this socket. */ - + statePtr = ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->acceptProc = acceptProc; @@ -1400,12 +1400,12 @@ Tcl_OpenTcpServer( newfds->fd = sock; newfds->statePtr = statePtr; fds = newfds; - + /* * Set up the callback mechanism for accepting connections from new * clients. */ - + Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); } @@ -1464,7 +1464,7 @@ TcpAccept( socklen_t len; /* For accept interface */ char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; - + len = sizeof(addr); newsock = accept(fds->fd, &addr.sa, &len); if (newsock < 0) { diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 013b320..22f2216 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -17,15 +17,6 @@ #include #include -#ifndef UNICODE -# undef CP_WINUNICODE -# define CP_WINUNICODE CP_WINANSI -# undef Tcl_WinTCharToUtf -# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) -# undef Tcl_WinUtfToTChar -# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) -#endif - #if !defined(NDEBUG) /* test POKE server Implemented for debug mode only */ # undef CBF_FAIL_POKES @@ -379,11 +370,10 @@ DdeSetServerName( Tcl_Obj* namePtr; Tcl_DString ds; const char *nameStr; - int len; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - nameStr = Tcl_GetStringFromObj(namePtr, &len); - Tcl_WinUtfToTChar(nameStr, len, &ds); + nameStr = Tcl_GetString(namePtr); + Tcl_WinUtfToTChar(nameStr, namePtr->length, &ds); if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); @@ -621,7 +611,7 @@ DdeServerProc( /* Transaction-dependent data. */ { Tcl_DString dString; - int len; + size_t len; DWORD dlen; TCHAR *utilString; Tcl_Obj *ddeObjectPtr; @@ -738,11 +728,13 @@ DdeServerProc( if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { if (uFmt == CF_TEXT) { returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + Tcl_GetString(convPtr->returnPackagePtr); + len = convPtr->returnPackagePtr->length; } else { + int tmp; returnString = (char *) - Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); - len = 2 * len + 1; + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &tmp); + len = 2 * tmp + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -758,12 +750,14 @@ DdeServerProc( TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { if (uFmt == CF_TEXT) { - returnString = Tcl_GetStringFromObj( - variableObjPtr, &len); + returnString = Tcl_GetString( + variableObjPtr); + len = variableObjPtr->length; } else { + int tmp; returnString = (char *) Tcl_GetUnicodeFromObj( - variableObjPtr, &len); - len = 2 * len + 1; + variableObjPtr, &tmp); + len = 2 * tmp + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -1433,11 +1427,7 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { -#ifdef UNICODE serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); -#else - serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); -#endif } else { length = 0; } @@ -1450,11 +1440,7 @@ DdeObjCmd( } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { -#ifdef UNICODE topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length); -#else - topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); -#endif if (length == 0) { topicName = NULL; } else { @@ -1531,13 +1517,8 @@ DdeObjCmd( break; } case DDE_REQUEST: { -#ifdef UNICODE const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); -#else - const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], - &length); -#endif if (length == 0) { Tcl_SetObjResult(interp, @@ -1591,13 +1572,8 @@ DdeObjCmd( break; } case DDE_POKE: { -#ifdef UNICODE const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); -#else - const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], - &length); -#endif BYTE *dataString; if (length == 0) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index ac88861..4ec6714 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1582,8 +1582,8 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - int len; - const char *str = Tcl_GetStringFromObj(fileName,&len); + const char *str = Tcl_GetString(fileName); + size_t len = fileName->length; if (len < 4) { if (len == 0) { @@ -1668,12 +1668,11 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; - int pathLen; Tcl_ListObjIndex(NULL, splitPath, i, &elt); - pathv = Tcl_GetStringFromObj(elt, &pathLen); - if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':')) + pathv = Tcl_GetString(elt); + if ((pathv[0] == '/') || ((elt->length == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* * Handle "/", "//machine/export", "c:/", "." or ".." by just @@ -1696,7 +1695,6 @@ ConvertFileNameFormat( Tcl_DString dsTemp; const TCHAR *nativeName; const char *tempString; - int tempLen; WIN32_FIND_DATA data; HANDLE handle; DWORD attr; @@ -1710,8 +1708,8 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&ds); - tempString = Tcl_GetStringFromObj(tempPath,&tempLen); - nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); + tempString = Tcl_GetString(tempPath); + nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds); Tcl_DecrRefCount(tempPath); handle = FindFirstFile(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 42405d4..9250cb4 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -928,11 +928,12 @@ TclpMatchInDirectory( * Match a single file directly. */ - int len; + size_t len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - const char *str = Tcl_GetStringFromObj(norm,&len); + const char *str = Tcl_GetString(norm); + len = norm->length; native = Tcl_FSGetNativePath(pathPtr); if (GetFileAttributesEx(native, @@ -952,7 +953,7 @@ TclpMatchInDirectory( WIN32_FIND_DATA data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - int dirLength; + size_t dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -991,7 +992,8 @@ TclpMatchInDirectory( */ Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetString(fileNamePtr); + dirLength = fileNamePtr->length; Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; @@ -2820,15 +2822,14 @@ TclpObjNormalizePath( * Not the end of the string. */ - int len; char *path; Tcl_Obj *tmpPathPtr; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); - path = Tcl_GetStringFromObj(tmpPathPtr, &len); - Tcl_SetStringObj(pathPtr, path, len); + path = Tcl_GetString(tmpPathPtr); + Tcl_SetStringObj(pathPtr, path, tmpPathPtr->length); Tcl_DecrRefCount(tmpPathPtr); } else { /* @@ -2911,11 +2912,12 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - int cwdLen; + size_t cwdLen; const char *drive = - Tcl_GetStringFromObj(useThisCwd, &cwdLen); + Tcl_GetString(useThisCwd); char drive_cur = path[0]; + cwdLen = useThisCwd->length; if (drive_cur >= 'a') { drive_cur -= ('a' - 'A'); } @@ -3048,7 +3050,7 @@ TclNativeCreateNativeRep( char *nativePathPtr, *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - int len; + size_t len; if (TclFSCwdIsNative()) { /* @@ -3073,7 +3075,8 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = Tcl_GetStringFromObj(validPathPtr, &len); + str = Tcl_GetString(validPathPtr); + len = validPathPtr->length; if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') { char *p; diff --git a/win/tclWinInit.c b/win/tclWinInit.c index f552e2c..e9b5697 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -176,7 +176,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 @@ -218,9 +218,10 @@ TclpInitLibraryPath( TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; - bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); + bytes = Tcl_GetString(pathPtr); + *lengthPtr = pathPtr->length; *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, bytes, (*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -338,7 +339,7 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -365,7 +366,7 @@ InitializeDefaultLibraryDir( *lengthPtr = strlen(name); *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, *lengthPtr + 1); } /* @@ -389,7 +390,7 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -416,7 +417,7 @@ InitializeSourceLibraryDir( *lengthPtr = strlen(name); *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, *lengthPtr + 1); } /* diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index f7ceabc..837f60b 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -2654,8 +2654,7 @@ Tcl_PidObjCmd( if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { - chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), - NULL); + chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } @@ -3107,9 +3106,9 @@ TclpOpenTemporaryFile( } namePtr += length * sizeof(TCHAR); if (basenameObj) { - const char *string = Tcl_GetStringFromObj(basenameObj, &length); + const char *string = Tcl_GetString(basenameObj); - Tcl_WinUtfToTChar(string, length, &buf); + Tcl_WinUtfToTChar(string, basenameObj->length, &buf); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 643bd06..2ce6b83 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -281,7 +281,7 @@ RegistryObjCmd( return TCL_ERROR; } - if (Tcl_GetStringFromObj(objv[n], NULL)[0] == '-') { + if (Tcl_GetString(objv[n])[0] == '-') { if (Tcl_GetIndexFromObjStruct(interp, objv[n++], modes, sizeof(char *), "mode", 0, &index) != TCL_OK) { return TCL_ERROR; @@ -406,7 +406,7 @@ DeleteKey( const TCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; - int length; + size_t length; Tcl_DString buf; REGSAM saveMode = mode; @@ -414,7 +414,8 @@ DeleteKey( * Find the parent of the key being deleted and open it. */ - keyName = Tcl_GetStringFromObj(keyNameObj, &length); + keyName = Tcl_GetString(keyNameObj); + length = keyNameObj->length; buffer = ckalloc(length + 1); strcpy(buffer, keyName); @@ -500,7 +501,7 @@ DeleteValue( { HKEY key; char *valueName; - int length; + size_t length; DWORD result; Tcl_DString ds; @@ -513,15 +514,16 @@ DeleteValue( return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; Tcl_WinUtfToTChar(valueName, length, &ds); result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", - Tcl_GetStringFromObj(valueNameObj, NULL), - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(valueNameObj), + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -569,7 +571,7 @@ GetKeyNames( Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ if (patternObj) { - pattern = Tcl_GetStringFromObj(patternObj, NULL); + pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } @@ -598,7 +600,7 @@ GetKeyNames( } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to enumerate subkeys of \"%s\": ", - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } @@ -656,7 +658,7 @@ GetType( Tcl_DString ds; const char *valueName; const TCHAR *nativeValue; - int length; + size_t length; /* * Attempt to open the key for reading. @@ -671,7 +673,8 @@ GetType( * Get the type of the value. */ - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); @@ -681,8 +684,8 @@ GetType( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get type of value \"%s\" from key \"%s\": ", - Tcl_GetStringFromObj(valueNameObj, NULL), - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(valueNameObj), + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -729,7 +732,7 @@ GetValue( const TCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; - int nameLen; + size_t nameLen; /* * Attempt to open the key for reading. @@ -754,7 +757,8 @@ GetValue( Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; - valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); + valueName = Tcl_GetString(valueNameObj); + nameLen = valueNameObj->length; nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); result = RegQueryValueEx(key, nativeValue, NULL, &type, @@ -776,8 +780,8 @@ GetValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get value \"%s\" from key \"%s\": ", - Tcl_GetStringFromObj(valueNameObj, NULL), - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(valueNameObj), + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -881,7 +885,7 @@ GetValueNames( result = TCL_OK; if (patternObj) { - pattern = Tcl_GetStringFromObj(patternObj, NULL); + pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } @@ -945,11 +949,12 @@ OpenKey( HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; - int length; + size_t length; HKEY rootKey; DWORD result; - keyName = Tcl_GetStringFromObj(keyNameObj, &length); + keyName = Tcl_GetString(keyNameObj); + length = keyNameObj->length; buffer = ckalloc(length + 1); strcpy(buffer, keyName); @@ -1249,7 +1254,8 @@ SetValue( Tcl_Obj *typeObj, /* Type of data to be written. */ REGSAM mode) /* Mode flags to pass. */ { - int type, length; + int type; + size_t length; DWORD result; HKEY key; const char *valueName; @@ -1269,7 +1275,8 @@ SetValue( return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { @@ -1303,8 +1310,9 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - const char *bytes = Tcl_GetStringFromObj(objv[i], &length); + const char *bytes = Tcl_GetString(objv[i]); + length = objv[i]->length; Tcl_DStringAppend(&data, bytes, length); /* @@ -1323,8 +1331,9 @@ SetValue( Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - const char *data = Tcl_GetStringFromObj(dataObj, &length); + const char *data = Tcl_GetString(dataObj); + length = dataObj->length; data = (char *) Tcl_WinUtfToTChar(data, length, &buf); /* @@ -1339,14 +1348,15 @@ SetValue( Tcl_DStringFree(&buf); } else { BYTE *data; + int bytelength; /* * Store binary data in the registry. */ - data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); result = RegSetValueEx(key, (TCHAR *) valueName, 0, - (DWORD) type, data, (DWORD) length); + (DWORD) type, data, (DWORD) bytelength); } Tcl_DStringFree(&nameBuf); @@ -1387,12 +1397,13 @@ BroadcastValue( LRESULT result; DWORD_PTR sendResult; UINT timeout = 3000; - int len; + size_t len; const char *str; Tcl_Obj *objPtr; if (objc == 3) { - str = Tcl_GetStringFromObj(objv[1], &len); + str = Tcl_GetString(objv[1]); + len = objv[1]->length; if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) { return TCL_BREAK; @@ -1402,7 +1413,8 @@ BroadcastValue( } } - str = Tcl_GetStringFromObj(objv[0], &len); + str = Tcl_GetString(objv[0]); + len = objv[0]->length; if (len == 0) { str = NULL; } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 1a74354..f0dfcb8 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2632,7 +2632,7 @@ Tcl_GetHostName(void) void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; @@ -2670,7 +2670,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, Tcl_DStringValue(&ds), (*lengthPtr)+1); Tcl_DStringFree(&ds); } -- cgit v0.12 From 4acf1744683b1dacaf236eeb3fa473030d107c41 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 7 Feb 2013 14:22:16 +0000 Subject: put braces around all macro parameters --- generic/tclDecls.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d7b2324..058e1a9 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3737,8 +3737,8 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, #define Tcl_GlobalEval(interp,objPtr) \ Tcl_EvalEx((interp),(objPtr),-1,TCL_EVAL_GLOBAL) #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ - Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, (int)sizeof(char *), \ - msg, flags, indexPtr) + Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \ + sizeof(char *), (msg), (flags), (indexPtr)) /* * Deprecated Tcl procedures: */ -- cgit v0.12 From abc5015131e70188b9e23ba1e7554cd50ba408bb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Feb 2013 10:25:04 +0000 Subject: more Tcl_NewIntObj/Tcl_NewBooleanObj -> Tcl_NewLongObj conversions --- generic/tclMain.c | 4 ++-- generic/tclOOBasic.c | 2 +- generic/tclOOInfo.c | 22 +++++++++++----------- generic/tclObj.c | 10 +++++----- generic/tclThreadTest.c | 4 ++-- generic/tclTrace.c | 2 +- generic/tclUtil.c | 2 +- generic/tclZlib.c | 6 +++--- macosx/tclMacOSXFCmd.c | 2 +- tools/tsdPerf.c | 2 +- unix/dltest/pkga.c | 2 +- unix/dltest/pkgb.c | 2 +- unix/dltest/pkgc.c | 2 +- unix/dltest/pkgd.c | 2 +- unix/dltest/pkgua.c | 2 +- unix/tclUnixFCmd.c | 6 +++--- unix/tclUnixPipe.c | 4 ++-- win/tclWinDde.c | 2 +- win/tclWinFCmd.c | 2 +- win/tclWinReg.c | 4 ++-- win/tclWinTest.c | 8 ++++---- 21 files changed, 46 insertions(+), 46 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index 1b15617..63e7464 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -362,7 +362,7 @@ Tcl_MainEx( argc--; argv++; - Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewLongObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { @@ -376,7 +376,7 @@ Tcl_MainEx( is.tty = isatty(0); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, - Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); + Tcl_NewLongObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 617be35..5e29512 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1148,7 +1148,7 @@ TclOOSelfObjCmd( } case SELF_CALL: result[0] = TclOORenderCallChain(interp, contextPtr->callPtr); - result[1] = Tcl_NewIntObj(contextPtr->index); + result[1] = Tcl_NewLongObj(contextPtr->index); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 3217f98..cbf49d3 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -197,11 +197,11 @@ InfoObjectClassCmd( FOREACH(mixinPtr, oPtr->mixins) { if (TclOOIsReachable(o2clsPtr, mixinPtr)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); return TCL_OK; } } - Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_SetObjResult(interp, Tcl_NewLongObj( TclOOIsReachable(o2clsPtr, oPtr->selfCls))); return TCL_OK; } @@ -418,7 +418,7 @@ InfoObjectIsACmd( if (!ok) { Tcl_ResetResult(interp); } - Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(ok!=0)); return TCL_OK; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); @@ -432,7 +432,7 @@ InfoObjectIsACmd( Tcl_WrongNumArgs(interp, 2, objv, "objName"); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(oPtr->classPtr!=NULL)); return TCL_OK; case IsMetaclass: if (objc != 3) { @@ -440,12 +440,12 @@ InfoObjectIsACmd( return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } else { Class *classCls = TclOOGetFoundation(interp)->classCls; - Tcl_SetObjResult(interp, Tcl_NewIntObj( - TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj( + TclOOIsReachable(classCls, oPtr->classPtr)!=0)); } return TCL_OK; case IsMixin: @@ -467,12 +467,12 @@ InfoObjectIsACmd( FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr == o2Ptr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); return TCL_OK; } } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; case IsType: if (objc != 4) { @@ -490,9 +490,9 @@ InfoObjectIsACmd( return TCL_ERROR; } if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } return TCL_OK; case IsObject: diff --git a/generic/tclObj.c b/generic/tclObj.c index 5c8ff47..bf98b35 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2396,11 +2396,11 @@ Tcl_NewLongObj( * Tcl_DbNewLongObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer - * objects end up calling the debugging function Tcl_DbNewLongObj - * instead. We provide two implementations of Tcl_DbNewLongObj so that - * whether the Tcl core is compiled to do memory debugging of the core is - * independent of whether a client requests debugging for itself. + * Tcl_NewLongObj to create new long integer objects end up calling the + * debugging function Tcl_DbNewLongObj instead. We provide two + * implementations of Tcl_DbNewLongObj so that whether the Tcl core is + * compiled to do memory debugging of the core is independent of whether + * a client requests debugging for itself. * * When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj * calls Tcl_DbCkalloc directly with the file name and line number from diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index d76a4f3..ccf5101 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -368,7 +368,7 @@ ThreadObjCmd( result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), status); + Tcl_SetLongObj(Tcl_GetObjResult(interp), status); } else { char buf[20]; @@ -415,7 +415,7 @@ ThreadObjCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_SetObjResult(interp, Tcl_NewLongObj( Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT))); return TCL_OK; } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 82d652c..cdebe03 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1845,7 +1845,7 @@ TraceExecutionProc( * Append result code. */ - resultCode = Tcl_NewIntObj(code); + resultCode = Tcl_NewLongObj(code); resultCodeStr = Tcl_GetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 54bca25..bcfdc2a 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3128,7 +3128,7 @@ TclPrecTraceProc( if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr!=0), + Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr), flags & TCL_GLOBAL_ONLY); return NULL; } diff --git a/generic/tclZlib.c b/generic/tclZlib.c index aa57d40..93e5af4 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -545,7 +545,7 @@ ExtractHeader( &tmp); SetValue(dictObj, "comment", TclDStringToObj(&tmp)); } - SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); + SetValue(dictObj, "crc", Tcl_NewLongObj(headerPtr->hcrc!=0)); if (headerPtr->name != Z_NULL) { if (latin1enc == NULL) { /* @@ -563,7 +563,7 @@ ExtractHeader( SetValue(dictObj, "filename", TclDStringToObj(&tmp)); } if (headerPtr->os != 255) { - SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os)); + SetValue(dictObj, "os", Tcl_NewLongObj(headerPtr->os)); } if (headerPtr->time != 0 /* magic - no time */) { SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time)); @@ -2581,7 +2581,7 @@ ZlibStreamCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_ZlibStreamEof(zstream))); return TCL_OK; case zs_checksum: /* $strm checksum */ if (objc != 2) { diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 8ecfd0b..d16f33f 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -192,7 +192,7 @@ TclMacOSXGetFileAttribute( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: - *attributePtrPtr = Tcl_NewBooleanObj( + *attributePtrPtr = Tcl_NewLongObj( (finder->fdFlags & kFinfoIsInvisible) != 0); break; case MACOSX_RSRCLENGTH_ATTRIBUTE: diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c index 40004b1..e1ac552 100644 --- a/tools/tsdPerf.c +++ b/tools/tsdPerf.c @@ -33,7 +33,7 @@ tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); - Tcl_SetObjResult(interp, Tcl_NewIntObj(perf->value)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(perf->value)); return TCL_OK; } diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index afa346a..d21ef95 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -62,7 +62,7 @@ Pkga_EqObjCmd( } else { result = 0; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; } diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index b32092c..591e225 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -65,7 +65,7 @@ Pkgb_SubObjCmd( Tcl_AppendResult(interp, " in line: ", buf, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second)); return TCL_OK; } diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index c76c2d2..a1d9ba0 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -56,7 +56,7 @@ Pkgc_SubObjCmd( || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second)); return TCL_OK; } diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index ae9ff93..3718dfb 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -56,7 +56,7 @@ Pkgd_SubObjCmd( || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second)); return TCL_OK; } diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index b92b320..a320bce 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -138,7 +138,7 @@ PkguaEqObjCmd( } else { result = 0; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; } diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index d9952b9..3c6d3f9 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1338,7 +1338,7 @@ GetGroupAttribute( groupPtr = TclpGetGrGid(statBuf.st_gid); if (groupPtr == NULL) { - *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); + *attributePtrPtr = Tcl_NewLongObj((long) statBuf.st_gid); } else { Tcl_DString ds; const char *utf; @@ -1392,7 +1392,7 @@ GetOwnerAttribute( pwPtr = TclpGetPwUid(statBuf.st_uid); if (pwPtr == NULL) { - *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); + *attributePtrPtr = Tcl_NewLongObj((long) statBuf.st_uid); } else { Tcl_DString ds; @@ -2283,7 +2283,7 @@ GetReadOnlyAttribute( return TCL_ERROR; } - *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE); + *attributePtrPtr = Tcl_NewLongObj((statBuf.st_flags&UF_IMMUTABLE)!=0); return TCL_OK; } diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index ce73751..ac9ba77 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -870,7 +870,7 @@ TclGetAndDetachPids( pipePtr = Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj( + Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewLongObj( PTR2INT(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } @@ -1288,7 +1288,7 @@ Tcl_PidObjCmd( resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); + Tcl_NewLongObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); } Tcl_SetObjResult(interp, resultPtr); } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 013b320..10876ed 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -568,7 +568,7 @@ ExecuteRemoteObject( returnPackagePtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, returnPackagePtr, - Tcl_NewIntObj(result)); + Tcl_NewLongObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index ac88861..db5ed9e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1607,7 +1607,7 @@ GetWinFileAttributes( } } - *attributePtrPtr = Tcl_NewBooleanObj(attr); + *attributePtrPtr = Tcl_NewLongObj(attr!=0); return TCL_OK; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 643bd06..15ca183 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -693,7 +693,7 @@ GetType( */ if (type > lastType) { - Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); + Tcl_SetObjResult(interp, Tcl_NewLongObj((int) type)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); } @@ -791,7 +791,7 @@ GetValue( */ if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { - Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, + Tcl_SetObjResult(interp, Tcl_NewLongObj((long) ConvertDWORD(type, *((DWORD *) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); diff --git a/win/tclWinTest.c b/win/tclWinTest.c index e046bd3..17b76b8 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -277,11 +277,11 @@ TestwinclockCmd( result = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, result, - Tcl_NewIntObj((int) (t2.QuadPart / 10000000))); + Tcl_NewLongObj((int) (t2.QuadPart / 10000000))); Tcl_ListObjAppendElement(interp, result, - Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000))); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec)); + Tcl_NewLongObj((int) ((t2.QuadPart / 10) % 1000000))); + Tcl_ListObjAppendElement(interp, result, Tcl_NewLongObj(tclTime.sec)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewLongObj(tclTime.usec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart)); -- cgit v0.12 From 7e01d5f28f929d74ccbd3716ab4ebcb5a50431bc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2013 14:38:18 +0000 Subject: Eliminate some usage of VOID and its variants. Remove unnecessary #undef's --- generic/regc_lex.c | 8 ++++---- generic/regc_locale.c | 2 +- generic/regc_nfa.c | 4 ++-- generic/regcomp.c | 14 +++++++------- generic/regcustom.h | 11 +++-------- generic/regex.h | 18 ++---------------- generic/regexec.c | 4 ++-- generic/regguts.h | 34 ++++------------------------------ generic/tclBasic.c | 1 - generic/tclDecls.h | 3 --- generic/tclIntDecls.h | 3 --- 11 files changed, 25 insertions(+), 77 deletions(-) diff --git a/generic/regc_lex.c b/generic/regc_lex.c index 132e757..70a0246 100644 --- a/generic/regc_lex.c +++ b/generic/regc_lex.c @@ -444,7 +444,7 @@ next( if (ATEOS()) { FAILW(REG_EESCAPE); } - (DISCARD)lexescape(v); + (void)lexescape(v); switch (v->nexttype) { /* not all escapes okay here */ case PLAIN: return 1; @@ -703,7 +703,7 @@ next( } RETV(PLAIN, *v->now++); } - (DISCARD)lexescape(v); + (void)lexescape(v); if (ISERR()) { FAILW(REG_EESCAPE); } @@ -1130,7 +1130,7 @@ skip( /* - newline - return the chr for a newline * This helps confine use of CHR to this source file. - ^ static chr newline(NOPARMS); + ^ static chr newline(void); */ static chr newline(void) @@ -1143,7 +1143,7 @@ newline(void) * This helps confine use of CHR to this source file. Beware that the caller * knows how long the sequence is. ^ #ifdef REG_DEBUG - ^ static const chr *ch(NOPARMS); + ^ static const chr *ch(void); ^ #endif */ #ifdef REG_DEBUG diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 7d15f8b..29341d7 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -1168,7 +1168,7 @@ cmp( const chr *x, const chr *y, /* strings to compare */ size_t len) /* exact length of comparison */ { - return memcmp(VS(x), VS(y), len*sizeof(chr)); + return memcmp((void*)(x), (void*)(y), len*sizeof(chr)); } /* diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index fc0c823..e36c5d2 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -617,7 +617,7 @@ moveins( /* - copyins - copy in arcs of a state to another state * Either all arcs, or only non-empty ones as determined by all value. - ^ static VOID copyins(struct nfa *, struct state *, struct state *, int); + ^ static void copyins(struct nfa *, struct state *, struct state *, int); */ static void copyins( @@ -660,7 +660,7 @@ moveouts( /* - copyouts - copy out arcs of a state to another state * Either all arcs, or only non-empty ones as determined by all value. - ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int); + ^ static void copyouts(struct nfa *, struct state *, struct state *, int); */ static void copyouts( diff --git a/generic/regcomp.c b/generic/regcomp.c index c93eb24..9d115f9 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -82,9 +82,9 @@ static int lexescape(struct vars *); static int lexdigits(struct vars *, int, int, int); static int brenext(struct vars *, pchr); static void skip(struct vars *); -static chr newline(NOPARMS); +static chr newline(void); #ifdef REG_DEBUG -static const chr *ch(NOPARMS); +static const chr *ch(void); #endif static chr chrnamed(struct vars *, const chr *, const chr *, pchr); /* === regc_color.c === */ @@ -328,13 +328,13 @@ compile( re->re_info = 0; /* bits get set during parse */ re->re_csize = sizeof(chr); re->re_guts = NULL; - re->re_fns = VS(&functions); + re->re_fns = (void*)(&functions); /* * More complex setup, malloced things. */ - re->re_guts = VS(MALLOC(sizeof(struct guts))); + re->re_guts = (void*)(MALLOC(sizeof(struct guts))); if (re->re_guts == NULL) { return freev(v, REG_ESPACE); } @@ -421,7 +421,7 @@ compile( * Can sacrifice main NFA now, so use it as work area. */ - (DISCARD) optimize(v->nfa, debug); + (void) optimize(v->nfa, debug); CNOERR(); makesearch(v, v->nfa); CNOERR(); @@ -1874,10 +1874,10 @@ nfatree( assert(t != NULL && t->begin != NULL); if (t->left != NULL) { - (DISCARD) nfatree(v, t->left, f); + (void) nfatree(v, t->left, f); } if (t->right != NULL) { - (DISCARD) nfatree(v, t->right, f); + (void) nfatree(v, t->right, f); } return nfanode(v, t, f); diff --git a/generic/regcustom.h b/generic/regcustom.h index 309203a..647b423 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -36,10 +36,9 @@ * Overrides for regguts.h definitions, if any. */ -#define FUNCPTR(name, args) (*name)args -#define MALLOC(n) VS(attemptckalloc(n)) -#define FREE(p) ckfree(VS(p)) -#define REALLOC(p,n) VS(attemptckrealloc(VS(p),n)) +#define MALLOC(n) ((void*)(attemptckalloc(n))) +#define FREE(p) ckfree((void*)(p)) +#define REALLOC(p,n) ((void*)(attemptckrealloc((void*)(p),n))) /* * Do not insert extras between the "begin" and "end" lines - this chunk is @@ -60,9 +59,6 @@ #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif -#ifdef __REG_VOID_T -#undef __REG_VOID_T -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -72,7 +68,6 @@ /* Interface types */ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* Not really right, but good enough... */ -#define __REG_VOID_T void /* Names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec diff --git a/generic/regex.h b/generic/regex.h index d09857c..ad2ce5d 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -92,9 +92,6 @@ extern "C" { #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif -#ifdef __REG_VOID_T -#undef __REG_VOID_T -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -104,7 +101,6 @@ extern "C" { /* interface types */ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* not really right, but good enough... */ -#define __REG_VOID_T void /* names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec @@ -130,16 +126,6 @@ typedef long regoff_t; #endif /* - * For benefit of old compilers, we offer the option of - * overriding the `void' type used to declare nonexistent return types. - */ -#ifdef __REG_VOID_T -typedef __REG_VOID_T re_void; -#else -typedef void re_void; -#endif - -/* * other interface types */ @@ -234,7 +220,7 @@ typedef struct { /* * misc generics (may be more functions here eventually) - ^ re_void regfree(regex_t *); + ^ void regfree(regex_t *); */ /* @@ -295,7 +281,7 @@ int regexec(regex_t *, const char *, size_t, regmatch_t [], int); #ifdef __REG_WIDE_T MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif -MODULE_SCOPE re_void regfree(regex_t *); +MODULE_SCOPE void regfree(regex_t *); MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ diff --git a/generic/regexec.c b/generic/regexec.c index 9b6a693..9e6b04e 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -44,7 +44,7 @@ struct sset { /* state set */ unsigned hash; /* hash of bitvector */ #define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw)) #define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \ - memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0)) + memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0)) int flags; #define STARTER 01 /* the initial state set */ #define POSTSTATE 02 /* includes the goal state */ @@ -276,7 +276,7 @@ exec( if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) { zapSubexpressions(pmatch, nmatch); n = (nmatch < v->nmatch) ? nmatch : v->nmatch; - memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t)); + memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t)); } /* diff --git a/generic/regguts.h b/generic/regguts.h index 67f9625..b877087 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -49,41 +49,15 @@ #include #endif -/* voids */ -#ifndef VOID -#define VOID void /* for function return values */ -#endif -#ifndef DISCARD -#define DISCARD void /* for throwing values away */ -#endif -#ifndef PVOID -#define PVOID void * /* generic pointer */ -#endif -#ifndef VS -#define VS(x) ((void*)(x)) /* cast something to generic ptr */ -#endif -#ifndef NOPARMS -#define NOPARMS void /* for empty parm lists */ -#endif - -/* function-pointer declarator */ -#ifndef FUNCPTR -#if __STDC__ >= 1 -#define FUNCPTR(name, args) (*name)args -#else -#define FUNCPTR(name, args) (*name)() -#endif -#endif - /* memory allocation */ #ifndef MALLOC #define MALLOC(n) malloc(n) #endif #ifndef REALLOC -#define REALLOC(p, n) realloc(VS(p), n) +#define REALLOC(p, n) realloc((void*)(p), n) #endif #ifndef FREE -#define FREE(p) free(VS(p)) +#define FREE(p) free((void*)(p)) #endif /* want size of a char in bits, and max value in bounded quantifiers */ @@ -366,7 +340,7 @@ struct subre { */ struct fns { - void FUNCPTR(free, (regex_t *)); + void (*free)(regex_t *); }; /* @@ -383,7 +357,7 @@ struct guts { struct cnfa search; /* for fast preliminary search */ int ntree; struct colormap cmap; - int FUNCPTR(compare, (const chr *, const chr *, size_t)); + int (*compare) (const chr *, const chr *, size_t); struct subre *lacons; /* lookahead-constraint vector */ int nlacons; /* size of lacons */ }; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 185a109..d31777e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6195,7 +6195,6 @@ Tcl_ExprString( *---------------------------------------------------------------------- */ -#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ea2468c..e263634 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3728,9 +3728,6 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) -#undef Tcl_SeekOld -#undef Tcl_TellOld - /* * Deprecated Tcl procedures: */ diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index d442211..26b168f 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -1209,7 +1209,4 @@ extern const TclIntStubs *tclIntStubsPtr; /* !END!: Do not edit above this line. */ -#undef TclCopyChannelOld -#undef TclSockMinimumBuffersOld - #endif /* _TCLINTDECLS */ -- cgit v0.12 From eecece2afea26aec8b61ab04a7887c203257e82a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 25 Mar 2013 15:00:55 +0000 Subject: TCL_INIT_ENCODINGPATH --- generic/tcl.h | 1 + generic/tclEncoding.c | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/generic/tcl.h b/generic/tcl.h index e89dff8..eda9eb9 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2412,6 +2412,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, /* Tcl_InitSubsystems, see TIP 414 */ #define TCL_INIT_PANIC (1) /* Set Panic proc */ +#define TCL_INIT_ENCODINGPATH (2) /* Set encoding path */ #define TCL_INIT_CREATE (48) /* Call Tcl_CreateInterp(), and set argc/argv */ #define TCL_INIT_CREATE_UNICODE (16) /* The same, but argv is in unicode */ #define TCL_INIT_CREATE_UTF8 (32) /* The same, but argv is in utf-8 */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index dbe747b..dfcca14 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1448,11 +1448,15 @@ Tcl_InitSubsystems(int flags, ...) va_list argList; int argc = 0; void **argv = NULL; + const char *encodingpath = NULL; va_start(argList, flags); if (flags & TCL_INIT_PANIC) { Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *)); } + if (flags & TCL_INIT_ENCODINGPATH) { + encodingpath = va_arg(argList, const char *); + } if (flags & TCL_INIT_CREATE) { argc = va_arg(argList, int); argv = va_arg(argList, void **); @@ -1460,6 +1464,9 @@ Tcl_InitSubsystems(int flags, ...) va_end(argList); TclInitSubsystems(); + if(encodingpath) { + Tcl_SetEncodingSearchPath(Tcl_NewStringObj(encodingpath, -1)); + } TclpSetInitialEncodings(); TclpFindExecutable(argv ? argv[0] : NULL); if (flags & TCL_INIT_CREATE) { -- cgit v0.12 From d048128004c027a3ee8e8d4fab19039a3bb358e2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Mar 2013 10:20:03 +0000 Subject: Version having TCL_INIT_PANIC as only Tcl_InitSubsystems() flag --- doc/InitSubSyst.3 | 31 ++----------------------------- generic/tcl.h | 6 +----- generic/tclEncoding.c | 44 +------------------------------------------- 3 files changed, 4 insertions(+), 77 deletions(-) diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3 index c23f2a3..0125912 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -18,8 +18,8 @@ Tcl_Interp * .SH ARGUMENTS .AS int flags .AP int flags in -Any combination of flags which indicate whether a custom panicProc -is registered and/or a real interpreter is created. +Any combination of flags which might modify the initialization sequence. +At this moment, only 0 and \fBTCL_INIT_PANIC\fR are supported. The value 0 can be used if Tcl is used as utility library only. .BE @@ -74,33 +74,6 @@ could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR, but then panics which could be produced by the initialization itself still use the default panic procedure. .PP -If you supply one of the flags \fBTCL_INIT_CREATE\fR, \fBTCL_INIT_CREATE_UTF8\fR or -\fBTCL_INIT_CREATE_UNICODE\fR to \fBTcl_InitSubsystems\fR, the function -gets two additional parameters, argc and argv. Then a real -Tcl interpreter will be created. If argc > 0 then the variables -\fBargc\fR and \fBargv\fR will be set in this interpreter. The 3 -variants assume a different encoding for the arguments, except for -\fIargv[0]\fR which is always assumed to be in the system encoding. -So, the above example code could be simplified to: -.CS -Tcl_Interp *interp = Tcl_InitSubSystems(TCL_INIT_CREATE, 0, NULL); -Tcl_InitStubs(interp, TCL_VERSION, 0); /* initialize the stub table */ -.CE -.PP -If the \fBTCL_INIT_PANIC\fR and one of the \fBTCL_INIT_CREATE\fR -flags are used in combination, the \fBpanicProc\fR argument comes -before the argc/argv arguments. -.PP -The reason for \fBargv[0]\fR always using the system encoding is that this way, -argv[0] can be derived directly from the main() (or mainw, on Windows) -arguments without any processing. \fBTCL_INIT_CREATE_UNICODE\fR is really only -useful on Windows. But on Windows, the argv[0] parameter is not used for -determining the value of [info executable] anyway. Modern UNIX system already -have UTF-8 as system encoding, so \fBTCL_INIT_CREATE_UTF8\fR would have the same -effect as \fBTCL_INIT_CREATE\fR, only slightly faster. Other parameters can be -preprocessed at will by the application, and if the application uses unicode -or UTF-8 internally there is no need to convert it back to the system encoding. -.PP The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to any other function than Tcl_InitStubs(). Tcl functions with an "interp" argument can only be called if the function supports passing NULL. diff --git a/generic/tcl.h b/generic/tcl.h index eda9eb9..4049c8a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2409,13 +2409,9 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, * TODO - tommath stubs export goes here! */ -/* Tcl_InitSubsystems, see TIP 414 */ +/* Tcl_InitSubsystems, see TIP #414 */ #define TCL_INIT_PANIC (1) /* Set Panic proc */ -#define TCL_INIT_ENCODINGPATH (2) /* Set encoding path */ -#define TCL_INIT_CREATE (48) /* Call Tcl_CreateInterp(), and set argc/argv */ -#define TCL_INIT_CREATE_UNICODE (16) /* The same, but argv is in unicode */ -#define TCL_INIT_CREATE_UTF8 (32) /* The same, but argv is in utf-8 */ EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...); diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index dfcca14..0ffc481 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1446,58 +1446,16 @@ Tcl_Interp * Tcl_InitSubsystems(int flags, ...) { va_list argList; - int argc = 0; - void **argv = NULL; - const char *encodingpath = NULL; va_start(argList, flags); if (flags & TCL_INIT_PANIC) { Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *)); } - if (flags & TCL_INIT_ENCODINGPATH) { - encodingpath = va_arg(argList, const char *); - } - if (flags & TCL_INIT_CREATE) { - argc = va_arg(argList, int); - argv = va_arg(argList, void **); - } va_end(argList); TclInitSubsystems(); - if(encodingpath) { - Tcl_SetEncodingSearchPath(Tcl_NewStringObj(encodingpath, -1)); - } TclpSetInitialEncodings(); - TclpFindExecutable(argv ? argv[0] : NULL); - if (flags & TCL_INIT_CREATE) { - Tcl_Interp *interp = Tcl_CreateInterp(); - if (--argc >= 0) { - Tcl_Obj *argvPtr; - - Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); - argvPtr = Tcl_NewListObj(argc, NULL); - if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UTF8) { - while (argc--) { - Tcl_ListObjAppendElement(NULL, argvPtr, - Tcl_NewStringObj(*++argv, -1)); - } - } else if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UNICODE) { - while (argc--) { - Tcl_ListObjAppendElement(NULL, argvPtr, - Tcl_NewUnicodeObj(*++argv, -1)); - } - } else { - Tcl_DString ds; - - while (argc--) { - Tcl_ExternalToUtfDString(NULL, *++argv, -1, &ds); - Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds)); - } - } - Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); - } - return interp; - } + TclpFindExecutable(NULL); return (Tcl_Interp *) &dummyInterp; } -- cgit v0.12 From bb770e33f8e270fc105aa9807a61bec5ac171771 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Mar 2013 13:58:53 +0000 Subject: Add TCL_INIT_STUFF --- doc/InitSubSyst.3 | 8 +++++++- generic/tcl.h | 1 + generic/tclEncoding.c | 7 ++++++- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3 index 0125912..4a3dc64 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -19,7 +19,8 @@ Tcl_Interp * .AS int flags .AP int flags in Any combination of flags which might modify the initialization sequence. -At this moment, only 0 and \fBTCL_INIT_PANIC\fR are supported. +At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_STUFF\fR +(or a combination) are supported. The value 0 can be used if Tcl is used as utility library only. .BE @@ -74,6 +75,11 @@ could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR, but then panics which could be produced by the initialization itself still use the default panic procedure. .PP +If you supply the flag \fBTCL_INIT_STUFF\fR to \fBTcl_InitSubsystems\fR, +the function expects two additional arguments: ClientData and a +custom proc with has ClientData as its only argument. The given +function will be executed just before the encodings are initialized. +.PP The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to any other function than Tcl_InitStubs(). Tcl functions with an "interp" argument can only be called if the function supports passing NULL. diff --git a/generic/tcl.h b/generic/tcl.h index 4049c8a..9325bf2 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2412,6 +2412,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, /* Tcl_InitSubsystems, see TIP #414 */ #define TCL_INIT_PANIC (1) /* Set Panic proc */ +#define TCL_INIT_STUFF (2) /* Do any stuff before initializing the encoding */ EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...); diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0ffc481..753222f 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1451,9 +1451,14 @@ Tcl_InitSubsystems(int flags, ...) if (flags & TCL_INIT_PANIC) { Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *)); } + TclInitSubsystems(); + if (flags & TCL_INIT_STUFF) { + ClientData clientData = va_arg(argList, ClientData); + void (*fn)() = va_arg(argList, void (*)(ClientData)); + fn(clientData); + } va_end(argList); - TclInitSubsystems(); TclpSetInitialEncodings(); TclpFindExecutable(NULL); return (Tcl_Interp *) &dummyInterp; -- cgit v0.12 From e4a0b9dbfd9e5e1261ed40444a27f64feac2833b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Mar 2013 15:57:45 +0000 Subject: Looks like TCL_INIT_CUSTOM (previously known as TCL_INIT_STUFF) is not a bad idea at all, provided it has a Tcl_Interp* argument as well, so it can initialize the stub table. A typedef for the function is not necessary, as a variable-argument function doesn't do any type checking. It's for the experienced developer anyway. --- doc/InitSubSyst.3 | 16 +++++++++------- generic/tcl.h | 2 +- generic/tclEncoding.c | 10 ++++++---- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3 index 4a3dc64..db3951e 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -19,7 +19,7 @@ Tcl_Interp * .AS int flags .AP int flags in Any combination of flags which might modify the initialization sequence. -At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_STUFF\fR +At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_CUSTOM\fR (or a combination) are supported. The value 0 can be used if Tcl is used as utility library only. .BE @@ -75,13 +75,15 @@ could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR, but then panics which could be produced by the initialization itself still use the default panic procedure. .PP -If you supply the flag \fBTCL_INIT_STUFF\fR to \fBTcl_InitSubsystems\fR, +If you supply the flag \fBTCL_INIT_CUSTOM\fR to \fBTcl_InitSubsystems\fR, the function expects two additional arguments: ClientData and a -custom proc with has ClientData as its only argument. The given -function will be executed just before the encodings are initialized. +custom proc. The proc will be supplied two arguments, the (pseudo) +Tcl interpreter and ClientData. The given function will be executed +just before the encodings are initialized. .PP -The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to -any other function than Tcl_InitStubs(). Tcl functions with an "interp" -argument can only be called if the function supports passing NULL. +The interpreter returned by Tcl_InitSubsystems(0) or passed to the +TCL_INIT_CUSTOM function cannot be passed to any other function than +Tcl_InitStubs(). Tcl functions with an "interp" argument can only +be called if the function supports passing NULL. .SH KEYWORDS binary, executable file diff --git a/generic/tcl.h b/generic/tcl.h index 9325bf2..522171e 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2412,7 +2412,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, /* Tcl_InitSubsystems, see TIP #414 */ #define TCL_INIT_PANIC (1) /* Set Panic proc */ -#define TCL_INIT_STUFF (2) /* Do any stuff before initializing the encoding */ +#define TCL_INIT_CUSTOM (2) /* Do any stuff before initializing the encoding */ EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...); diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 753222f..9905eaa 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1446,22 +1446,24 @@ Tcl_Interp * Tcl_InitSubsystems(int flags, ...) { va_list argList; + Tcl_Interp *interp = (Tcl_Interp *) &dummyInterp; va_start(argList, flags); if (flags & TCL_INIT_PANIC) { Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *)); } TclInitSubsystems(); - if (flags & TCL_INIT_STUFF) { + if (flags & TCL_INIT_CUSTOM) { ClientData clientData = va_arg(argList, ClientData); - void (*fn)() = va_arg(argList, void (*)(ClientData)); - fn(clientData); + void (*fn)(Tcl_Interp *, ClientData) = va_arg(argList, + void (*)(Tcl_Interp *, ClientData)); + fn(interp, clientData); } va_end(argList); TclpSetInitialEncodings(); TclpFindExecutable(NULL); - return (Tcl_Interp *) &dummyInterp; + return interp; } void -- cgit v0.12 From 6d0db57c023c72893e0a7221030126a4ec637b3c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 30 Mar 2013 21:44:39 +0000 Subject: Better Windows console panic proc, still to be TIPped. --- generic/tcl.h | 8 +++++- generic/tclPanic.c | 16 +++-------- win/Makefile.in | 6 +++- win/makefile.bc | 6 +++- win/makefile.vc | 6 +++- win/tcl.dsp | 4 +++ win/tclWinPanic.c | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 114 insertions(+), 16 deletions(-) create mode 100644 win/tclWinPanic.c diff --git a/generic/tcl.h b/generic/tcl.h index 4de18f0..73229b1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2395,6 +2395,11 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); +#ifdef _WIN32 +void Tcl_ConsolePanic(const char *format, ...); +#else +#define Tcl_ConsolePanic NULL +#endif /* * When not using stubs, make it a macro. @@ -2415,7 +2420,8 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) + (Tcl_SetPanicProc(Tcl_ConsolePanic), \ + Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, diff --git a/generic/tclPanic.c b/generic/tclPanic.c index b87a8df..a95b9c9 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -23,11 +23,7 @@ * procedure. */ -#if defined(__CYGWIN__) -static Tcl_PanicProc *panicProc = tclWinDebugPanic; -#else static Tcl_PanicProc *panicProc = NULL; -#endif /* *---------------------------------------------------------------------- @@ -49,10 +45,6 @@ void Tcl_SetPanicProc( Tcl_PanicProc *proc) { -#if defined(_WIN32) - /* tclWinDebugPanic only installs if there is no panicProc yet. */ - if ((proc != tclWinDebugPanic) || (panicProc == NULL)) -#endif panicProc = proc; } @@ -93,15 +85,15 @@ Tcl_PanicVA( if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#ifdef _WIN32 - } else if (IsDebuggerPresent()) { - tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#endif } else { +#if defined(_WIN32) || defined(__CYGWIN__) + tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +#else fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); fprintf(stderr, "\n"); fflush(stderr); +#endif #if defined(_WIN32) || defined(__CYGWIN__) # if defined(__GNUC__) __builtin_trap(); diff --git a/win/Makefile.in b/win/Makefile.in index 99009b9..2942da4 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -384,7 +384,8 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ - tclOOStubLib.$(OBJEXT) + tclOOStubLib.$(OBJEXT) \ + tclWinPanic.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) @@ -519,6 +520,9 @@ tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c tclOOStubLib.${OBJEXT}: tclOOStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) +tclWinPanic.${OBJEXT}: tclWinPanic.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + # Implicit rule for all object files that will end up in the Tcl library %.${OBJEXT}: %.c diff --git a/win/makefile.bc b/win/makefile.bc index 18bfa28..b5f388c 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -278,7 +278,8 @@ TCLOBJS = \ TCLSTUBOBJS = \ $(TMPDIR)\tclStubLib.obj \ $(TMPDIR)\tclTomMathStubLib.obj \ - $(TMPDIR)\tclOOStubLib.obj + $(TMPDIR)\tclOOStubLib.obj \ + $(TMPDIR)\tclWinPanic.obj WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic @@ -532,6 +533,9 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? +$(TMPDIR)\tclWinPanic.obj : $(GENERICDIR)\tclWinPanic.c + $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? + # Dedependency rules diff --git a/win/makefile.vc b/win/makefile.vc index 2784140..e4f064e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -449,7 +449,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ - $(TMP_DIR)\tclOOStubLib.obj + $(TMP_DIR)\tclOOStubLib.obj \ + $(TMP_DIR)\tclWinPanic.obj ### The following paths CANNOT have spaces in them. COMPATDIR = $(ROOT)\compat @@ -983,6 +984,9 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? +$(TMP_DIR)\tclWinPanic.obj: $(GENERICDIR)\tclWinPanic.c + $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? + #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a diff --git a/win/tcl.dsp b/win/tcl.dsp index 57ec6bf..5880d09 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1304,6 +1304,10 @@ SOURCE=..\generic\tclOOStubLib.c # End Source File # Begin Source File +SOURCE=..\generic\tclWinPanic.c +# End Source File +# Begin Source File + SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c new file mode 100644 index 0000000..266625c --- /dev/null +++ b/win/tclWinPanic.c @@ -0,0 +1,84 @@ +/* + * tclWinPanic.c -- + * + * Contains the Windows-specific command-line panic proc. + * + * Copyright (c) 2013 by Jan Nijtmans. + * All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" + +/* + *---------------------------------------------------------------------- + * + * Tcl_ConsolePanic -- + * + * Display a message. If a debugger is present, present it directly to + * the debugger, otherwise send it to stderr. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_ConsolePanic( + const char *format, ...) +{ +#define TCL_MAX_WARN_LEN 1024 + DWORD dummy; + va_list argList; + WCHAR msgString[TCL_MAX_WARN_LEN]; + char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; + HANDLE handle = GetStdHandle(STD_ERROR_HANDLE); + + va_start(argList, format); + _vsnprintf(buf+3, sizeof(buf)-3, format, argList); + buf[sizeof(buf)-1] = 0; + msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN); + + /* + * Truncate MessageBox string if it is too long to not overflow the buffer. + */ + + if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + } + + if (IsDebuggerPresent()) { + OutputDebugStringW(msgString); + } else if (_isatty(2)) { + WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); + } else { + buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */ + WriteFile(handle, buf, strlen(buf), &dummy, 0); + FlushFileBuffers(handle); + } +#if defined(__GNUC__) + __builtin_trap(); +#elif defined(_WIN64) + __debugbreak(); +#elif defined(_MSC_VER) + _asm {int 3} +#else + DebugBreak(); +#endif + ExitProcess(1); +} +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * End: + */ -- cgit v0.12 From 260c2634b9c296b79c7c6adc8326214233e38d87 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 31 Mar 2013 19:32:57 +0000 Subject: better leave tclPanic.c as it was --- generic/tcl.h | 7 ++++++- generic/tclPanic.c | 16 ++++++++++++---- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 73229b1..70fee83 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2419,9 +2419,14 @@ void Tcl_ConsolePanic(const char *format, ...); * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ +#ifdef _WIN32 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ (Tcl_SetPanicProc(Tcl_ConsolePanic), \ - Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) + Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) +#else +#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ + (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) +#endif EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, diff --git a/generic/tclPanic.c b/generic/tclPanic.c index a95b9c9..b87a8df 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -23,7 +23,11 @@ * procedure. */ +#if defined(__CYGWIN__) +static Tcl_PanicProc *panicProc = tclWinDebugPanic; +#else static Tcl_PanicProc *panicProc = NULL; +#endif /* *---------------------------------------------------------------------- @@ -45,6 +49,10 @@ void Tcl_SetPanicProc( Tcl_PanicProc *proc) { +#if defined(_WIN32) + /* tclWinDebugPanic only installs if there is no panicProc yet. */ + if ((proc != tclWinDebugPanic) || (panicProc == NULL)) +#endif panicProc = proc; } @@ -85,15 +93,15 @@ Tcl_PanicVA( if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); - } else { -#if defined(_WIN32) || defined(__CYGWIN__) +#ifdef _WIN32 + } else if (IsDebuggerPresent()) { tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#else +#endif + } else { fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); fprintf(stderr, "\n"); fflush(stderr); -#endif #if defined(_WIN32) || defined(__CYGWIN__) # if defined(__GNUC__) __builtin_trap(); -- cgit v0.12 From a58db736cfe4a984cd83ab93d38da09d21fb418f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 31 Mar 2013 20:27:33 +0000 Subject: Fix Tcl_Main macro --- doc/InitStubs.3 | 4 ---- generic/tcl.h | 2 +- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 8188b0b..4dc62c6 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -83,10 +83,6 @@ non-zero means that only the specified \fIversion\fR is acceptable. \fBTcl_InitStubs\fR returns a string containing the actual version of Tcl satisfying the request, or NULL if the Tcl version is not acceptable, does not support stubs, or any other error condition occurred. -.PP -If \fBTcl_InitStubs\fR is called with as first argument the -pseudo interpreter returned by \fBTcl_InitSubsystems(0)\fR, then -the \fIversion\fR and \fIexact\fR parameters have no effect. .SH "SEE ALSO" Tk_InitStubs .SH KEYWORDS diff --git a/generic/tcl.h b/generic/tcl.h index 451c6cc..4acc39d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2432,7 +2432,7 @@ EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc); */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - (Tcl_InitSubsystems(Tcl_ConsolePanic), Tcl_CreateInterp)()) + (Tcl_InitSubsystems(Tcl_ConsolePanic), Tcl_CreateInterp())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, -- cgit v0.12 From 1c6a242b2e520aacca113e4189ebb0b95caf9844 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 31 Mar 2013 22:09:40 +0000 Subject: 2 lines not used any more --- generic/tcl.h | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 4acc39d..67cd181 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2416,9 +2416,6 @@ void Tcl_ConsolePanic(const char *format, ...); /* Tcl_InitSubsystems, see TIP #414 */ -#define TCL_INIT_PANIC (1) /* Set Panic proc */ -#define TCL_INIT_CUSTOM (2) /* Do any stuff before initializing the encoding */ - #ifdef USE_TCL_STUBS EXTERN Tcl_Interp *Tcl_InitSubsystems(Tcl_PanicProc *panicProc); #define Tcl_InitSubsystems(panicProc) Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0) -- cgit v0.12 From 696a9ba3f9a7c0ed882dc6a3b878970f8a94d27c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 1 Apr 2013 21:48:51 +0000 Subject: Use Tcl_InitSubsystems in Tcl_Main macro --- generic/tcl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index 5d93e8d..051e2a1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2424,7 +2424,7 @@ EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc); */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) + (Tcl_InitSubsystems(NULL), Tcl_CreateInterp())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, -- cgit v0.12 From 07af7d5337d813d6bd0ce15b62b1b04de5db9e06 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 Apr 2013 12:38:46 +0000 Subject: better comments --- doc/InitSubSyst.3 | 22 ++++++++++------------ generic/tcl.h | 3 ++- generic/tclEncoding.c | 10 ++++++---- 3 files changed, 18 insertions(+), 17 deletions(-) diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3 index 4fd99c7..2d5c2bc 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -5,7 +5,7 @@ '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .so man.macros -.TH Tcl_InitSubsystems 3 8.7 Tcl "Tcl Library Procedures" +.TH Tcl_InitSubsystems 3 8.6.1 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_InitSubsystems \- initialize the Tcl library. @@ -19,9 +19,8 @@ const char * .SH ARGUMENTS .AS Tcl_PanicProc *panicProc .AP Tcl_PanicProc *panicProc in -Desired panic function, for error reporting. The value NULL is used -when the default panicProc is desired, which normally writes the -message to stderr. +Desired panic function, for error reporting. If NULL, the default +panicProc is used, which normally writes the message to stderr. .BE .SH DESCRIPTION @@ -35,11 +34,12 @@ called once by Tcl embedders. Tcl_SetPanicProc is in the stub table, meant for Tcl extenders, and can be called at any time later to change the panic proc. .PP -\fBTcl_InitSubsystems\fR can be used in stead of -\fBTcl_FindExecutable\fR when Tcl is used as utility library -only, and no other encodings than utf8, iso8859-1 or unicode -are used. The system encoding will not be determined -correctly but being set to iso8859-1. +\fBTcl_InitSubsystems\fR is very similar to +\fBTcl_FindExecutable\fR as well. It can be used when Tcl is +used as utility library, no other encodings than utf8, +iso8859-1 or unicode are used, and no interest exists in the +value of \fBinfo nameofexecutable\fR. The system encoding will not +be extracted from the environment, but falls back to iso8859-1. .PP The return value is the Tcl version. .PP @@ -53,8 +53,6 @@ const char *version = Tcl_InitSubSystems(NULL); int major, minor, patch; Tcl_GetVersion(&major, &minor, &patch); .CE -This will work as expected, both with and without stubs. When -using stubs, this code must be linked with both the normal -Tcl library (static or shared) and the stub library. +This will work as expected, both with and without stubs. .SH KEYWORDS binary, executable file diff --git a/generic/tcl.h b/generic/tcl.h index 051e2a1..543b2a6 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2413,7 +2413,8 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, #ifdef USE_TCL_STUBS EXTERN Tcl_Interp *Tcl_InitSubsystems(Tcl_PanicProc *panicProc); -#define Tcl_InitSubsystems(panicProc) Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0) +#define Tcl_InitSubsystems(panicProc) \ + Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0) #else EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc); #endif diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e57272f..a83a6b0 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1428,10 +1428,12 @@ Tcl_UtfToExternal( */ MODULE_SCOPE const TclStubs tclStubs; -/* Dummy const structure returned by Tcl_InitSubsystems, - * which looks like an Tcl_Interp, but in reality is not. - * It contains just enough for Tcl_InitStubs to be able - * to initialize the stub table. */ +/* Dummy const structure returned by Tcl_InitSubsystems when + * using stubs, which looks like an Tcl_Interp, but in reality + * is not. It contains just enough for Tcl_InitStubs to be able + * to initialize the stub table. The first bytes of this structure + * are filled with the Tcl version string, so it can be cast to a + * "const char *" holding the Tcl version as well. */ static const struct { /* A real interpreter has interp->result/freeProc here: */ const char version[sizeof(struct {char *r; void (*f)(void);})]; -- cgit v0.12 From f292911c6d55b9fb236cb3c080aaf16414ed4e81 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 21 Apr 2013 21:01:26 +0000 Subject: Revert part of [bb4707eb077f0cd9], which removed Tcl_NewIntObj, Tcl_SetIntObj, Tcl_NewBooleanObj, Tcl_DbNewBooleanObj and Tcl_SetBooleanObj from the stub table and replaced those by macros. Add those functions back were they were. Reason: the upcoming cygwin64 will change the definition of 'long', I'm not sure any more this was a good idea. More investigation needed before doing something like this in "novem". --- generic/tcl.decls | 35 ++++---- generic/tclDecls.h | 50 +++++++---- generic/tclObj.c | 235 ++++++++++++++++++++++++++++++++++++++++++++++++-- generic/tclStubInit.c | 10 +-- 4 files changed, 280 insertions(+), 50 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index d96ff25..9f85773 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -104,10 +104,9 @@ declare 20 { declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } -# Removed in 9.0: -#declare 22 { -# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) -#} +declare 22 { + Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) +} declare 23 { Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line) @@ -200,20 +199,18 @@ declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]) } -# Removed in 9.0: -#declare 49 { -# Tcl_Obj *Tcl_NewBooleanObj(int boolValue) -#} +declare 49 { + Tcl_Obj *Tcl_NewBooleanObj(int boolValue) +} declare 50 { Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length) } declare 51 { Tcl_Obj *Tcl_NewDoubleObj(double doubleValue) } -# Removed in 9.0: -#declare 52 { -# Tcl_Obj *Tcl_NewIntObj(int intValue) -#} +declare 52 { + Tcl_Obj *Tcl_NewIntObj(int intValue) +} declare 53 { Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[]) } @@ -226,10 +223,9 @@ declare 55 { declare 56 { Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length) } -# Removed from 9.0: -#declare 57 { -# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) -#} +declare 57 { + void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) +} declare 58 { unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length) } @@ -240,10 +236,9 @@ declare 59 { declare 60 { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) } -# Removed in 9.0: -#declare 61 { -# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) -#} +declare 61 { + void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) +} declare 62 { void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]) } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index e263634..68cdc41 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -94,7 +94,9 @@ TCLAPI void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, /* 21 */ TCLAPI int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); -/* Slot 22 is reserved */ +/* 22 */ +TCLAPI Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, + int line); /* 23 */ TCLAPI Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line); @@ -168,13 +170,15 @@ TCLAPI int Tcl_ListObjLength(Tcl_Interp *interp, TCLAPI int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); -/* Slot 49 is reserved */ +/* 49 */ +TCLAPI Tcl_Obj * Tcl_NewBooleanObj(int boolValue); /* 50 */ TCLAPI Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, int length); /* 51 */ TCLAPI Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); -/* Slot 52 is reserved */ +/* 52 */ +TCLAPI Tcl_Obj * Tcl_NewIntObj(int intValue); /* 53 */ TCLAPI Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); /* 54 */ @@ -183,7 +187,8 @@ TCLAPI Tcl_Obj * Tcl_NewLongObj(long longValue); TCLAPI Tcl_Obj * Tcl_NewObj(void); /* 56 */ TCLAPI Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); -/* Slot 57 is reserved */ +/* 57 */ +TCLAPI void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); /* 58 */ TCLAPI unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); /* 59 */ @@ -191,7 +196,8 @@ TCLAPI void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 60 */ TCLAPI void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); -/* Slot 61 is reserved */ +/* 61 */ +TCLAPI void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); /* 62 */ TCLAPI void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); @@ -1771,7 +1777,7 @@ typedef struct TclStubs { void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ - void (*reserved22)(void); + Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */ Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ @@ -1798,19 +1804,19 @@ typedef struct TclStubs { int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ - void (*reserved49)(void); + Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */ Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ - void (*reserved52)(void); + Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */ Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */ - void (*reserved57)(void); + void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */ unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */ void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ - void (*reserved61)(void); + void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */ void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */ void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */ void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ @@ -2460,7 +2466,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ -/* Slot 22 is reserved */ +#define Tcl_DbNewBooleanObj \ + (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #define Tcl_DbNewDoubleObj \ @@ -2512,12 +2519,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ListObjLength) /* 47 */ #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ -/* Slot 49 is reserved */ +#define Tcl_NewBooleanObj \ + (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ -/* Slot 52 is reserved */ +#define Tcl_NewIntObj \ + (tclStubsPtr->tcl_NewIntObj) /* 52 */ #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ #define Tcl_NewLongObj \ @@ -2526,14 +2535,16 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NewObj) /* 55 */ #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ -/* Slot 57 is reserved */ +#define Tcl_SetBooleanObj \ + (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ -/* Slot 61 is reserved */ +#define Tcl_SetIntObj \ + (tclStubsPtr->tcl_SetIntObj) /* 61 */ #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ #define Tcl_SetLongObj \ @@ -3687,14 +3698,15 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \ sizeof(char *), (msg), (flags), (indexPtr)) -#define Tcl_NewIntObj Tcl_NewLongObj -#define Tcl_SetIntObj Tcl_SetLongObj +#undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(boolValue) \ - Tcl_NewLongObj((boolValue)!=0) + Tcl_NewIntObj((boolValue)!=0) +#undef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj(boolValue, file, line) \ Tcl_DbNewLongObj((boolValue)!=0, file, line) +#undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, boolValue) \ - Tcl_SetLongObj((objPtr), (boolValue)!=0) + Tcl_SetIntObj((objPtr), (boolValue)!=0) #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1)) #define Tcl_AddObjErrorInfo(interp, message, length) \ diff --git a/generic/tclObj.c b/generic/tclObj.c index 2cbc6ed..2c156f9 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1725,6 +1725,144 @@ Tcl_InvalidateStringRep( /* *---------------------------------------------------------------------- * + * Tcl_NewBooleanObj -- + * + * This function is normally called when not debugging: i.e., when + * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and + * initializes it from the argument boolean value. A nonzero "boolValue" + * is coerced to 1. + * + * When TCL_MEM_DEBUG is defined, this function just returns the result + * of calling the debugging version Tcl_DbNewBooleanObj. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_NewBooleanObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_NewBooleanObj( + register int boolValue) /* Boolean used to initialize new object. */ +{ + return Tcl_DbNewBooleanObj(boolValue, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_NewBooleanObj( + register int boolValue) /* Boolean used to initialize new object. */ +{ + register Tcl_Obj *objPtr; + + TclNewLongObj(objPtr, boolValue!=0); + return objPtr; +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_DbNewBooleanObj -- + * + * This function is normally called when debugging: i.e., when + * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the + * same as the Tcl_NewBooleanObj function above except that it calls + * Tcl_DbCkalloc directly with the file name and line number from its + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. + * + * When TCL_MEM_DEBUG is not defined, this function just returns the + * result of calling Tcl_NewBooleanObj. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_DbNewBooleanObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_DbNewBooleanObj( + register int boolValue, /* Boolean used to initialize new object. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ +{ + register Tcl_Obj *objPtr; + + TclDbNewObj(objPtr, file, line); + objPtr->bytes = NULL; + + objPtr->internalRep.longValue = (boolValue? 1 : 0); + objPtr->typePtr = &tclIntType; + return objPtr; +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_DbNewBooleanObj( + register int boolValue, /* Boolean used to initialize new object. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ +{ + return Tcl_NewBooleanObj(boolValue); +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetBooleanObj -- + * + * Modify an object to be a boolean object and to have the specified + * boolean value. A nonzero "boolValue" is coerced to 1. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_SetBooleanObj +void +Tcl_SetBooleanObj( + register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + register int boolValue) /* Boolean used to set object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); + } + + TclSetLongObj(objPtr, boolValue!=0); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This @@ -2242,6 +2380,90 @@ UpdateStringOfDouble( /* *---------------------------------------------------------------------- * + * Tcl_NewIntObj -- + * + * If a client is compiled with TCL_MEM_DEBUG defined, calls to + * Tcl_NewIntObj to create a new integer object end up calling the + * debugging function Tcl_DbNewLongObj instead. + * + * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, + * calls to Tcl_NewIntObj result in a call to one of the two + * Tcl_NewIntObj implementations below. We provide two implementations so + * that the Tcl core can be compiled to do memory debugging of the core + * even if a client does not request it for itself. + * + * Integer and long integer objects share the same "integer" type + * implementation. We store all integers as longs and Tcl_GetIntFromObj + * checks whether the current value of the long can be represented by an + * int. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_NewIntObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_NewIntObj( + register int intValue) /* Int used to initialize the new object. */ +{ + return Tcl_DbNewLongObj((long)intValue, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_NewIntObj( + register int intValue) /* Int used to initialize the new object. */ +{ + register Tcl_Obj *objPtr; + + TclNewLongObj(objPtr, intValue); + return objPtr; +} +#endif /* if TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetIntObj -- + * + * Modify an object to be an integer and to have the specified integer + * value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_SetIntObj +void +Tcl_SetIntObj( + register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + register int intValue) /* Integer used to set object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); + } + + TclSetLongObj(objPtr, intValue); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetIntFromObj -- * * Attempt to return an int from the Tcl object "objPtr". If the object @@ -2382,8 +2604,8 @@ UpdateStringOfInt( *---------------------------------------------------------------------- */ -#ifdef TCL_MEM_DEBUG #undef Tcl_NewLongObj +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( @@ -2413,11 +2635,11 @@ Tcl_NewLongObj( * Tcl_DbNewLongObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewLongObj to create new long integer objects end up calling the - * debugging function Tcl_DbNewLongObj instead. We provide two - * implementations of Tcl_DbNewLongObj so that whether the Tcl core is - * compiled to do memory debugging of the core is independent of whether - * a client requests debugging for itself. + * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer + * objects end up calling the debugging function Tcl_DbNewLongObj + * instead. We provide two implementations of Tcl_DbNewLongObj so that + * whether the Tcl core is compiled to do memory debugging of the core is + * independent of whether a client requests debugging for itself. * * When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj * calls Tcl_DbCkalloc directly with the file name and line number from @@ -2493,6 +2715,7 @@ Tcl_DbNewLongObj( *---------------------------------------------------------------------- */ +#undef Tcl_SetLongObj void Tcl_SetLongObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 94f4fda..65bdc5f 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -675,7 +675,7 @@ const TclStubs tclStubs = { Tcl_DbDecrRefCount, /* 19 */ Tcl_DbIncrRefCount, /* 20 */ Tcl_DbIsShared, /* 21 */ - 0, /* 22 */ + Tcl_DbNewBooleanObj, /* 22 */ Tcl_DbNewByteArrayObj, /* 23 */ Tcl_DbNewDoubleObj, /* 24 */ Tcl_DbNewListObj, /* 25 */ @@ -702,19 +702,19 @@ const TclStubs tclStubs = { Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ - 0, /* 49 */ + Tcl_NewBooleanObj, /* 49 */ Tcl_NewByteArrayObj, /* 50 */ Tcl_NewDoubleObj, /* 51 */ - 0, /* 52 */ + Tcl_NewIntObj, /* 52 */ Tcl_NewListObj, /* 53 */ Tcl_NewLongObj, /* 54 */ Tcl_NewObj, /* 55 */ Tcl_NewStringObj, /* 56 */ - 0, /* 57 */ + Tcl_SetBooleanObj, /* 57 */ Tcl_SetByteArrayLength, /* 58 */ Tcl_SetByteArrayObj, /* 59 */ Tcl_SetDoubleObj, /* 60 */ - 0, /* 61 */ + Tcl_SetIntObj, /* 61 */ Tcl_SetListObj, /* 62 */ Tcl_SetLongObj, /* 63 */ Tcl_SetObjLength, /* 64 */ -- cgit v0.12 From d96b2343b09366537e4e32b8185ae466df7e2942 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 6 May 2013 09:08:45 +0000 Subject: Change Tcl_UtfNcmp and friend's signature to use size_t in stead of unsigned long. This is potentially binary incompatible on win64, but not on any other platform. It eliminates the need for special stub-wrappers on Cygwin64 for those functions. "novem" doesn't promise binary compatibility anyway. --- doc/Utf.3 | 2 +- generic/tcl.decls | 8 ++++---- generic/tclCmdMZ.c | 20 ++++++++++---------- generic/tclDecls.h | 31 ++++++++----------------------- generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 4 ++-- generic/tclStubInit.c | 26 ++++---------------------- generic/tclUtf.c | 10 +++++----- 8 files changed, 35 insertions(+), 68 deletions(-) diff --git a/doc/Utf.3 b/doc/Utf.3 index 55906e7..9cecafc 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -102,7 +102,7 @@ The length of the Unicode string in characters. Must be greater than or equal to 0. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. -.AP "unsigned long" numChars in +.AP "size_t" numChars in The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. diff --git a/generic/tcl.decls b/generic/tcl.decls index 9f85773..f8bfe5f 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1278,7 +1278,7 @@ declare 352 { } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) + size_t numChars) } declare 354 { char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, @@ -1340,10 +1340,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -1514,7 +1514,7 @@ declare 418 { } declare 419 { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) + size_t numChars) } declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 9f9506a..cc4462e 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -594,7 +594,7 @@ Tcl_RegsubObjCmd( */ int slen, nocase; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p, wsrclc; numMatches = 0; @@ -629,7 +629,7 @@ Tcl_RegsubObjCmd( if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, - (unsigned long) slen) == 0))) { + (size_t)slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); @@ -1845,7 +1845,7 @@ StringMapCmd( int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); @@ -1986,7 +1986,7 @@ StringMapCmd( if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - (unsigned long) length2) == 0)) { + (size_t) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; @@ -2034,7 +2034,7 @@ StringMapCmd( (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ (end-ustring1 >= length2) && ((length2 == 1) || - !strCmpFn(ustring2, ustring1, (unsigned) length2))) { + !strCmpFn(ustring2, ustring1, (size_t) length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. @@ -2563,7 +2563,7 @@ StringEqualCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); + typedef int (*strCmpFn_t)(const char *, const char *, size_t); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2713,7 +2713,7 @@ StringCmpCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); + typedef int (*strCmpFn_t)(const char *, const char *, size_t); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2797,11 +2797,11 @@ StringCmpCmd( string1 = (char *) TclGetStringFromObj(objv[0], &length1); string2 = (char *) TclGetStringFromObj(objv[1], &length2); if ((reqlength < 0) && !nocase) { - strCmpFn = (strCmpFn_t) TclpUtfNcmp2; + strCmpFn = TclpUtfNcmp2; } else { length1 = Tcl_NumUtfChars(string1, length1); length2 = Tcl_NumUtfChars(string2, length2); - strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); + strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp; } } @@ -2817,7 +2817,7 @@ StringCmpCmd( reqlength = length + 1; } - match = strCmpFn(string1, string2, (unsigned) length); + match = strCmpFn(string1, string2, (size_t) length); if ((match == 0) && (reqlength > length)) { match = length1 - length2; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 5fe0fcf..3e13409 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -948,8 +948,7 @@ TCLAPI int Tcl_UniCharIsWordChar(int ch); TCLAPI int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, - unsigned long numChars); + const Tcl_UniChar *uct, size_t numChars); /* 354 */ TCLAPI char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); @@ -996,11 +995,10 @@ TCLAPI int Tcl_Access(const char *path, int mode); /* 368 */ TCLAPI int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, - unsigned long n); +TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 370 */ TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2, - unsigned long n); + size_t n); /* 371 */ TCLAPI int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); @@ -1129,8 +1127,7 @@ TCLAPI void Tcl_ClearChannelHandlers(Tcl_Channel channel); TCLAPI int Tcl_IsChannelExisting(const char *channelName); /* 419 */ TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, - unsigned long numChars); + const Tcl_UniChar *uct, size_t numChars); /* 420 */ TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); @@ -2116,7 +2113,7 @@ typedef struct TclStubs { int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ + int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ @@ -2132,8 +2129,8 @@ typedef struct TclStubs { int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ @@ -2182,7 +2179,7 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ + int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ @@ -3755,10 +3752,6 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, # undef Tcl_SetLongObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj -# undef Tcl_UniCharNcmp -# undef Tcl_UtfNcmp -# undef Tcl_UtfNcasecmp -# undef Tcl_UniCharNcasecmp # define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj) # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) # define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj) @@ -3777,14 +3770,6 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, if (result == TCL_OK) *ptr = (long)intValue; return result; } -# define Tcl_UniCharNcmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) -# define Tcl_UtfNcmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UtfNcasecmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UniCharNcasecmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif diff --git a/generic/tclInt.decls b/generic/tclInt.decls index b840d04..356a265 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -703,7 +703,7 @@ declare 166 { #} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) + int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 26b168f..fce4dbb 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -361,7 +361,7 @@ TCLAPI int TclListObjSetElement(Tcl_Interp *interp, /* Slot 168 is reserved */ /* 169 */ TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2, - unsigned long n); + size_t n); /* 170 */ TCLAPI int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, @@ -716,7 +716,7 @@ typedef struct TclIntStubs { int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ void (*reserved167)(void); void (*reserved168)(void); - int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ + int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 2b41f07..0206e88 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -209,9 +209,8 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { - Tcl_SetResult(interp, - "integer value too large to represent as non-long integer", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent as non-long integer", -1)); result = TCL_ERROR; } } @@ -226,31 +225,14 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { - Tcl_SetResult(interp, - "integer value too large to represent as non-long integer", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent as non-long integer", -1)); result = TCL_ERROR; } } return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj -static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp -static int utfNcmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp -static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp -static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp static int formatInt(char *buffer, int n){ return TclFormatInt(buffer, (long)n); } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 02c5eb8..891c0ff 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -986,7 +986,7 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1033,7 +1033,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; @@ -1081,7 +1081,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; while (numChars-- > 0) { @@ -1245,7 +1245,7 @@ int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* @@ -1290,7 +1290,7 @@ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { -- cgit v0.12 From 3f5f45f002154ba9fc45f89e99f68beef8ea79c3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 May 2013 14:09:20 +0000 Subject: fix directory where tclWinPanic.c resides --- win/makefile.bc | 2 +- win/makefile.vc | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/win/makefile.bc b/win/makefile.bc index b5f388c..891fe69 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -533,7 +533,7 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? -$(TMPDIR)\tclWinPanic.obj : $(GENERICDIR)\tclWinPanic.c +$(TMPDIR)\tclWinPanic.obj : $(WINDIR)\tclWinPanic.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? diff --git a/win/makefile.vc b/win/makefile.vc index e4f064e..1485486 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -984,7 +984,7 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? -$(TMP_DIR)\tclWinPanic.obj: $(GENERICDIR)\tclWinPanic.c +$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? #--------------------------------------------------------------------- -- cgit v0.12 From 89ec383cdcc3cec78d12d6bf5f2f40a26500275f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 18 Jun 2013 13:59:30 +0000 Subject: Update Unicode tables to latest 6.3 beta version --- generic/regc_locale.c | 29 ++++++++++------------------- 1 file changed, 10 insertions(+), 19 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 5d6c916..0006635 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -191,10 +191,6 @@ static const crange alphaRangeTable[] = { {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xabc0, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, - {0xdc02, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, - {0xdd02, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, - {0xde02, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, - {0xdf02, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, @@ -246,8 +242,7 @@ static const chr alphaCharTable[] = { 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, - 0xaab6, 0xaac0, 0xaac2, 0xdc00, 0xdd00, 0xde00, 0xdf00, 0xfb1d, 0xfb3e, - 0xfb40, 0xfb41, 0xfb43, 0xfb44 + 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44 #if TCL_UTF_MAX > 4 ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x109be, 0x109bf, 0x10a00, 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, @@ -321,12 +316,13 @@ static const crange punctRangeTable[] = { {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad}, {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, - {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, {0x29d8, 0x29db}, - {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, {0x3001, 0x3003}, - {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7}, - {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f}, - {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03}, - {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65} + {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, + {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, + {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, + {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, + {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, + {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, + {0xff5f, 0xff65} #if TCL_UTF_MAX > 4 ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10b39, 0x10b3f}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x12470, 0x12473} @@ -642,11 +638,7 @@ static const crange graphRangeTable[] = { {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaa7b}, {0xaa80, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xabc0, 0xabed}, {0xabf0, 0xabf9}, - {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, - {0xdc42, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e}, - {0xdd42, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e}, - {0xde42, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, - {0xdf42, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, + {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe26}, @@ -705,8 +697,7 @@ static const chr graphCharTable[] = { 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa9de, - 0xa9df, 0xdc40, 0xdd40, 0xde40, 0xdf40, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, - 0xfb44, 0xfffc, 0xfffd + 0xa9df, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd #if TCL_UTF_MAX > 4 ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f, 0x109be, 0x109bf, 0x10a05, 0x10a06, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, -- cgit v0.12 From 2f4d9112d2ba547d612e6539dd0f129ca427e630 Mon Sep 17 00:00:00 2001 From: stwo Date: Sun, 7 Jul 2013 01:09:10 +0000 Subject: OpenBSD/m88k is now elf. Remove unneeded elf check. --- unix/configure | 43 ++++--------------------------------------- unix/tcl.m4 | 15 ++++----------- 2 files changed, 8 insertions(+), 50 deletions(-) diff --git a/unix/configure b/unix/configure index e440baa..ba874fa 100755 --- a/unix/configure +++ b/unix/configure @@ -7794,11 +7794,12 @@ fi OpenBSD-*) arch=`arch -s` case "$arch" in - m88k|vax) + vax) # Equivalent using configure option --disable-load # Step 4 will set the necessary variables DL_OBJS="" SHLIB_LD_LIBS="" + LDFLAGS="" ;; *) SHLIB_CFLAGS="-fPIC" @@ -7813,10 +7814,11 @@ fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" ;; esac case "$arch" in - m88k|vax) + vax) CFLAGS_OPTIMIZE="-O1" ;; sh) @@ -7826,43 +7828,6 @@ fi CFLAGS_OPTIMIZE="-O2" ;; esac - echo "$as_me:$LINENO: checking for ELF" >&5 -echo $ECHO_N "checking for ELF... $ECHO_C" >&6 -if test "${tcl_cv_ld_elf+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -#ifdef __ELF__ - yes -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "yes" >/dev/null 2>&1; then - tcl_cv_ld_elf=yes -else - tcl_cv_ld_elf=no -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $tcl_cv_ld_elf" >&5 -echo "${ECHO_T}$tcl_cv_ld_elf" >&6 - if test $tcl_cv_ld_elf = yes; then - - LDFLAGS=-Wl,-export-dynamic - -else - LDFLAGS="" -fi - if test "${TCL_THREADS}" = "1"; then # On OpenBSD: Compile with -pthread diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 0ac4fb1..1ded260 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1510,11 +1510,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ OpenBSD-*) arch=`arch -s` case "$arch" in - m88k|vax) + vax) # Equivalent using configure option --disable-load # Step 4 will set the necessary variables DL_OBJS="" SHLIB_LD_LIBS="" + LDFLAGS="" ;; *) SHLIB_CFLAGS="-fPIC" @@ -1526,10 +1527,11 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" ;; esac case "$arch" in - m88k|vax) + vax) CFLAGS_OPTIMIZE="-O1" ;; sh) @@ -1539,15 +1541,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_OPTIMIZE="-O2" ;; esac - AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [ - AC_EGREP_CPP(yes, [ -#ifdef __ELF__ - yes -#endif - ], tcl_cv_ld_elf=yes, tcl_cv_ld_elf=no)]) - AS_IF([test $tcl_cv_ld_elf = yes], [ - LDFLAGS=-Wl,-export-dynamic - ], [LDFLAGS=""]) AS_IF([test "${TCL_THREADS}" = "1"], [ # On OpenBSD: Compile with -pthread # Don't link with -lpthread -- cgit v0.12 From 21d8621d11bcad78438d51a17dd685e4c8c3c557 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 7 Jul 2013 11:15:08 +0000 Subject: Added a mechanism for discovering the "type" of a command. --- generic/tclBasic.c | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++- generic/tclCmdIL.c | 47 ++++++++++++++++++++++++++ generic/tclEnsemble.c | 41 +++++++++++------------ generic/tclInt.h | 15 +++++++++ generic/tclInterp.c | 33 ++++++++---------- generic/tclNamesp.c | 10 +++--- generic/tclOO.c | 29 +++++++--------- 7 files changed, 203 insertions(+), 64 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b2a505a..94697b2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -74,7 +74,18 @@ typedef struct { } CancelInfo; static Tcl_HashTable cancelTable; static int cancelTableInitialized = 0; /* 0 means not yet initialized. */ -TCL_DECLARE_MUTEX(cancelLock) +TCL_DECLARE_MUTEX(cancelLock); + +/* + * Table used to map command implementation functions to a human-readable type + * name, for [info type]. The keys in the table are function addresses, and + * the values in the table are static char* containing strings in Tcl's + * internal encoding (almost UTF-8). + */ + +static Tcl_HashTable commandTypeTable; +static int commandTypeInit = 0; +TCL_DECLARE_MUTEX(commandTypeLock); /* * Declarations for managing contexts for non-recursive coroutines. Contexts @@ -430,6 +441,13 @@ TclFinalizeEvaluation(void) cancelTableInitialized = 0; } Tcl_MutexUnlock(&cancelLock); + + Tcl_MutexLock(&commandTypeLock); + if (commandTypeInit) { + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; + } + Tcl_MutexUnlock(&commandTypeLock); } /* @@ -507,6 +525,16 @@ Tcl_CreateInterp(void) Tcl_MutexUnlock(&cancelLock); } + if (commandTypeInit == 0) { + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclSlaveObjCmd, "slave"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + } + /* * Initialize support for namespaces and create the global namespace * (whose name is ""; an alias is "::"). This also initializes the Tcl @@ -995,6 +1023,68 @@ DeleteOpCmdClientData( } /* + * --------------------------------------------------------------------- + * + * TclRegisterCommandTypeName, TclGetCommandTypeName -- + * + * Command type registration and lookup mechanism. Everything is keyed by + * the Tcl_ObjCmdProc for the command, and that is used as the *key* into + * the hash table that maps to constant strings that are names. (It is + * recommended that those names be ASCII.) + * + * --------------------------------------------------------------------- + */ + +void +TclRegisterCommandTypeName( + Tcl_ObjCmdProc *implementationProc, + const char *nameStr) +{ + Tcl_HashEntry *hPtr; + + Tcl_MutexLock(&commandTypeLock); + if (commandTypeInit == 0) { + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; + } + if (nameStr != NULL) { + int isNew; + + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + (void *) implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); + } else { + hPtr = Tcl_FindHashEntry(&commandTypeTable, + (void *) implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } + } + Tcl_MutexUnlock(&commandTypeLock); +} + +const char * +TclGetCommandTypeName( + Tcl_Command command) +{ + Command *cmdPtr = (Command *) command; + const char *name = "native"; + + Tcl_MutexLock(&commandTypeLock); + if (commandTypeInit) { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, + (void *) cmdPtr->objProc); + + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } + } + Tcl_MutexUnlock(&commandTypeLock); + + return name; +} + +/* *---------------------------------------------------------------------- * * TclHideUnsafeCommands -- diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 0e33392..1b6f9c1 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -146,6 +146,8 @@ static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int InfoTypeCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, @@ -184,6 +186,7 @@ static const EnsembleImplMap defaultInfoMap[] = { {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"type", InfoTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -2141,6 +2144,50 @@ InfoTclVersionCmd( /* *---------------------------------------------------------------------- * + * InfoTypeCmd -- + * + * Called to implement the "info type" command that returns the type of a + * given command. Handles the following syntax: + * + * info type cmdName + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a type name. If there is an error, the result is an error + * message. + * + *---------------------------------------------------------------------- + */ + +static int +InfoTypeCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Command command; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "commandName"); + return TCL_ERROR; + } + command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL, + TCL_LEAVE_ERR_MSG); + if (command == NULL) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, + Tcl_NewStringObj(TclGetCommandTypeName(command), -1)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_JoinObjCmd -- * * This procedure is invoked to process the "join" Tcl command. See the diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 813e056..e81fa1b 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -21,8 +21,6 @@ static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr); static inline int EnsembleUnknownCallback(Tcl_Interp *interp, EnsembleConfig *ensemblePtr, int objc, Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr); -static int NsEnsembleImplementationCmd(ClientData clientData, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NsEnsembleImplementationCmdNR(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr); @@ -687,7 +685,7 @@ Tcl_CreateEnsemble( ensemblePtr->parameterList = NULL; ensemblePtr->unknownHandler = NULL; ensemblePtr->token = Tcl_NRCreateCommand(interp, name, - NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR, + TclEnsembleImplementationCmd, NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig); ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles; nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr; @@ -738,7 +736,7 @@ Tcl_SetEnsembleSubcommandList( EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); @@ -814,7 +812,7 @@ Tcl_SetEnsembleParameterList( Tcl_Obj *oldList; int length; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); @@ -890,7 +888,7 @@ Tcl_SetEnsembleMappingDict( EnsembleConfig *ensemblePtr; Tcl_Obj *oldDict; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); @@ -989,7 +987,7 @@ Tcl_SetEnsembleUnknownHandler( EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); @@ -1055,7 +1053,7 @@ Tcl_SetEnsembleFlags( EnsembleConfig *ensemblePtr; int wasCompiled; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); @@ -1131,7 +1129,7 @@ Tcl_GetEnsembleSubcommandList( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); @@ -1173,7 +1171,7 @@ Tcl_GetEnsembleParameterList( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); @@ -1215,7 +1213,7 @@ Tcl_GetEnsembleMappingDict( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); @@ -1256,7 +1254,7 @@ Tcl_GetEnsembleUnknownHandler( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); @@ -1297,7 +1295,7 @@ Tcl_GetEnsembleFlags( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); @@ -1338,7 +1336,7 @@ Tcl_GetEnsembleNamespace( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); @@ -1388,7 +1386,7 @@ Tcl_FindEnsemble( return NULL; } - if (cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr->objProc != TclEnsembleImplementationCmd) { /* * Reuse existing infrastructure for following import link chains * rather than duplicating it. @@ -1396,7 +1394,8 @@ Tcl_FindEnsemble( cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); - if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){ + if (cmdPtr == NULL + || cmdPtr->objProc != TclEnsembleImplementationCmd) { if (flags & TCL_LEAVE_ERR_MSG) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" is not an ensemble command", @@ -1434,11 +1433,11 @@ Tcl_IsEnsemble( { Command *cmdPtr = (Command *) token; - if (cmdPtr->objProc == NsEnsembleImplementationCmd) { + if (cmdPtr->objProc == TclEnsembleImplementationCmd) { return 1; } cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); - if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) { + if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) { return 0; } return 1; @@ -1609,7 +1608,7 @@ TclMakeEnsemble( /* *---------------------------------------------------------------------- * - * NsEnsembleImplementationCmd -- + * TclEnsembleImplementationCmd -- * * Implements an ensemble of commands (being those exported by a * namespace other than the global namespace) as a command with the same @@ -1628,8 +1627,8 @@ TclMakeEnsemble( *---------------------------------------------------------------------- */ -static int -NsEnsembleImplementationCmd( +int +TclEnsembleImplementationCmd( ClientData clientData, Tcl_Interp *interp, int objc, diff --git a/generic/tclInt.h b/generic/tclInt.h index b940225..ce8ef8f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3096,6 +3096,10 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); +MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); +MODULE_SCOPE void TclRegisterCommandTypeName( + Tcl_ObjCmdProc *implementationProc, + const char *nameStr); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); @@ -3886,6 +3890,17 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); /* + * Just for the purposes of command-type registration. + */ + +MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd; + +/* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 1a4297b..fe218ff 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -222,9 +222,6 @@ static int AliasDelete(Tcl_Interp *interp, static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp); -static int AliasObjCmd(ClientData dummy, - Tcl_Interp *currentInterp, int objc, - Tcl_Obj *const objv[]); static int AliasNRCmd(ClientData dummy, Tcl_Interp *currentInterp, int objc, Tcl_Obj *const objv[]); @@ -257,8 +254,6 @@ static int SlaveInvokeHidden(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SlaveMarkTrusted(Tcl_Interp *interp, Tcl_Interp *slaveInterp); -static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); static void SlaveObjCmdDeleteProc(ClientData clientData); static int SlaveRecursionLimit(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, @@ -1390,7 +1385,7 @@ TclPreventAliasLoop( * create or rename the command. */ - if (cmdPtr->objProc != AliasObjCmd) { + if (cmdPtr->objProc != TclAliasObjCmd) { return TCL_OK; } @@ -1445,7 +1440,7 @@ TclPreventAliasLoop( * Otherwise we do not have a loop. */ - if (aliasCmdPtr->objProc != AliasObjCmd) { + if (aliasCmdPtr->objProc != TclAliasObjCmd) { return TCL_OK; } nextAliasPtr = aliasCmdPtr->objClientData; @@ -1511,12 +1506,12 @@ AliasCreate( if (slaveInterp == masterInterp) { aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp, - TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr, + TclGetString(namePtr), TclAliasObjCmd, AliasNRCmd, aliasPtr, AliasObjCmdDeleteProc); } else { - aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, - TclGetString(namePtr), AliasObjCmd, aliasPtr, - AliasObjCmdDeleteProc); + aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, + TclGetString(namePtr), TclAliasObjCmd, aliasPtr, + AliasObjCmdDeleteProc); } if (TclPreventAliasLoop(interp, slaveInterp, @@ -1752,7 +1747,7 @@ AliasList( /* *---------------------------------------------------------------------- * - * AliasObjCmd -- + * TclAliasObjCmd -- * * This is the function that services invocations of aliases in a slave * interpreter. One such command exists for each alias. When invoked, @@ -1835,8 +1830,8 @@ AliasNRCmd( return Tcl_NREvalObj(interp, listPtr, flags); } -static int -AliasObjCmd( +int +TclAliasObjCmd( ClientData clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2373,7 +2368,7 @@ SlaveCreate( slavePtr->slaveEntryPtr = hPtr; slavePtr->slaveInterp = slaveInterp; slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path, - SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc); + TclSlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc); Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS); Tcl_SetHashValue(hPtr, slavePtr); Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); @@ -2441,7 +2436,7 @@ SlaveCreate( /* *---------------------------------------------------------------------- * - * SlaveObjCmd -- + * TclSlaveObjCmd -- * * Command to manipulate an interpreter, e.g. to send commands to it to * be evaluated. One such command exists for each slave interpreter. @@ -2455,8 +2450,8 @@ SlaveCreate( *---------------------------------------------------------------------- */ -static int -SlaveObjCmd( +int +TclSlaveObjCmd( ClientData clientData, /* Slave interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2478,7 +2473,7 @@ SlaveObjCmd( }; if (slaveInterp == NULL) { - Tcl_Panic("SlaveObjCmd: interpreter has been deleted"); + Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted"); } if (objc < 2) { diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index aed623a..cc2f953 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -89,8 +89,6 @@ static char * EstablishErrorInfoTraces(ClientData clientData, static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); -static int InvokeImportedCmd(ClientData clientData, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int InvokeImportedNRCmd(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceChildrenCmd(ClientData dummy, @@ -1693,7 +1691,7 @@ DoImport( dataPtr = ckalloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), - InvokeImportedCmd, InvokeImportedNRCmd, dataPtr, + TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); dataPtr->realCmdPtr = cmdPtr; dataPtr->selfPtr = (Command *) importedCmd; @@ -1914,7 +1912,7 @@ TclGetOriginalCommand( /* *---------------------------------------------------------------------- * - * InvokeImportedCmd -- + * TclInvokeImportedCmd -- * * Invoked by Tcl whenever the user calls an imported command that was * created by Tcl_Import. Finds the "real" command (in another @@ -1945,8 +1943,8 @@ InvokeImportedNRCmd( return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0); } -static int -InvokeImportedCmd( +int +TclInvokeImportedCmd( ClientData clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ diff --git a/generic/tclOO.c b/generic/tclOO.c index cb22de6..1138c99 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -84,15 +84,9 @@ static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); static inline void SquelchCachedName(Object *oPtr); static void SquelchedNsFirst(ClientData clientData); -static int PublicObjectCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); static int PublicNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static int PrivateObjectCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); static int PrivateNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); @@ -650,10 +644,11 @@ AllocObject( if (!nameStr) { oPtr->command = Tcl_CreateObjCommand(interp, - oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL); + oPtr->namespacePtr->fullName, TclOOPublicObjectCmd, oPtr, + NULL); } else if (nameStr[0] == ':' && nameStr[1] == ':') { oPtr->command = Tcl_CreateObjCommand(interp, nameStr, - PublicObjectCmd, oPtr, NULL); + TclOOPublicObjectCmd, oPtr, NULL); } else { Tcl_DString buffer; @@ -663,7 +658,7 @@ AllocObject( TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, nameStr, -1); oPtr->command = Tcl_CreateObjCommand(interp, - Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL); + Tcl_DStringValue(&buffer), TclOOPublicObjectCmd, oPtr, NULL); Tcl_DStringFree(&buffer); } @@ -692,7 +687,7 @@ AllocObject( cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my", &ignored); cmdPtr->refCount = 1; - cmdPtr->objProc = PrivateObjectCmd; + cmdPtr->objProc = TclOOPrivateObjectCmd; cmdPtr->deleteProc = MyDeleted; cmdPtr->objClientData = cmdPtr->deleteData = oPtr; cmdPtr->proc = TclInvokeObjectCommand; @@ -2368,7 +2363,7 @@ Tcl_ObjectSetMetadata( /* * ---------------------------------------------------------------------- * - * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject -- + * TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject -- * * Main entry point for object invokations. The Public* and Private* * wrapper functions (implementations of both object instance commands @@ -2378,8 +2373,8 @@ Tcl_ObjectSetMetadata( * ---------------------------------------------------------------------- */ -static int -PublicObjectCmd( +int +TclOOPublicObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, @@ -2399,8 +2394,8 @@ PublicNRObjectCmd( NULL); } -static int -PrivateObjectCmd( +int +TclOOPrivateObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, @@ -2784,9 +2779,9 @@ Tcl_GetObjectFromObj( if (cmdPtr == NULL) { goto notAnObject; } - if (cmdPtr->objProc != PublicObjectCmd) { + if (cmdPtr->objProc != TclOOPublicObjectCmd) { cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); - if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) { + if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) { goto notAnObject; } } -- cgit v0.12 From 82132b6c4c3b3779d75abdb7283c82bc90012d82 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 10 Jul 2013 13:45:52 +0000 Subject: Some documentation. --- doc/CrtObjCmd.3 | 29 ++++++++++++++++++++++++++++- doc/info.n | 30 ++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index faf8b74..16e7c92 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -8,7 +8,7 @@ .TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C +Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C .SH SYNOPSIS .nf \fB#include \fR @@ -42,6 +42,14 @@ void .sp Tcl_Command \fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR) +.sp +.VS "info type feature" +void +\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR) +.sp +const char * +\fBTcl_GetCommandTypeName\fR(\fItoken\fR) +.VE "info type feature" .SH ARGUMENTS .AS Tcl_CmdDeleteProc *deleteProc in/out .AP Tcl_Interp *interp in @@ -65,6 +73,9 @@ Pointer to structure containing various information about a Tcl command. .AP Tcl_Obj *objPtr in Value containing the name of a Tcl command. +.AP "const char" *typeName in +Indicates the name of the type of command implementation associated +with a particular \fIproc\fR, or NULL to break the association. .BE .SH DESCRIPTION .PP @@ -296,6 +307,22 @@ is appended to the value specified by \fIobjPtr\fR. specified by the name in a \fBTcl_Obj\fR. The command name is resolved relative to the current namespace. Returns NULL if the command is not found. +.PP +.VS "info type feature" +\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the +\fItypeName\fR argument) with a particular implementation function so that it +can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is +called with a command token that information is wanted for and which returns +the name of the type that was registered for the implementation function used +for that command. (The lookup functionality is surfaced virtually directly in Tcl via +\fBinfo type\fR.) If there is no function registered for a particular +function, the result will be the string literal +.QW \fBnative\fR . +The registration of a name can be undone by registering a mapping to NULL +instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that +string which was registered, and not a copy; use of a compile-time constant +string is \fIstrongly recommended\fR. +.VE "info type feature" .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3) .SH KEYWORDS diff --git a/doc/info.n b/doc/info.n index e65a083..59ee1a2 100644 --- a/doc/info.n +++ b/doc/info.n @@ -377,6 +377,36 @@ string is returned. Returns the value of the global variable \fBtcl_version\fR; see the \fBtclvars\fR manual entry for more information. .TP +\fBinfo type \fIcommandName\fR +.VS "info type feature" +Returns a description of the kind of command named by \fIcommandName\fR. The +supported types are: +.RS +.IP \fBalias\fR +Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. +.IP \fBensemble\fR +Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR. +.IP \fBimport\fR +Indicates that \fIcommandName\fR was created by \fBnamespace import\fR. +.IP \fBnative\fR +Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR +interface directly without further registration of the type of command. +.IP \fBobject\fR +Indicates that \fIcommandName\fR is the public command that represents an +instance of \fBoo::object\fR or one of its subclasses. +.IP \fBprivateObject\fR +Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default) +that represents an instance of \fBoo::object\fR or one of its subclasses. +.IP \fBproc\fR +Indicates that \fIcommandName\fR was created by \fBproc\fR. +.IP \fBslave\fR +Indicates that \fIcommandName\fR was created by \fBinterp create\fR. +.PP +There may be other registered types as well; this is a set that is extensible +at the implementation level with \fBTcl_RegisterCommandTypeName\fR. +.RE +.VE "info type feature" +.TP \fBinfo vars\fR ?\fIpattern\fR? . If \fIpattern\fR is not specified, -- cgit v0.12 From afd4d17b3c5167c365d4072b61c93a80aacafad1 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 16 Jul 2013 14:12:40 +0000 Subject: Changed subcommand name following community feedback. --- doc/CrtObjCmd.3 | 10 ++++----- doc/info.n | 60 +++++++++++++++++++++++++++--------------------------- generic/tclCmdIL.c | 14 ++++++------- 3 files changed, 42 insertions(+), 42 deletions(-) diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 16e7c92..149d2f6 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -43,13 +43,13 @@ void Tcl_Command \fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR) .sp -.VS "info type feature" +.VS "info cmdtype feature" void \fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR) .sp const char * \fBTcl_GetCommandTypeName\fR(\fItoken\fR) -.VE "info type feature" +.VE "info cmdtype feature" .SH ARGUMENTS .AS Tcl_CmdDeleteProc *deleteProc in/out .AP Tcl_Interp *interp in @@ -308,21 +308,21 @@ specified by the name in a \fBTcl_Obj\fR. The command name is resolved relative to the current namespace. Returns NULL if the command is not found. .PP -.VS "info type feature" +.VS "info cmdtype feature" \fBTcl_RegisterCommandTypeName\fR is used to associate a name (the \fItypeName\fR argument) with a particular implementation function so that it can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is called with a command token that information is wanted for and which returns the name of the type that was registered for the implementation function used for that command. (The lookup functionality is surfaced virtually directly in Tcl via -\fBinfo type\fR.) If there is no function registered for a particular +\fBinfo cmdtype\fR.) If there is no function registered for a particular function, the result will be the string literal .QW \fBnative\fR . The registration of a name can be undone by registering a mapping to NULL instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that string which was registered, and not a copy; use of a compile-time constant string is \fIstrongly recommended\fR. -.VE "info type feature" +.VE "info cmdtype feature" .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3) .SH KEYWORDS diff --git a/doc/info.n b/doc/info.n index 59ee1a2..42fe6c3 100644 --- a/doc/info.n +++ b/doc/info.n @@ -45,6 +45,36 @@ described in \fBCLASS INTROSPECTION\fR below. Returns a count of the total number of commands that have been invoked in this interpreter. .TP +\fBinfo cmdtype \fIcommandName\fR +.VS "info cmdtype feature" +Returns a description of the kind of command named by \fIcommandName\fR. The +supported types are: +.RS +.IP \fBalias\fR +Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. +.IP \fBensemble\fR +Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR. +.IP \fBimport\fR +Indicates that \fIcommandName\fR was created by \fBnamespace import\fR. +.IP \fBnative\fR +Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR +interface directly without further registration of the type of command. +.IP \fBobject\fR +Indicates that \fIcommandName\fR is the public command that represents an +instance of \fBoo::object\fR or one of its subclasses. +.IP \fBprivateObject\fR +Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default) +that represents an instance of \fBoo::object\fR or one of its subclasses. +.IP \fBproc\fR +Indicates that \fIcommandName\fR was created by \fBproc\fR. +.IP \fBslave\fR +Indicates that \fIcommandName\fR was created by \fBinterp create\fR. +.PP +There may be other registered types as well; this is a set that is extensible +at the implementation level with \fBTcl_RegisterCommandTypeName\fR. +.RE +.VE "info cmdtype feature" +.TP \fBinfo commands \fR?\fIpattern\fR? . If \fIpattern\fR is not specified, @@ -377,36 +407,6 @@ string is returned. Returns the value of the global variable \fBtcl_version\fR; see the \fBtclvars\fR manual entry for more information. .TP -\fBinfo type \fIcommandName\fR -.VS "info type feature" -Returns a description of the kind of command named by \fIcommandName\fR. The -supported types are: -.RS -.IP \fBalias\fR -Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. -.IP \fBensemble\fR -Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR. -.IP \fBimport\fR -Indicates that \fIcommandName\fR was created by \fBnamespace import\fR. -.IP \fBnative\fR -Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR -interface directly without further registration of the type of command. -.IP \fBobject\fR -Indicates that \fIcommandName\fR is the public command that represents an -instance of \fBoo::object\fR or one of its subclasses. -.IP \fBprivateObject\fR -Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default) -that represents an instance of \fBoo::object\fR or one of its subclasses. -.IP \fBproc\fR -Indicates that \fIcommandName\fR was created by \fBproc\fR. -.IP \fBslave\fR -Indicates that \fIcommandName\fR was created by \fBinterp create\fR. -.PP -There may be other registered types as well; this is a set that is extensible -at the implementation level with \fBTcl_RegisterCommandTypeName\fR. -.RE -.VE "info type feature" -.TP \fBinfo vars\fR ?\fIpattern\fR? . If \fIpattern\fR is not specified, diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 1b6f9c1..b99b9e2 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -146,7 +146,7 @@ static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int InfoTypeCmd(ClientData dummy, Tcl_Interp *interp, +static int InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -166,6 +166,7 @@ static const EnsembleImplMap defaultInfoMap[] = { {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"cmdtype", InfoCmdTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, @@ -186,7 +187,6 @@ static const EnsembleImplMap defaultInfoMap[] = { {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, - {"type", InfoTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -2144,12 +2144,12 @@ InfoTclVersionCmd( /* *---------------------------------------------------------------------- * - * InfoTypeCmd -- + * InfoCmdTypeCmd -- * - * Called to implement the "info type" command that returns the type of a - * given command. Handles the following syntax: + * Called to implement the "info cmdtype" command that returns the type + * of a given command. Handles the following syntax: * - * info type cmdName + * info cmdtype cmdName * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. @@ -2162,7 +2162,7 @@ InfoTclVersionCmd( */ static int -InfoTypeCmd( +InfoCmdTypeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ -- cgit v0.12 From 53dc25e532b83e02c84f5991389720106c6d9018 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 23 Jul 2013 11:54:49 +0000 Subject: Add documentation --- doc/Panic.3 | 13 ++++++++++++- generic/tclDecls.h | 1 + 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/doc/Panic.3 b/doc/Panic.3 index 48aed2b..9013e89 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -7,7 +7,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort +Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort .SH SYNOPSIS .nf \fB#include \fR @@ -21,6 +21,9 @@ void void \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp +void +\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) +.sp .SH ARGUMENTS .AS Tcl_PanicProc *panicProc .AP "const char*" format in @@ -54,6 +57,14 @@ message is sent to the debugger in stead. If the windows executable does not have a stderr channel (e.g. \fBwish.exe\fR), then a system dialog box is used to display the panic message. .PP +If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR +and you want to implicitly use the stderr channel of your +application's C runtime (in stead of the stderr channel of the +C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR +with \fBTcl_ConsolePanic\fR as its argument. On platforms which +only have one C runtime (almost all platforms except Windows +and Cygwin) \fBTcl_ConsolePanic\fR is equivalent to NULL. +.PP \fBTcl_SetPanicProc\fR may be used to modify the behavior of \fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the type \fBTcl_PanicProc\fR: diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1ade6ef..4d40be1 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3789,6 +3789,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) # define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) # define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) +# define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc)) # define Tcl_SetVar(interp, varName, newValue, flags) \ (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags)) # define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \ -- cgit v0.12 From 4ddfe70ae216fd2931131fd6a31a975c7219e8c2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 23 Jul 2013 12:42:52 +0000 Subject: implement for Cygwin as well --- generic/tcl.h | 2 +- unix/Makefile.in | 5 ++++- unix/configure | 2 +- unix/tcl.m4 | 2 +- win/tclWinPanic.c | 33 ++++++++++++++++++++++++--------- 5 files changed, 31 insertions(+), 13 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index af5e8f0..e593910 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2397,7 +2397,7 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); -#ifdef _WIN32 +#if defined(_WIN32) || defined(__CYGWIN__) void Tcl_ConsolePanic(const char *format, ...); #else #define Tcl_ConsolePanic ((Tcl_PanicProc *)0) diff --git a/unix/Makefile.in b/unix/Makefile.in index b5ca879..bc66f19 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1580,10 +1580,13 @@ tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c -# The following is a CYGWIN only source: +# The following are CYGWIN only sources: tclWinError.o: $(TOP_DIR)/win/tclWinError.c $(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c +tclWinPanic.o: $(TOP_DIR)/win/tclWinPanic.c + $(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinPanic.c + # DTrace support $(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @DTRACE_HDR@ diff --git a/unix/configure b/unix/configure index ef47ac5..54b1a87 100755 --- a/unix/configure +++ b/unix/configure @@ -7170,7 +7170,7 @@ fi SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o" + DL_OBJS="tclLoadDl.o tclWinError.o tclWinPanic.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" diff --git a/unix/tcl.m4 b/unix/tcl.m4 index b9b6532..d1f9b66 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1224,7 +1224,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o" + DL_OBJS="tclLoadDl.o tclWinError.o tclWinPanic.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c index bc59d75..3c2e072 100644 --- a/win/tclWinPanic.c +++ b/win/tclWinPanic.c @@ -34,11 +34,13 @@ Tcl_ConsolePanic( const char *format, ...) { #define TCL_MAX_WARN_LEN 26000 - DWORD dummy; va_list argList; WCHAR msgString[TCL_MAX_WARN_LEN]; char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; +#ifndef __CYGWIN__ HANDLE handle = GetStdHandle(STD_ERROR_HANDLE); + DWORD dummy; +#endif va_start(argList, format); vsnprintf(buf+3, sizeof(buf)-3, format, argList); @@ -56,23 +58,36 @@ Tcl_ConsolePanic( if (IsDebuggerPresent()) { OutputDebugStringW(msgString); +#ifdef __CYGWIN__ + } else { + buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */ + write(2, buf, strlen(buf)); + fsync(2); +#else } else if (_isatty(2)) { WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); } else { buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */ WriteFile(handle, buf, strlen(buf), &dummy, 0); FlushFileBuffers(handle); +#endif } -#if defined(__GNUC__) - __builtin_trap(); -#elif defined(_WIN64) - __debugbreak(); -#elif defined(_MSC_VER) - _asm {int 3} +#if defined(_WIN32) || defined(__CYGWIN__) +# if defined(__GNUC__) + __builtin_trap(); +# elif defined(_WIN64) + __debugbreak(); +# elif defined(_MSC_VER) + _asm {int 3} +# else + DebugBreak(); +# endif +#endif +#if defined(_WIN32) + ExitProcess(1); #else - DebugBreak(); + abort(); #endif - ExitProcess(1); } /* * Local Variables: -- cgit v0.12 From 017b8b10b611c4b8dbcbeaadc07559ace4a5e346 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Jul 2013 14:14:34 +0000 Subject: Fix Cygwin build: put Tcl_ConsolePanic in the stub library, not the dll. --- unix/Makefile.in | 4 ++-- unix/configure | 8 ++++++-- unix/tcl.m4 | 5 ++++- 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index bc66f19..578a896 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -335,7 +335,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o -STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS} +STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS} @STUB_OBJS@ UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ @@ -1585,7 +1585,7 @@ tclWinError.o: $(TOP_DIR)/win/tclWinError.c $(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c tclWinPanic.o: $(TOP_DIR)/win/tclWinPanic.c - $(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinPanic.c + $(CC) -c $(CC_SWITCHES) -DBUILD_STATIC $(TOP_DIR)/win/tclWinPanic.c # DTrace support diff --git a/unix/configure b/unix/configure index 54b1a87..944b342 100755 --- a/unix/configure +++ b/unix/configure @@ -308,7 +308,7 @@ ac_includes_default="\ # include #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS STUB_OBJS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' ac_subst_files='' # Initialize some variables set by options. @@ -7170,7 +7170,9 @@ fi SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o tclWinPanic.o" + DL_OBJS="tclLoadDl.o" + PLAT_OBJS="tclWinError.o" + STUB_OBJS="tclWinPanic.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -9293,6 +9295,7 @@ _ACEOF + cat >>confdefs.h <<_ACEOF #define TCL_SHLIB_EXT "${SHLIB_SUFFIX}" _ACEOF @@ -20118,6 +20121,7 @@ s,@DL_LIBS@,$DL_LIBS,;t t s,@DL_OBJS@,$DL_OBJS,;t t s,@PLAT_OBJS@,$PLAT_OBJS,;t t s,@PLAT_SRCS@,$PLAT_SRCS,;t t +s,@STUB_OBJS@,$STUB_OBJS,;t t s,@LDAIX_SRC@,$LDAIX_SRC,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t diff --git a/unix/tcl.m4 b/unix/tcl.m4 index d1f9b66..dd8e682 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1224,7 +1224,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o tclWinPanic.o" + DL_OBJS="tclLoadDl.o" + PLAT_OBJS="tclWinError.o" + STUB_OBJS="tclWinPanic.o" DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -2106,6 +2108,7 @@ dnl # preprocessing tests use only CPPFLAGS. AC_SUBST(DL_OBJS) AC_SUBST(PLAT_OBJS) AC_SUBST(PLAT_SRCS) + AC_SUBST(STUB_OBJS) AC_SUBST(LDAIX_SRC) AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) -- cgit v0.12 From a6c0992f472a7690735859d61d05cd042ecd43c1 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 31 Jul 2013 20:03:43 +0000 Subject: Added tests --- tests/info.test | 95 ++++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 88 insertions(+), 7 deletions(-) diff --git a/tests/info.test b/tests/info.test index 3057dd2..ef6bba9 100644 --- a/tests/info.test +++ b/tests/info.test @@ -33,7 +33,7 @@ namespace eval test_ns_info1 { proc p {x} {return "x=$x"} proc q {{y 27} {z {}}} {return "y=$y"} } - + test info-1.1 {info args option} { proc t1 {a bbb c} {return foo} info args t1 @@ -110,7 +110,7 @@ test info-2.6 {info body option, returning list bodies} { proc testinfocmdcount {} { set x [info cmdcount] set y 12345 - set z [info cm] + set z [info cmdc] expr {$z-$x} } test info-3.1 {info cmdcount compiled} { @@ -119,7 +119,7 @@ test info-3.1 {info cmdcount compiled} { test info-3.2 {info cmdcount evaled} -body { set x [info cmdcount] set y 12345 - set z [info cm] + set z [info cmdc] expr {$z-$x} } -cleanup {unset x y z} -result 4 test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4 @@ -678,16 +678,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body { } -result {wrong # args: should be "info subcommand ?arg ...?"} test info-21.2 {miscellaneous error conditions} -returnCodes error -body { info gorp -} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.3 {miscellaneous error conditions} -returnCodes error -body { info c -} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.4 {miscellaneous error conditions} -returnCodes error -body { info l -} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.5 {miscellaneous error conditions} -returnCodes error -body { info s -} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} ## # ### ### ### ######### ######### ######### @@ -2396,6 +2396,87 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body { } -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- +namespace eval ::testinfocmdtype { + apply {cmds { + foreach c $cmds {rename $c {}} + } ::testinfocmdtype} [info commands ::testinfocmdtype::*] +} +test info-40.1 {info cmdtype: syntax} -body { + info cmdtype +} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"} +test info-40.2 {info cmdtype: syntax} -body { + info cmdtype foo bar +} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"} +test info-40.3 {info cmdtype: no such command} -body { + info cmdtype ::testinfocmdtype::foo +} -returnCodes error -result {unknown command "::testinfocmdtype::foo"} +test info-40.4 {info cmdtype: native commands} -body { + info cmdtype ::if +} -result native +test info-40.5 {info cmdtype: native commands} -body { + info cmdtype ::puts +} -result native +test info-40.6 {info cmdtype: native commands} -body { + info cmdtype ::yield +} -result native +test info-40.7 {info cmdtype: procedures} -setup { + proc ::testinfocmdtype::someproc {} {} +} -body { + info cmdtype ::testinfocmdtype::someproc +} -cleanup { + rename ::testinfocmdtype::someproc {} +} -result proc +test info-40.8 {info cmdtype: aliases} -setup { + interp alias {} ::testinfocmdtype::somealias {} ::puts +} -body { + info cmdtype ::testinfocmdtype::somealias +} -cleanup { + rename ::testinfocmdtype::somealias {} +} -result alias +test info-40.9 {info cmdtype: imports} -setup { + namespace eval ::testinfocmdtype { + namespace eval foo { + proc bar {} {} + namespace export bar + } + namespace import foo::bar + } +} -body { + info cmdtype ::testinfocmdtype::bar +} -cleanup { + rename ::testinfocmdtype::bar {} + namespace delete ::testinfocmdtype::foo +} -result import +test info-40.10 {info cmdtype: slaves} -setup { + apply {i { + rename $i ::testinfocmdtype::slave + variable ::testinfocmdtype::slave $i + }} [interp create] +} -body { + info cmdtype ::testinfocmdtype::slave +} -cleanup { + interp delete $::testinfocmdtype::slave +} -result slave +test info-40.11 {info cmdtype: objects} -setup { + apply {{} { + oo::object create obj + } ::testinfocmdtype} +} -body { + info cmdtype ::testinfocmdtype::obj +} -cleanup { + ::testinfocmdtype::obj destroy +} -result object +test info-40.12 {info cmdtype: objects} -setup { + apply {{} { + oo::object create obj + } ::testinfocmdtype} +} -body { + info cmdtype [info object namespace ::testinfocmdtype::obj]::my +} -cleanup { + ::testinfocmdtype::obj destroy +} -result privateObject + +# ------------------------------------------------------------------------- unset -nocomplain res # cleanup -- cgit v0.12 From f8e147cb73f34eb486c128a840ceddacdee2677b Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 1 Aug 2013 06:44:24 +0000 Subject: Improving the test suite for [info cmdtype]. --- tests/info.test | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/info.test b/tests/info.test index ef6bba9..f3517f9 100644 --- a/tests/info.test +++ b/tests/info.test @@ -2475,6 +2475,34 @@ test info-40.12 {info cmdtype: objects} -setup { } -cleanup { ::testinfocmdtype::obj destroy } -result privateObject +test info-40.13 {info cmdtype: ensembles} -setup { + namespace eval ::testinfocmdtype { + namespace eval ensmbl { + proc bar {} {} + namespace export * + namespace ensemble create + } + } +} -body { + info cmdtype ::testinfocmdtype::ensmbl +} -cleanup { + namespace delete ::testinfocmdtype::ensmbl +} -result ensemble +test info-40.14 {info cmdtype: dynamic behavior} -setup { + proc ::testinfocmdtype::foo {} {} +} -body { + namespace eval ::testinfocmdtype { + list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \ + [namespace which foo] [rename foo bar] [namespace which bar] \ + [catch {info cmdtype foo}] [catch {info cmdtype bar}] + } +} -cleanup { + namespace eval ::testinfocmdtype { + catch {rename foo {}} + catch {rename bar {}} + } +} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0} +namespace delete ::testinfocmdtype # ------------------------------------------------------------------------- unset -nocomplain res -- cgit v0.12 From f370c68d92b4669981b3fa2574a2e32fa1911595 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 1 Aug 2013 13:21:04 +0000 Subject: Support type discovery in coroutines. --- generic/tclBasic.c | 8 ++++++-- generic/tclZlib.c | 6 ++++++ tests/info.test | 20 ++++++++++++++++++-- 3 files changed, 30 insertions(+), 4 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3dfb639..97cdc51 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -533,6 +533,7 @@ Tcl_CreateInterp(void) TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* @@ -1068,12 +1069,15 @@ TclGetCommandTypeName( Tcl_Command command) { Command *cmdPtr = (Command *) command; + void *procPtr = cmdPtr->objProc; const char *name = "native"; + if (procPtr == NULL) { + procPtr = cmdPtr->nreProc; + } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, - (void *) cmdPtr->objProc); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); if (hPtr && Tcl_GetHashValue(hPtr)) { name = (const char *) Tcl_GetHashValue(hPtr); diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 9bceb4c..4907b45 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3868,6 +3868,12 @@ TclZlibInit( Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1"); /* + * Allow command type introspection to do something sensible with streams. + */ + + TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream"); + + /* * Formally provide the package as a Tcl built-in. */ diff --git a/tests/info.test b/tests/info.test index f3517f9..7cd6678 100644 --- a/tests/info.test +++ b/tests/info.test @@ -19,9 +19,9 @@ if {{::tcltest} ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } - ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +testConstraint zlib [llength [info commands zlib]] # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. @@ -2488,7 +2488,23 @@ test info-40.13 {info cmdtype: ensembles} -setup { } -cleanup { namespace delete ::testinfocmdtype::ensmbl } -result ensemble -test info-40.14 {info cmdtype: dynamic behavior} -setup { +test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup { + namespace eval ::testinfocmdtype { + rename [zlib stream gzip] zstream + } +} -body { + info cmdtype ::testinfocmdtype::zstream +} -cleanup { + ::testinfocmdtype::zstream close +} -result zlibStream +test info-40.15 {info cmdtype: coroutines} -setup { + coroutine ::testinfocmdtype::coro eval yield +} -body { + info cmdtype ::testinfocmdtype::coro +} -cleanup { + ::testinfocmdtype::coro +} -result coroutine +test info-40.16 {info cmdtype: dynamic behavior} -setup { proc ::testinfocmdtype::foo {} {} } -body { namespace eval ::testinfocmdtype { -- cgit v0.12 From f96b9f2783963a84c437d1d8abc468d88eac3396 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 1 Aug 2013 13:27:37 +0000 Subject: And documentation --- doc/info.n | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/info.n b/doc/info.n index 42fe6c3..819991f 100644 --- a/doc/info.n +++ b/doc/info.n @@ -52,6 +52,8 @@ supported types are: .RS .IP \fBalias\fR Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. +.IP \fBcoroutine\fR +Indicates that \fIcommandName\fR was created by \fBcoroutine\fR. .IP \fBensemble\fR Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR. .IP \fBimport\fR @@ -69,6 +71,8 @@ that represents an instance of \fBoo::object\fR or one of its subclasses. Indicates that \fIcommandName\fR was created by \fBproc\fR. .IP \fBslave\fR Indicates that \fIcommandName\fR was created by \fBinterp create\fR. +.IP \fBzlibStream\fR +Indicates that \fIcommandName\fR was created by \fBzlib stream\fR. .PP There may be other registered types as well; this is a set that is extensible at the implementation level with \fBTcl_RegisterCommandTypeName\fR. -- cgit v0.12 From d0e9f9dade02ccd2ab0f1af115654739d870b0fd Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 13 Aug 2013 19:26:35 +0000 Subject: [0aa8f12dcc] Restore minimum code to stop failing tests. --- generic/tclExecute.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2cdba8a..94ee3af 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5547,6 +5547,11 @@ TEBCresume( w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 - w2; +#ifdef TCL_WIDE_INT_IS_LONG + if (Overflowing(w1, ~w2, wResult)) { + goto overflow; + } +#endif wideResultOfArithmetic: TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { @@ -7910,7 +7915,9 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = w1 - w2; +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) +#endif { /* * Must check for overflow. The macro tests for overflows -- cgit v0.12 From f218f909ad2c669b52d99149394fa31722d43926 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 14 Aug 2013 14:15:36 +0000 Subject: restore all #ifdef TCL_WIDE_INT_IS_LONG, which were accidently removed in [19ff9b95e1] --- generic/tclBasic.c | 2 ++ generic/tclCmdMZ.c | 4 +++ generic/tclExecute.c | 87 +++++++++++++++++++++++++++++++++++++++++++++++--- generic/tclIOUtil.c | 2 ++ generic/tclInt.h | 4 +++ generic/tclObj.c | 35 ++++++++++++++++++++ generic/tclProc.c | 2 ++ generic/tclStrToD.c | 4 +++ generic/tclStringObj.c | 2 ++ generic/tclTimer.c | 6 ++++ 10 files changed, 144 insertions(+), 4 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index bb175d3..fac22c3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6799,6 +6799,7 @@ ExprAbsFunc( return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt w = *((const Tcl_WideInt *) ptr); @@ -6812,6 +6813,7 @@ ExprAbsFunc( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w)); return TCL_OK; } +#endif if (type == TCL_NUMBER_BIG) { if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) { diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 40cd940..5d1820c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1565,7 +1565,9 @@ StringIsCmd( /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || +#ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || +#endif (objPtr->typePtr == &tclBignumType)) { break; } @@ -1600,7 +1602,9 @@ StringIsCmd( goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || +#ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || +#endif (objPtr->typePtr == &tclBignumType)) { break; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 94ee3af..f3d5b59 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -380,6 +380,23 @@ VarHashCreateVar( * ClientData *ptrPtr, int *tPtr); */ +#ifdef TCL_WIDE_INT_IS_LONG +#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? (*(tPtr) = TCL_NUMBER_LONG, \ + *(ptrPtr) = (ClientData) \ + (&((objPtr)->internalRep.longValue)), TCL_OK) : \ + ((objPtr)->typePtr == &tclDoubleType) \ + ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ + ? (*(tPtr) = TCL_NUMBER_NAN) \ + : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ + *(ptrPtr) = (ClientData) \ + (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ + ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ + (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ + ? TCL_ERROR : \ + TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) +#else /* !TCL_WIDE_INT_IS_LONG */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ @@ -399,6 +416,7 @@ VarHashCreateVar( (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ ? TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) +#endif /* TCL_WIDE_INT_IS_LONG */ /* * Macro used in this file to save a function call for common uses of @@ -422,6 +440,13 @@ VarHashCreateVar( * Tcl_WideInt *wideIntPtr); */ +#ifdef TCL_WIDE_INT_IS_LONG +#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? (*(wideIntPtr) = (Tcl_WideInt) \ + ((objPtr)->internalRep.longValue), TCL_OK) : \ + Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) +#else /* !TCL_WIDE_INT_IS_LONG */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclWideIntType) \ ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ @@ -429,6 +454,7 @@ VarHashCreateVar( ? (*(wideIntPtr) = (Tcl_WideInt) \ ((objPtr)->internalRep.longValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) +#endif /* TCL_WIDE_INT_IS_LONG */ /* * Macro used to make the check for type overflow more mnemonic. This works by @@ -1784,6 +1810,7 @@ TclIncrObj( TclSetLongObj(valuePtr, sum); return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG { Tcl_WideInt w1 = (Tcl_WideInt) augend; Tcl_WideInt w2 = (Tcl_WideInt) addend; @@ -1796,6 +1823,7 @@ TclIncrObj( TclSetWideIntObj(valuePtr, w1 + w2); return TCL_OK; } +#endif } if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { @@ -1815,6 +1843,7 @@ TclIncrObj( return TCL_ERROR; } +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, sum; @@ -1831,6 +1860,7 @@ TclIncrObj( return TCL_OK; } } +#endif Tcl_TakeBignumFromObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); @@ -3304,7 +3334,9 @@ TEBCresume( { Tcl_Obj *incrPtr; +#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w; +#endif long increment; case INST_INCR_SCALAR1: @@ -3424,6 +3456,7 @@ TEBCresume( } goto doneIncr; } +#ifndef TCL_WIDE_INT_IS_LONG w = (Tcl_WideInt)augend; TRACE(("%u %ld => ", opnd, increment)); @@ -3443,7 +3476,9 @@ TEBCresume( TclSetWideIntObj(objPtr, w+increment); } goto doneIncr; +#endif } /* end if (type == TCL_NUMBER_LONG) */ +#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt sum; @@ -3475,6 +3510,7 @@ TEBCresume( goto doneIncr; } } +#endif } if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ @@ -5541,6 +5577,15 @@ TEBCresume( w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 + w2; +#ifdef TCL_WIDE_INT_IS_LONG + /* + * Check for overflow. + */ + + if (Overflowing(w1, w2, wResult)) { + goto overflow; + } +#endif goto wideResultOfArithmetic; case INST_SUB: @@ -5548,9 +5593,9 @@ TEBCresume( w2 = (Tcl_WideInt) l2; wResult = w1 - w2; #ifdef TCL_WIDE_INT_IS_LONG - if (Overflowing(w1, ~w2, wResult)) { - goto overflow; - } + if (Overflowing(w1, ~w2, wResult)) { + goto overflow; + } #endif wideResultOfArithmetic: TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -7083,6 +7128,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } } +#ifndef TCL_WIDE_INT_IS_LONG if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *)ptr1); if (type2 != TCL_NUMBER_BIG) { @@ -7127,6 +7173,7 @@ ExecuteExtendedBinaryMathOp( mp_clear(&big2); return NULL; } +#endif Tcl_GetBignumFromObj(NULL, valuePtr, &big1); Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); @@ -7156,9 +7203,11 @@ ExecuteExtendedBinaryMathOp( case TCL_NUMBER_LONG: invalid = (*((const long *)ptr2) < 0L); break; +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; +#endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); invalid = (mp_cmp_d(&big2, 0) == MP_LT); @@ -7238,9 +7287,11 @@ ExecuteExtendedBinaryMathOp( case TCL_NUMBER_LONG: zero = (*(const long *)ptr1 > 0L); break; +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; +#endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); zero = (mp_cmp_d(&big1, 0) == MP_GT); @@ -7257,6 +7308,7 @@ ExecuteExtendedBinaryMathOp( } shift = (int)(*(const long *)ptr2); +#ifndef TCL_WIDE_INT_IS_LONG /* * Handle shifts within the native wide range. */ @@ -7271,6 +7323,7 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(w1 >> shift); } +#endif } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); @@ -7438,6 +7491,7 @@ ExecuteExtendedBinaryMathOp( BIG_RESULT(&bigResult); } +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -7458,6 +7512,7 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(wResult); } +#endif l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); @@ -7514,11 +7569,13 @@ ExecuteExtendedBinaryMathOp( negativeExponent = (l2 < 0); oddExponent = (int) (l2 & 1); break; +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); break; +#endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT); @@ -7608,9 +7665,11 @@ ExecuteExtendedBinaryMathOp( if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { LONG_RESULT(1L << l2); } +#if !defined(TCL_WIDE_INT_IS_LONG) if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) { WIDE_RESULT(((Tcl_WideInt) 1) << l2); } +#endif goto overflowExpon; } if (l1 == -2) { @@ -7623,9 +7682,11 @@ ExecuteExtendedBinaryMathOp( if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { LONG_RESULT(signum * (1L << l2)); } +#if !defined(TCL_WIDE_INT_IS_LONG) if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2)); } +#endif goto overflowExpon; } #if (LONG_MAX == 0x7fffffff) @@ -7697,11 +7758,13 @@ ExecuteExtendedBinaryMathOp( } #endif } -#if (LONG_MAX > 0x7fffffff) +#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) if (type1 == TCL_NUMBER_LONG) { w1 = l1; +#ifndef TCL_WIDE_INT_IS_LONG } else if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); +#endif } else { goto overflowExpon; } @@ -7901,7 +7964,9 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = w1 + w2; +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) +#endif { /* * Check for overflow. @@ -8041,10 +8106,12 @@ ExecuteExtendedUnaryMathOp( switch (opcode) { case INST_BITNOT: +#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } +#endif Tcl_TakeBignumFromObj(NULL, valuePtr, &big); /* ~a = - a - 1 */ mp_neg(&big, &big); @@ -8061,6 +8128,7 @@ ExecuteExtendedUnaryMathOp( } TclBNInitBignumFromLong(&big, *(const long *) ptr); break; +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w = *((const Tcl_WideInt *) ptr); if (w != LLONG_MIN) { @@ -8068,6 +8136,7 @@ ExecuteExtendedUnaryMathOp( } TclBNInitBignumFromWideInt(&big, w); break; +#endif default: Tcl_TakeBignumFromObj(NULL, valuePtr, &big); } @@ -8111,7 +8180,9 @@ TclCompareTwoNumbers( mp_int big1, big2; double d1, d2, tmp; long l1, l2; +#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w1, w2; +#endif (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); @@ -8124,10 +8195,12 @@ TclCompareTwoNumbers( l2 = *((const long *)ptr2); longCompare: return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); w1 = (Tcl_WideInt)l1; goto wideCompare; +#endif case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); d1 = (double) l1; @@ -8174,6 +8247,7 @@ TclCompareTwoNumbers( return compare; } +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w1 = *((const Tcl_WideInt *)ptr1); switch (type2) { @@ -8210,6 +8284,7 @@ TclCompareTwoNumbers( mp_clear(&big2); return compare; } +#endif case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); @@ -8233,6 +8308,7 @@ TclCompareTwoNumbers( } l1 = (long) d1; goto longCompare; +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; @@ -8248,6 +8324,7 @@ TclCompareTwoNumbers( } w1 = (Tcl_WideInt) d1; goto wideCompare; +#endif case TCL_NUMBER_BIG: if (TclIsInfinite(d1)) { return (d1 > 0.0) ? MP_GT : MP_LT; @@ -8275,7 +8352,9 @@ TclCompareTwoNumbers( case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: +#endif case TCL_NUMBER_LONG: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index adbfe07..a8dd484 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -267,6 +267,7 @@ Tcl_Stat( ret = Tcl_FSStat(pathPtr, &buf); Tcl_DecrRefCount(pathPtr); if (ret != -1) { +#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt tmp1, tmp2, tmp3 = 0; # define OUT_OF_RANGE(x) \ @@ -304,6 +305,7 @@ Tcl_Stat( # undef OUT_OF_RANGE # undef OUT_OF_URANGE +#endif /* !TCL_WIDE_INT_IS_LONG */ /* * Copy across all supported fields, with possible type coercions on diff --git a/generic/tclInt.h b/generic/tclInt.h index fa6af8e..060b4bc 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2632,7 +2632,9 @@ MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclArraySearchType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; +#ifndef TCL_WIDE_INT_IS_LONG MODULE_SCOPE const Tcl_ObjType tclWideIntType; +#endif MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; @@ -4381,6 +4383,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * value of strings like: "yes", "no", "true", "false", "on", "off". */ +#ifndef TCL_WIDE_INT_IS_LONG #define TclSetWideIntObj(objPtr, w) \ do { \ TclInvalidateStringRep(objPtr); \ @@ -4388,6 +4391,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ (objPtr)->typePtr = &tclWideIntType; \ } while (0) +#endif #define TclSetDoubleObj(objPtr, d) \ do { \ diff --git a/generic/tclObj.c b/generic/tclObj.c index cd75d8d..224503d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -212,8 +212,10 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); +#ifndef TCL_WIDE_INT_IS_LONG static void UpdateStringOfWideInt(Tcl_Obj *objPtr); static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +#endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); @@ -270,6 +272,7 @@ const Tcl_ObjType tclIntType = { UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; +#ifndef TCL_WIDE_INT_IS_LONG const Tcl_ObjType tclWideIntType = { "wideInt", /* name */ NULL, /* freeIntRepProc */ @@ -277,6 +280,7 @@ const Tcl_ObjType tclWideIntType = { UpdateStringOfWideInt, /* updateStringProc */ SetWideIntFromAny /* setFromAnyProc */ }; +#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ @@ -406,7 +410,9 @@ TclInitObjSubsystem(void) /* For backward compatibility only ... */ Tcl_RegisterObjType(&oldBooleanType); +#ifndef TCL_WIDE_INT_IS_LONG Tcl_RegisterObjType(&tclWideIntType); +#endif #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); @@ -1909,10 +1915,12 @@ Tcl_GetBooleanFromObj( *boolPtr = 1; return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } +#endif } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0))); return TCL_ERROR; @@ -1962,9 +1970,11 @@ TclSetBooleanFromAny( goto badBoolean; } +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { goto badBoolean; } +#endif if (objPtr->typePtr == &tclDoubleType) { goto badBoolean; @@ -2292,10 +2302,12 @@ Tcl_GetDoubleFromObj( *dblPtr = TclBignumToDouble(&big); return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *dblPtr = (double) objPtr->internalRep.wideValue; return TCL_OK; } +#endif } while (SetDoubleFromAny(interp, objPtr) == TCL_OK); return TCL_ERROR; } @@ -2749,6 +2761,7 @@ Tcl_GetLongFromObj( *longPtr = objPtr->internalRep.longValue; return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { /* * We return any integer in the range -ULONG_MAX to ULONG_MAX @@ -2767,6 +2780,7 @@ Tcl_GetLongFromObj( } goto tooLarge; } +#endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2805,7 +2819,9 @@ Tcl_GetLongFromObj( return TCL_OK; } } +#ifndef TCL_WIDE_INT_IS_LONG tooLarge: +#endif if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_Obj *msg = Tcl_NewStringObj(s, -1); @@ -2819,6 +2835,7 @@ Tcl_GetLongFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } +#ifndef TCL_WIDE_INT_IS_LONG /* *---------------------------------------------------------------------- @@ -2860,6 +2877,7 @@ UpdateStringOfWideInt( memcpy(objPtr->bytes, buffer, len + 1); objPtr->length = len; } +#endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- @@ -3014,7 +3032,14 @@ Tcl_SetWideIntObj( && (wideValue <= (Tcl_WideInt) LONG_MAX)) { TclSetLongObj(objPtr, (long) wideValue); } else { +#ifndef TCL_WIDE_INT_IS_LONG TclSetWideIntObj(objPtr, wideValue); +#else + mp_int big; + + TclBNInitBignumFromWideInt(&big, wideValue); + Tcl_SetBignumObj(objPtr, &big); +#endif } } @@ -3047,10 +3072,12 @@ Tcl_GetWideIntFromObj( /* Place to store resulting long. */ { do { +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } +#endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue; return TCL_OK; @@ -3105,6 +3132,7 @@ Tcl_GetWideIntFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } +#ifndef TCL_WIDE_INT_IS_LONG /* *---------------------------------------------------------------------- @@ -3130,6 +3158,7 @@ SetWideIntFromAny( Tcl_WideInt w; return Tcl_GetWideIntFromObj(interp, objPtr, &w); } +#endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- @@ -3377,11 +3406,13 @@ GetBignumFromObj( TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue); return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } +#endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3514,6 +3545,7 @@ Tcl_SetBignumObj( return; } tooLargeForLong: +#ifndef TCL_WIDE_INT_IS_LONG if ((size_t) bignumValue->used <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) { Tcl_WideUInt value = 0; @@ -3539,6 +3571,7 @@ Tcl_SetBignumObj( return; } tooLargeForWide: +#endif TclInvalidateStringRep(objPtr); TclFreeIntRep(objPtr); TclSetBignumIntRep(objPtr, bignumValue); @@ -3624,11 +3657,13 @@ TclGetNumberFromObj( *clientDataPtr = &objPtr->internalRep.longValue; return TCL_OK; } +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } +#endif if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, diff --git a/generic/tclProc.c b/generic/tclProc.c index 29315b4..10d5fef 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -837,7 +837,9 @@ TclObjGetFrame( } /* TODO: Consider skipping the typePtr checks */ } else if (objPtr->typePtr == &tclIntType +#ifndef TCL_WIDE_INT_IS_LONG || objPtr->typePtr == &tclWideIntType +#endif ) { if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) { goto levelError; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 388fff6..30a72ba 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1172,6 +1172,7 @@ TclParseNumber( if (!octalSignificandOverflow) { if (octalSignificandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { +#ifndef TCL_WIDE_INT_IS_LONG if (octalSignificandWide <= (MOST_BITS + signum)) { objPtr->typePtr = &tclWideIntType; if (signum) { @@ -1183,6 +1184,7 @@ TclParseNumber( } break; } +#endif TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); octalSignificandOverflow = 1; @@ -1217,6 +1219,7 @@ TclParseNumber( if (!significandOverflow) { if (significandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { +#ifndef TCL_WIDE_INT_IS_LONG if (significandWide <= MOST_BITS+signum) { objPtr->typePtr = &tclWideIntType; if (signum) { @@ -1228,6 +1231,7 @@ TclParseNumber( } break; } +#endif TclBNInitBignumFromWideUInt(&significandBig, significandWide); significandOverflow = 1; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 3c3f1a6..16d0a17 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1918,8 +1918,10 @@ Tcl_AppendFormatToObj( useBig = 1; format += step; step = Tcl_UtfToUniChar(format, &ch); +#ifndef TCL_WIDE_INT_IS_LONG } else { useWide = 1; +#endif } } diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 1a88836..2d1cd33 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -819,7 +819,9 @@ Tcl_AfterObjCmd( */ if (objv[1]->typePtr == &tclIntType +#ifndef TCL_WIDE_INT_IS_LONG || objv[1]->typePtr == &tclWideIntType +#endif || objv[1]->typePtr == &tclBignumType || (Tcl_GetIndexFromObjStruct(NULL, objv[1], afterSubCmds, sizeof(char *), "", 0, &index) != TCL_OK)) { @@ -1043,9 +1045,11 @@ AfterDelay( if (iPtr->limit.timeEvent == NULL || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); +#ifndef TCL_WIDE_INT_IS_LONG if (diff > LONG_MAX) { diff = LONG_MAX; } +#endif if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } @@ -1056,9 +1060,11 @@ AfterDelay( } else break; } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); +#ifndef TCL_WIDE_INT_IS_LONG if (diff > LONG_MAX) { diff = LONG_MAX; } +#endif if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } -- cgit v0.12 From 4434155b9fa422c2a56fb6259b439eaa2bddffc0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 13 Oct 2013 15:32:46 +0000 Subject: Add note to ChangeLog, copied from Tcl 8.6 ChangeLog note --- ChangeLog | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/ChangeLog b/ChangeLog index 7b1cb0f..b11d763 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,26 @@ +A NOTE ON THE CHANGELOG: +Starting in early 2011, Tcl source code has been under the management of +fossil, hosted at http://core.tcl.tk/tcl/ . Fossil presents a "Timeline" +view of changes made that is superior in every way to a hand edited log file. +Because of this, many Tcl developers are now out of the habit of maintaining +this log file. You may still find useful things in it, but the Timeline is +a better first place to look now. +============================================================================ + +2013-09-19 Don Porter + + *** 8.6.1 TAGGED FOR RELEASE *** + + * generic/tcl.h: Bump version number to 8.6.1. + * library/init.tcl: + * unix/configure.in: + * win/configure.in: + * unix/tcl.spec: + * README: + + * unix/configure: autoconf-2.59 + * win/configure: + 2013-09-19 Donal Fellows * doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected -- cgit v0.12 From 92258c44a5e7dad291fc4bad16f414cf32d96303 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 13 Oct 2013 16:19:44 +0000 Subject: The Tcl 9.0 way of how [dfc08326e3] should be fixed: Real integration of TclOO in Tcl means that calling the function Tcl_OOInitStubs() should be elminated in full. This branch shows how to do that. --- generic/tcl.decls | 3 +- generic/tclDecls.h | 1 + generic/tclOO.h | 9 +---- generic/tclOOStubLib.c | 71 ------------------------------------ generic/tclStubInit.c | 10 ++++- generic/tclStubLib.c | 13 +++++++ macosx/Tcl.xcode/project.pbxproj | 4 -- macosx/Tcl.xcodeproj/project.pbxproj | 4 -- unix/Makefile.in | 7 +--- win/Makefile.in | 6 +-- win/makefile.bc | 6 +-- win/makefile.vc | 6 +-- win/tcl.dsp | 4 -- 13 files changed, 31 insertions(+), 113 deletions(-) delete mode 100644 generic/tclOOStubLib.c diff --git a/generic/tcl.decls b/generic/tcl.decls index 734aae7..005b513 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -18,9 +18,10 @@ library tcl # tclPlat - platform specific public # tclInt - generic private # tclPlatInt - platform specific private +# tclOO - tclOO public interface tcl -hooks {tclPlat tclInt tclIntPlat} +hooks {tclPlat tclInt tclIntPlat tclOO} scspec TCLAPI # Declare each of the functions in the public Tcl interface. Note that diff --git a/generic/tclDecls.h b/generic/tclDecls.h index e38f752..673726b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1731,6 +1731,7 @@ typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; + const struct TclOOStubs *tclOOStubs; } TclStubHooks; typedef struct TclStubs { diff --git a/generic/tclOO.h b/generic/tclOO.h index a6e8a22..b8aa974 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -37,13 +37,8 @@ extern "C" { #endif -extern const char *TclOOInitializeStubs( - Tcl_Interp *, const char *version); -#define Tcl_OOInitStubs(interp) \ - TclOOInitializeStubs((interp), TCLOO_VERSION) -#ifndef USE_TCL_STUBS -# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) -#endif +#define Tcl_OOInitStubs(interp) (TCLOO_PATCHLEVEL) +#define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) /* * These are opaque types. diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c deleted file mode 100644 index a9fa212..0000000 --- a/generic/tclOOStubLib.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 - */ - -#include "tclOOInt.h" - -MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; -MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; - -const TclOOStubs *tclOOStubsPtr = NULL; -const TclOOIntStubs *tclOOIntStubsPtr = NULL; - -/* - *---------------------------------------------------------------------- - * - * TclOOInitializeStubs -- - * Load the tclOO package, initialize stub table pointer. Do not call - * this function directly, use Tcl_OOInitStubs() macro instead. - * - * Results: - * The actual version of the package that satisfies the request, or NULL - * to indicate that an error occurred. - * - * Side effects: - * Sets the stub table pointers. - * - *---------------------------------------------------------------------- - */ - -#undef TclOOInitializeStubs - -MODULE_SCOPE const char * -TclOOInitializeStubs( - Tcl_Interp *interp, - const char *version) -{ - int exact = 0; - const char *packageName = "TclOO"; - const char *errMsg = NULL; - TclOOStubs *stubsPtr = NULL; - const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, - packageName, version, exact, &stubsPtr); - - if (actualVersion == NULL) { - return NULL; - } - if (stubsPtr == NULL) { - errMsg = "missing stub table pointer"; - } else { - tclOOStubsPtr = stubsPtr; - if (stubsPtr->hooks) { - tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; - } else { - tclOOIntStubsPtr = NULL; - } - return actualVersion; - } - tclStubsPtr->tcl_ResetResult(interp); - tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, - " (requested version ", version, ", actual version ", - actualVersion, "): ", errMsg, NULL); - return NULL; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 5fb501a..1ec155a 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -10,8 +10,15 @@ */ #include "tclInt.h" +#include "tclOOInt.h" #include "tommath.h" +/* + * The actual definition of the variable holding the TclOO stub table. + */ + +MODULE_SCOPE const TclOOStubs tclOOStubs; + #ifdef __GNUC__ #pragma GCC dependency "tcl.decls" #pragma GCC dependency "tclInt.decls" @@ -694,7 +701,8 @@ const TclTomMathStubs tclTomMathStubs = { static const TclStubHooks tclStubHooks = { &tclPlatStubs, &tclIntStubs, - &tclIntPlatStubs + &tclIntPlatStubs, + &tclOOStubs }; const TclStubs tclStubs = { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 3e4a5ae..6487ebb 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -12,16 +12,21 @@ */ #include "tclInt.h" +#include "tclOOInt.h" MODULE_SCOPE const TclStubs *tclStubsPtr; MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; +MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; +MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; const TclStubs *tclStubsPtr = NULL; const TclPlatStubs *tclPlatStubsPtr = NULL; const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; +const TclOOStubs *tclOOStubsPtr = NULL; +const TclOOIntStubs *tclOOIntStubsPtr = NULL; /* * Use our own ISDIGIT to avoid linking to libc on windows @@ -113,10 +118,18 @@ Tcl_InitStubs( tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = stubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs; + tclOOStubsPtr = stubsPtr->hooks->tclOOStubs; + if (tclOOStubsPtr && tclOOStubsPtr->hooks) { + tclOOIntStubsPtr = tclOOStubsPtr->hooks->tclOOIntStubs; + } else { + tclOOIntStubsPtr = NULL; + } } else { tclPlatStubsPtr = NULL; tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; + tclOOStubsPtr = NULL; + tclOOIntStubsPtr = NULL; } return actualVersion; diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index a2a703b..7fb918e 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -15,7 +15,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; @@ -209,7 +208,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = ""; }; F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = ""; }; F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = ""; }; - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = ""; }; F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = ""; }; F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = ""; }; F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = ""; }; @@ -1289,7 +1287,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, @@ -2023,7 +2020,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 9c18ac0..ddd5e3b 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -15,7 +15,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; @@ -209,7 +208,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = ""; }; F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = ""; }; F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = ""; }; - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = ""; }; F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = ""; }; F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = ""; }; F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = ""; }; @@ -1289,7 +1287,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, @@ -2023,7 +2020,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, diff --git a/unix/Makefile.in b/unix/Makefile.in index 309e229..67bbd49 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -337,7 +337,6 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ STUB_LIB_OBJS = tclStubLib.o \ tclTomMathStubLib.o \ - tclOOStubLib.o \ ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ @@ -475,8 +474,7 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ - $(GENERIC_DIR)/tclTomMathStubLib.c \ - $(GENERIC_DIR)/tclOOStubLib.c + $(GENERIC_DIR)/tclTomMathStubLib.c TOMMATH_SRCS = \ $(TOMMATH_DIR)/bncore.c \ @@ -1696,9 +1694,6 @@ tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c -tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclOOStubLib.c - .c.o: $(CC) -c $(CC_SWITCHES) $< diff --git a/win/Makefile.in b/win/Makefile.in index be82d73..6f27856 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -385,8 +385,7 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ - tclTomMathStubLib.$(OBJEXT) \ - tclOOStubLib.$(OBJEXT) + tclTomMathStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) @@ -518,9 +517,6 @@ tclStubLib.${OBJEXT}: tclStubLib.c tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) -tclOOStubLib.${OBJEXT}: tclOOStubLib.c - $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) - # Implicit rule for all object files that will end up in the Tcl library %.${OBJEXT}: %.c diff --git a/win/makefile.bc b/win/makefile.bc index f6e32f9..73fbc19 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -279,8 +279,7 @@ TCLOBJS = \ TCLSTUBOBJS = \ $(TMPDIR)\tclStubLib.obj \ - $(TMPDIR)\tclTomMathStubLib.obj \ - $(TMPDIR)\tclOOStubLib.obj + $(TMPDIR)\tclTomMathStubLib.obj WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic @@ -531,9 +530,6 @@ $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? -$(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c - $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? - # Dedependency rules diff --git a/win/makefile.vc b/win/makefile.vc index b76a939..e3851c9 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -450,8 +450,7 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ - $(TMP_DIR)\tclTomMathStubLib.obj \ - $(TMP_DIR)\tclOOStubLib.obj + $(TMP_DIR)\tclTomMathStubLib.obj ### The following paths CANNOT have spaces in them. COMPATDIR = $(ROOT)\compat @@ -982,9 +981,6 @@ $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? -$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c - $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? - #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a diff --git a/win/tcl.dsp b/win/tcl.dsp index 57ec6bf..96152b8 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1300,10 +1300,6 @@ SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File -SOURCE=..\generic\tclOOStubLib.c -# End Source File -# Begin Source File - SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File -- cgit v0.12 From 9ad2ec38c881fa95f4ca01c9dc418f3ae774700c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 13 Oct 2013 17:22:28 +0000 Subject: Fix definition of TCLAPI macro, when Tcl header files are used from within C++. --- generic/tcl.h | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index f4e503c..ba94281 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -214,9 +214,11 @@ extern "C" { */ #ifdef BUILD_tcl -# define TCLAPI DLLEXPORT +# define TCLAPI extern DLLEXPORT +#elif defined(__cplusplus) +# define TCLAPI extern "C" DLLIMPORT #else -# define TCLAPI DLLIMPORT +# define TCLAPI extern DLLIMPORT #endif /* -- cgit v0.12 From 9255d52d018204fbb2a30c0e571b72488363b0db Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Oct 2013 11:22:47 +0000 Subject: Prevent tclOOIntStubs from being exported from the shared library. --- generic/tclOODecls.h | 1 + generic/tclOOStubInit.c | 1 + 2 files changed, 2 insertions(+) diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 1ddb7c6..b93865e 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -11,6 +11,7 @@ #endif #define tclOOPrivateStubs tclOOIntStubs +#define TclOOPrivateStubs TclOOIntStubs /* !BEGIN!: Do not edit below this line. */ diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c index 33da395..7be341a 100644 --- a/generic/tclOOStubInit.c +++ b/generic/tclOOStubInit.c @@ -9,6 +9,7 @@ #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs tclOOStubs; +MODULE_SCOPE const TclOOIntStubs tclOOIntStubs; #ifdef __GNUC__ #pragma GCC dependency "tclOO.decls" -- cgit v0.12 From a8fdebc1ebedcfbc3b9d11621484b3e7582a21cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 25 Nov 2013 12:39:27 +0000 Subject: Don't depend on TCLAPI to be defined in . If this tclOODecls.h is ever installed in an Tcl 8.x environment, it still will be usable normally. --- generic/tclOODecls.h | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 1d71359..1de3e92 100755 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -5,6 +5,14 @@ #ifndef _TCLOODECLS #define _TCLOODECLS +#ifndef TCLAPI +# ifdef BUILD_tcl +# define TCLAPI extern DLLEXPORT +# else +# define TCLAPI extern DLLIMPORT +# endif +#endif + #ifdef USE_TCL_STUBS # undef USE_TCLOO_STUBS # define USE_TCLOO_STUBS -- cgit v0.12 From 4032f9d4dc2aca9190b3745cf67ef709accecdc6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 25 Nov 2013 13:02:54 +0000 Subject: Take over "changes" and "doc/file.n" from trunk, it should have been merged to "novem" already. --- changes | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- doc/file.n | 2 +- 2 files changed, 139 insertions(+), 2 deletions(-) diff --git a/changes b/changes index d3bbb43..659319c 100644 --- a/changes +++ b/changes @@ -8164,6 +8164,143 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows) --- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- -2013-05-08 (bug fix)[3036566] Honor language packs on Vista+ to get initial locale (oehlmann) +2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd) + +2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans) + +2013-01-04 (bug fix) memleak in [format] compiler (fellows) + +2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points + +2013-01-09 (bug fix)[3599395] status line processing (nijtmans) +2013-01-23 (bug fix)[2911139] repair async connection management (fellows) +=> http 2.8.6 + +2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans) + +2013-01-28 (enhancement) improve ensemble bytecode (fellows) + +2013-01-30 (enhancement) selected script code improvements (fradin) +=> tcltest 2.3.6 + +2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries) +=> platform 1.0.11 + +2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff) + +2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin) + +2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows) + +2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows) + +2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans) +=> msgcat 1.5.1 + +2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick) + +2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter) + +2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max) + +2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane) + +2013-03-03 (bug fix)[3606258] major serial port update (english) + +2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs +(grathwohl,lane,porter) + +2013-03-12 (enhancement) better build support for Debian arch (shadura) + +2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans) + +2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin) + +2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter + +2013-04-04 (bug fix) Support URLs with query but no path (max) +=> http 2.8.7 + +2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas) + +2013-04-29 (enhancement) [array set] compile improvement (fellows) + +2013-04-30 (enhancement) broaden glibc version detection (kupries) +=> platform 1.0.12 + +2013-05-06 (platform support) Cygwin64 (nijtmans) + +2013-05-15 (enhancement) Improved [list {*}...] compile (fellows) + +2013-05-16 (platform support) mingw-4.0 (nijtmans) + +2013-05-19 (platform support) FreeBSD updates (cerutti) + +2013-05-20 (bug fix)[3613567] access error temp file creation (keene) + +2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene) + +2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows) + +2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann) => msgcat 1.5.2 +2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter) + +2013-06-03 Restored lost performance appending to long strings (elby,porter) + +2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows) + +2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans) + +2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans) + +2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang) + +2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin) + +2013-07-06 tzdata updated to Olson's tzdata2013d (kenny) + +2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter) + +2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter) + +2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane) + +2013-07-29 [string is space \u202f] => 1 (nijtmans) + +2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans) + +2013-08-01 (bug fix)[1905562] RE recursion limit increased to support +reported usage of large expressions (porter) + +2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows) + +2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows) + +2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter) + +2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter) + +2013-08-15 Errors from execution traces become errors of the command (porter) + +2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter) + +2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter) + +2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows) + +2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter) + +2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows) +=> TclOO 1.0.1 + +2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows) + +2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter) + +2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter) + +Many optmizations, improvements, and tightened stack management in bytecode. + +--- Released 8.6.1, Septemer 20, 2013 --- http://core.tcl.tk/tcl/ for details diff --git a/doc/file.n b/doc/file.n index a5a2fc8..5ff45fd 100644 --- a/doc/file.n +++ b/doc/file.n @@ -484,7 +484,7 @@ not the effective ones. .TP \fBWindows\fR\0\0\0\0 . -The \fbfile owned\fR subcommand currently always reports that the current user +The \fBfile owned\fR subcommand currently always reports that the current user is the owner of the file, without regard for what the operating system believes to be true, making an ownership test useless. This issue (#3613671) may be fixed in a future release of Tcl. -- cgit v0.12 From 50cb73a76ef1ac85f26e2ab1e3d5babd6be4e9ca Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 8 Feb 2014 15:36:53 +0000 Subject: update list of TLDs --- library/http/effective_tld_names.txt.gz | Bin 32891 -> 39188 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/library/http/effective_tld_names.txt.gz b/library/http/effective_tld_names.txt.gz index a799d16..9ce2b69 100644 Binary files a/library/http/effective_tld_names.txt.gz and b/library/http/effective_tld_names.txt.gz differ -- cgit v0.12 From 334a96f761a2768ff680d31e3cad25eaf63d9bea Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Feb 2014 12:41:05 +0000 Subject: D'oh! --- library/http/pkgIndex.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 8b48a9f..2928f88 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,4 +1,4 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]] -package ifndeeded tcl::idna 1.0 [list source [file join $dir idna.tcl]] +package ifneeded tcl::idna 1.0 [list source [file join $dir idna.tcl]] -- cgit v0.12 From 0cffbf8eb7de60da060b05ae4a06ff19adc24ad6 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Feb 2014 12:56:24 +0000 Subject: starting to write some tests --- library/http/idna.tcl | 2 +- tests/http.test | 26 ++++++++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/library/http/idna.tcl b/library/http/idna.tcl index 7727e45..2b02c33 100644 --- a/library/http/idna.tcl +++ b/library/http/idna.tcl @@ -17,7 +17,7 @@ namespace eval ::tcl::idna { encode IDNAencode decode IDNAdecode puny puny - version {::package present idna} + version {::apply {{} {package present tcl::idna} ::}} } proc IDNAencode hostname { diff --git a/tests/http.test b/tests/http.test index 45dd393..0f7cd0a 100644 --- a/tests/http.test +++ b/tests/http.test @@ -635,6 +635,32 @@ test http-7.4 {http::formatQuery} -setup { http::config -urlencoding $enc } -result {%3F} +package require -exact tcl::idna 1.0 +test http-idna-1.1 {} -returnCodes error -body { + ::tcl::idna +} -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} +test http-idna-1.2 {} -returnCodes error -body { + ::tcl::idna ? +} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} +test http-idna-1.3 {} -body { + ::tcl::idna version +} -result 1.0 +test http-idna-1.4 {} -returnCodes error -body { + ::tcl::idna version what +} -result {wrong # args: should be "::tcl::idna version"} +test http-idna-1.5 {} -returnCodes error -body { + ::tcl::idna puny +} -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} +test http-idna-1.6 {} -returnCodes error -body { + ::tcl::idna puny ? +} -result {unknown or ambiguous subcommand "?": must be decode, or encode} +test http-idna-1.7 {} -returnCodes error -body { + ::tcl::idna puny encode +} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} +test http-idna-1.8 {} -returnCodes error -body { + ::tcl::idna puny decode +} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} + # cleanup catch {unset url} catch {unset badurl} -- cgit v0.12 From ffb8dbaeee4ec56af776d3268065efb96a7611fc Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 13 Feb 2014 09:04:23 +0000 Subject: more tests for the punycode engine --- tests/http.test | 126 ++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 118 insertions(+), 8 deletions(-) diff --git a/tests/http.test b/tests/http.test index 0f7cd0a..8a94c35 100644 --- a/tests/http.test +++ b/tests/http.test @@ -636,30 +636,140 @@ test http-7.4 {http::formatQuery} -setup { } -result {%3F} package require -exact tcl::idna 1.0 -test http-idna-1.1 {} -returnCodes error -body { + +test http-idna-1.1 {IDNA package: basics} -returnCodes error -body { ::tcl::idna } -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} -test http-idna-1.2 {} -returnCodes error -body { +test http-idna-1.2 {IDNA package: basics} -returnCodes error -body { ::tcl::idna ? } -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} -test http-idna-1.3 {} -body { +test http-idna-1.3 {IDNA package: basics} -body { ::tcl::idna version } -result 1.0 -test http-idna-1.4 {} -returnCodes error -body { +test http-idna-1.4 {IDNA package: basics} -returnCodes error -body { ::tcl::idna version what } -result {wrong # args: should be "::tcl::idna version"} -test http-idna-1.5 {} -returnCodes error -body { +test http-idna-1.5 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny } -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} -test http-idna-1.6 {} -returnCodes error -body { +test http-idna-1.6 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny ? } -result {unknown or ambiguous subcommand "?": must be decode, or encode} -test http-idna-1.7 {} -returnCodes error -body { +test http-idna-1.7 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} -test http-idna-1.8 {} -returnCodes error -body { +test http-idna-1.8 {IDNA package: basics} -returnCodes error -body { + ::tcl::idna puny encode a b c +} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} +test http-idna-1.9 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny decode } -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} +test http-idna-1.10 {IDNA package: basics} -returnCodes error -body { + ::tcl::idna puny decode a b c +} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} +test http-idna-1.11 {IDNA package: basics} -returnCodes error -body { + ::tcl::idna decode +} -result {wrong # args: should be "::tcl::idna decode hostname"} +test http-idna-1.12 {IDNA package: basics} -returnCodes error -body { + ::tcl::idna encode +} -result {wrong # args: should be "::tcl::idna encode hostname"} + +test http-idna-2.1 {puny encode: functional test} { + ::tcl::idna puny encode abc +} abc- +test http-idna-2.2 {puny encode: functional test} { + ::tcl::idna puny encode a\u20acb\u20acc +} abc-k50ab +test http-idna-2.3 {puny encode: functional test} { + ::tcl::idna puny encode ABC +} ABC- +test http-idna-2.4 {puny encode: functional test} { + ::tcl::idna puny encode A\u20ACB\u20ACC +} ABC-k50ab +test http-idna-2.5 {puny encode: functional test} { + ::tcl::idna puny encode ABC 0 +} abc- +test http-idna-2.6 {puny encode: functional test} { + ::tcl::idna puny encode A\u20ACB\u20ACC 0 +} abc-k50ab +test http-idna-2.7 {puny encode: functional test} { + ::tcl::idna puny encode ABC 1 +} ABC- +test http-idna-2.8 {puny encode: functional test} { + ::tcl::idna puny encode A\u20ACB\u20ACC 1 +} ABC-k50ab +test http-idna-2.9 {puny encode: functional test} { + ::tcl::idna puny encode abc 0 +} abc- +test http-idna-2.10 {puny encode: functional test} { + ::tcl::idna puny encode a\u20ACb\u20ACc 0 +} abc-k50ab +test http-idna-2.11 {puny encode: functional test} { + ::tcl::idna puny encode abc 1 +} ABC- +test http-idna-2.12 {puny encode: functional test} { + ::tcl::idna puny encode a\u20ACb\u20ACc 1 +} ABC-k50ab +test http-idna-2.13 {puny encode: edge cases} { + ::tcl::idna puny encode "" +} "" + +test http-idna-3.1 {puny decode: functional test} { + ::tcl::idna puny decode abc- +} abc +test http-idna-3.2 {puny decode: functional test} { + ::tcl::idna puny decode abc-k50ab +} a\u20acb\u20acc +test http-idna-3.3 {puny decode: functional test} { + ::tcl::idna puny decode ABC- +} ABC +test http-idna-3.4 {puny decode: functional test} { + ::tcl::idna puny decode ABC-k50ab +} A\u20ACB\u20ACC +test http-idna-3.5 {puny decode: functional test} { + ::tcl::idna puny decode ABC-K50AB +} A\u20ACB\u20ACC +test http-idna-3.6 {puny decode: functional test} { + ::tcl::idna puny decode abc-K50AB +} a\u20ACb\u20ACc +test http-idna-3.7 {puny decode: functional test} { + ::tcl::idna puny decode ABC- 0 +} abc +test http-idna-3.8 {puny decode: functional test} { + ::tcl::idna puny decode ABC-K50AB 0 +} a\u20ACb\u20ACc +test http-idna-3.9 {puny decode: functional test} { + ::tcl::idna puny decode ABC- 1 +} ABC +test http-idna-3.10 {puny decode: functional test} { + ::tcl::idna puny decode ABC-K50AB 1 +} A\u20ACB\u20ACC +test http-idna-3.11 {puny decode: functional test} { + ::tcl::idna puny decode abc- 0 +} abc +test http-idna-3.12 {puny decode: functional test} { + ::tcl::idna puny decode abc-k50ab 0 +} a\u20ACb\u20ACc +test http-idna-3.13 {puny decode: functional test} { + ::tcl::idna puny decode abc- 1 +} ABC +test http-idna-3.14 {puny decode: functional test} { + ::tcl::idna puny decode abc-k50ab 1 +} A\u20ACB\u20ACC +test http-idna-3.15 {puny decode: edge cases and errors} { + # Is this case actually correct? + binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]] +} c282c281c280 +test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body { + ::tcl::idna puny decode abc! +} -result {bad decode character "!"} +test http-idna-3.17 {puny decode: edge cases and errors} { + catch {::tcl::idna puny decode abc!} -> opt + dict get $opt -errorcode +} {PUNYCODE BAD_INPUT} +test http-idna-3.18 {puny decode: edge cases and errors} { + ::tcl::idna puny decode "" +} {} # cleanup catch {unset url} -- cgit v0.12 From 355793810091ea96c89cee861e47d3e2b81e4bba Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 14 Feb 2014 09:03:49 +0000 Subject: more tests, now getting to the IDNA handling --- library/http/idna.tcl | 2 +- tests/http.test | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+), 1 deletion(-) diff --git a/library/http/idna.tcl b/library/http/idna.tcl index 2b02c33..a73d113 100644 --- a/library/http/idna.tcl +++ b/library/http/idna.tcl @@ -43,7 +43,7 @@ namespace eval ::tcl::idna { set parts {} # Split term from RFC 3490, Sec 3.1 foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { - if {[string match "xn--*" $part]} { + if {[string match -nocase "xn--*" $part]} { set part [punydecode [string range $part 4 end]] } lappend parts $part diff --git a/tests/http.test b/tests/http.test index 8a94c35..aa8340c 100644 --- a/tests/http.test +++ b/tests/http.test @@ -770,6 +770,52 @@ test http-idna-3.17 {puny decode: edge cases and errors} { test http-idna-3.18 {puny decode: edge cases and errors} { ::tcl::idna puny decode "" } {} + +test http-idna-4.1 {IDNA encoding} { + ::tcl::idna encode abc.def +} abc.def +test http-idna-4.2 {IDNA encoding} { + ::tcl::idna encode a\u20acb\u20acc.def +} xn--abc-k50ab.def +test http-idna-4.3 {IDNA encoding} { + ::tcl::idna encode def.a\u20acb\u20acc +} def.xn--abc-k50ab +test http-idna-4.4 {IDNA encoding} { + ::tcl::idna encode ABC.DEF +} ABC.DEF +test http-idna-4.5 {IDNA encoding} { + ::tcl::idna encode A\u20acB\u20acC.def +} xn--ABC-k50ab.def +test http-idna-4.6 {IDNA encoding: invalid edge case} { + # Should this be an error? + ::tcl::idna encode abc..def +} abc..def +test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body { + ::tcl::idna encode abc.$.def +} -result {bad character "$" in DNS name} +test http-idna-4.7.1 {IDNA encoding: invalid char} { + catch {::tcl::idna encode abc.$.def} -> opt + dict get $opt -errorcode +} {IDNA INVALID_NAME_CHARACTER 36} +test http-idna-4.8 {IDNA encoding: empty} { + ::tcl::idna encode "" +} {} + +test http-idna-5.1 {IDNA decoding} { + ::tcl::idna decode abc.def +} abc.def +test http-idna-5.2 {IDNA decoding} { + # Invalid entry that's just a wrapper + ::tcl::idna decode xn--abc-.def +} abc.def +test http-idna-5.3 {IDNA decoding} { + # Invalid entry that's just a wrapper + ::tcl::idna decode xn--abc-.xn--def- +} abc.def +test http-idna-5.4 {IDNA decoding} { + # Invalid entry that's just a wrapper + ::tcl::idna decode XN--abc-.XN--def- +} abc.def # cleanup catch {unset url} -- cgit v0.12 From 1c6910c2ec785c4ed4dbd27ed84206e43c7186c6 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 15 Feb 2014 10:02:43 +0000 Subject: add the test cases from RFC 3492 --- tests/http.test | 233 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 233 insertions(+) diff --git a/tests/http.test b/tests/http.test index aa8340c..a1da46b 100644 --- a/tests/http.test +++ b/tests/http.test @@ -713,6 +713,125 @@ test http-idna-2.12 {puny encode: functional test} { test http-idna-2.13 {puny encode: edge cases} { ::tcl::idna puny encode "" } "" +test http-idna-2.14-A {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 + u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F + }]] ""] +} egbpdaj6bu4bxfgehfvwxn +test http-idna-2.14-B {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587 + }]] ""] +} ihqwcrb4cv8a8dqg056pqjye +test http-idna-2.14-C {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587 + }]] ""] +} ihqwctvzc91f659drss3x8bo0yb +test http-idna-2.14-D {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 + u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D + u+0065 u+0073 u+006B u+0079 + }]] ""] +} Proprostnemluvesky-uyb24dma41a +test http-idna-2.14-E {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 + u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 + u+05D1 u+05E8 u+05D9 u+05EA + }]] ""] +} 4dbcagdahymbxekheh6e0a7fei0b +test http-idna-2.14-F {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D + u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 + u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 + u+0939 u+0948 u+0902 + }]] ""] +} i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd +test http-idna-2.14-G {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 + u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B + }]] ""] +} n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa +test http-idna-2.14-H {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 + u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 + u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C + }]] ""] +} 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c +test http-idna-2.14-I {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E + u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 + u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A + u+0438 + }]] ""] +} b1abfaaepdrnnbgefbadotcwatmq2g4l +test http-idna-2.14-J {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 + u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 + u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061 + u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 + u+0061 u+00F1 u+006F u+006C + }]] ""] +} PorqunopuedensimplementehablarenEspaol-fmd56a +test http-idna-2.14-K {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B + u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 + u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 + u+0056 u+0069 u+1EC7 u+0074 + }]] ""] +} TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g +test http-idna-2.14-L {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F + }]] ""] +} 3B-ww4c5e180e575a65lsy2b +test http-idna-2.14-M {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 + u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D + u+004F u+004E u+004B u+0045 u+0059 u+0053 + }]] ""] +} -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n +test http-idna-2.14-N {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F + u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D + u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 + }]] ""] +} Hello-Another-Way--fc4qua05auwb3674vfr0b +test http-idna-2.14-O {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032 + }]] ""] +} 2-u9tlzr9756bt3uc0v +test http-idna-2.14-P {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 + u+308B u+0035 u+79D2 u+524D + }]] ""] +} MajiKoi5-783gue6qz075azm5e +test http-idna-2.14-Q {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0 + }]] ""] +} de-jg4avhby1noc0d +test http-idna-2.14-R {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode [join [subst [string map {u+ \\u} { + u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067 + }]] ""] +} d9juau41awczczp +test http-idna-2.14-S {puny encode: examples from RFC 3492} { + ::tcl::idna puny encode {-> $1.00 <-} +} {-> $1.00 <--} test http-idna-3.1 {puny decode: functional test} { ::tcl::idna puny decode abc- @@ -770,6 +889,120 @@ test http-idna-3.17 {puny decode: edge cases and errors} { test http-idna-3.18 {puny decode: edge cases and errors} { ::tcl::idna puny decode "" } {} +# A helper so we don't get lots of crap in failures +proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}} +test http-idna-3.19-A {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn] +} [list {*}{ + u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 + u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F +}] +test http-idna-3.19-B {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye] +} {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587} +test http-idna-3.19-C {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb] +} {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587} +test http-idna-3.19-D {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a] +} [list {*}{ + u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 + u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D + u+0065 u+0073 u+006B u+0079 +}] +test http-idna-3.19-E {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b] +} [list {*}{ + u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 + u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 + u+05D1 u+05E8 u+05D9 u+05EA +}] +test http-idna-3.19-F {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode \ + i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd] +} [list {*}{ + u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D + u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 + u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 + u+0939 u+0948 u+0902 +}] +test http-idna-3.19-G {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa] +} [list {*}{ + u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 + u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B +}] +test http-idna-3.19-H {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode \ + 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c] +} [list {*}{ + u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 + u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 + u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C +}] +test http-idna-3.19-I {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l] +} [list {*}{ + u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E + u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 + u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A + u+0438 +}] +test http-idna-3.19-J {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode \ + PorqunopuedensimplementehablarenEspaol-fmd56a] +} [list {*}{ + u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 + u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 + u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061 + u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 + u+0061 u+00F1 u+006F u+006C +}] +test http-idna-3.19-K {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode \ + TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g] +} [list {*}{ + u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B + u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 + u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 + u+0056 u+0069 u+1EC7 u+0074 +}] +test http-idna-3.19-L {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b] +} {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F} +test http-idna-3.19-M {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n] +} [list {*}{ + u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 + u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D + u+004F u+004E u+004B u+0045 u+0059 u+0053 +}] +test http-idna-3.19-N {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b] +} [list {*}{ + u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F + u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D + u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 +}] +test http-idna-3.19-O {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v] +} {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032} +test http-idna-3.19-P {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e] +} [list {*}{ + u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 + u+308B u+0035 u+79D2 u+524D +}] +test http-idna-3.19-Q {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode de-jg4avhby1noc0d] +} {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0} +test http-idna-3.19-R {puny decode: examples from RFC 3492} { + hexify [::tcl::idna puny decode d9juau41awczczp] +} {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067} +test http-idna-3.19-S {puny decode: examples from RFC 3492} { + ::tcl::idna puny decode {-> $1.00 <--} +} {-> $1.00 <-} +rename hexify "" test http-idna-4.1 {IDNA encoding} { ::tcl::idna encode abc.def -- cgit v0.12 From 9b6ba772240147bd21bb1c4c0173ed2f4e794f84 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 16 Feb 2014 09:04:44 +0000 Subject: extending the IDNA tests --- library/http/idna.tcl | 12 +++++++++--- tests/http.test | 31 +++++++++++++++++++++++++++++-- 2 files changed, 38 insertions(+), 5 deletions(-) diff --git a/library/http/idna.tcl b/library/http/idna.tcl index a73d113..7dfb968 100644 --- a/library/http/idna.tcl +++ b/library/http/idna.tcl @@ -30,10 +30,15 @@ namespace eval ::tcl::idna { if {$ch < "!" || $ch > "~"} { set ch [format "\\u%04x" $c] } - throw [list IDNA INVALID_NAME_CHARACTER $c] \ + throw [list IDNA INVALID_NAME_CHARACTER $ch] \ "bad character \"$ch\" in DNS name" } set part xn--[punyencode $part] + # Length restriction from RFC 5890, Sec 2.3.1 + if {[string length $part] > 63} { + throw [list IDNA OVERLONG_PART $part] \ + "hostname part too long" + } } lappend parts $part } @@ -226,7 +231,7 @@ namespace eval ::tcl::idna { for {set oldi $i; set w 1; set k $base} 1 {incr in} { if {[set ch [string index $post $in]] eq ""} { - throw {PUNYCODE BAD_INPUT} "exceeded input data" + throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data" } if {[string match -nocase {[a-z]} $ch]} { scan [string toupper $ch] %c digit @@ -234,7 +239,8 @@ namespace eval ::tcl::idna { } elseif {[string match {[0-9]} $ch]} { set digit [expr {$ch + 26}] } else { - throw {PUNYCODE BAD_INPUT} "bad decode character \"$ch\"" + throw {PUNYCODE BAD_INPUT CHAR} \ + "bad decode character \"$ch\"" } incr i [expr {$digit * $w}] set t [expr {min(max($tmin, $k-$bias), $tmax)}] diff --git a/tests/http.test b/tests/http.test index a1da46b..0f76258 100644 --- a/tests/http.test +++ b/tests/http.test @@ -885,7 +885,7 @@ test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -bod test http-idna-3.17 {puny decode: edge cases and errors} { catch {::tcl::idna puny decode abc!} -> opt dict get $opt -errorcode -} {PUNYCODE BAD_INPUT} +} {PUNYCODE BAD_INPUT CHAR} test http-idna-3.18 {puny decode: edge cases and errors} { ::tcl::idna puny decode "" } {} @@ -1029,10 +1029,23 @@ test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body { test http-idna-4.7.1 {IDNA encoding: invalid char} { catch {::tcl::idna encode abc.$.def} -> opt dict get $opt -errorcode -} {IDNA INVALID_NAME_CHARACTER 36} +} {IDNA INVALID_NAME_CHARACTER {$}} test http-idna-4.8 {IDNA encoding: empty} { ::tcl::idna encode "" } {} +set overlong www.[join [subst [string map {u+ \\u} { + u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 + u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 + u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C +}]] ""].com +test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body { + ::tcl::idna encode $overlong +} -returnCodes error -result "hostname part too long" +test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} { + catch {::tcl::idna encode $overlong} -> opt + dict get $opt -errorcode +} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c} +unset overlong test http-idna-5.1 {IDNA decoding} { ::tcl::idna decode abc.def @@ -1049,6 +1062,20 @@ test http-idna-5.4 {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode XN--abc-.XN--def- } abc.def +test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body { + ::tcl::idna decode xn--$$$.example.com +} -result {bad decode character "$"} +test http-idna-5.5.1 {IDNA decoding: error cases} { + catch {::tcl::idna decode xn--$$$.example.com} -> opt + dict get $opt -errorcode +} {PUNYCODE BAD_INPUT CHAR} +test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body { + ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def +} -result {exceeded input data} +test http-idna-5.6.1 {IDNA decoding: error cases} { + catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt + dict get $opt -errorcode +} {PUNYCODE BAD_INPUT LENGTH} # cleanup catch {unset url} -- cgit v0.12 From 96c666ffcf7708b61f36932ba164e4018cd02fb8 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Feb 2014 14:14:33 +0000 Subject: testing of the cookiejar implementation --- library/http/cookiejar.tcl | 58 ++++++++--------- tests/httpcookie.test | 157 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 186 insertions(+), 29 deletions(-) create mode 100644 tests/httpcookie.test diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 5fa6eb2..3df52f0 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -35,7 +35,9 @@ namespace eval ::http { variable cookiejar_purgeinterval 60000 # This is the class that we are creating - ::oo::class create cookiejar + if {![llength [info commands cookiejar]]} { + ::oo::class create cookiejar + } # Some support procedures, none particularly useful in general namespace eval cookiejar_support { @@ -50,10 +52,10 @@ namespace eval ::http { proc locn {secure domain path {key ""}} { if {$key eq ""} { format "%s://%s%s" [expr {$secure?"https":"http"}] \ - [tcl::idna encode $domain] $path + [::tcl::idna encode $domain] $path } else { format "%s://%s%s?%s" \ - [expr {$secure?"https":"http"}] [tcl::idna encode $domain] \ + [expr {$secure?"https":"http"}] [::tcl::idna encode $domain] \ $path $key } } @@ -85,7 +87,6 @@ namespace eval ::http { ::http::Log "[isoNow] [string toupper $level] cookiejar($who) - ${msg}" } } - namespace import ::http::cookiejar_support::puny::IDNA* } } @@ -96,10 +97,9 @@ package provide cookiejar $::http::cookiejar_version ::oo::define ::http::cookiejar { self method loglevel {{level "\u0000\u0000"}} { namespace upvar ::http cookiejar_loglevel loglevel - if {$level in {debug info warn error}} { - set loglevel $level - } elseif {$level ne "\u0000\u0000"} { - return -code error "unknown log level \"$level\": must be debug, info, warn, or error" + if {$level ne "\u0000\u0000"} { + set loglevel [::tcl::prefix match -message "log level" \ + {debug info warn error} $level] } return $loglevel } @@ -254,8 +254,8 @@ package provide cookiejar $::http::cookiejar_version continue } elseif {[string match !* $line]} { set line [string range $line 1 end] - set idna [string tolower [tcl::idna encode $line]] - set utf [tcl::idna decode [string tolower $line]] + set idna [string tolower [::tcl::idna encode $line]] + set utf [::tcl::idna decode [string tolower $line]] db eval { INSERT OR REPLACE INTO domains (domain, forbidden) VALUES ($utf, 0); @@ -269,8 +269,8 @@ package provide cookiejar $::http::cookiejar_version } else { if {[string match {\*.*} $line]} { set line [string range $line 2 end] - set idna [string tolower [tcl::idna encode $line]] - set utf [tcl::idna decode [string tolower $line]] + set idna [string tolower [::tcl::idna encode $line]] + set utf [::tcl::idna decode [string tolower $line]] db eval { INSERT OR REPLACE INTO forbiddenSuper (domain) VALUES ($utf); @@ -282,8 +282,8 @@ package provide cookiejar $::http::cookiejar_version } } } else { - set idna [string tolower [tcl::idna encode $line]] - set utf [tcl::idna decode [string tolower $line]] + set idna [string tolower [::tcl::idna encode $line]] + set utf [::tcl::idna decode [string tolower $line]] } db eval { INSERT OR REPLACE INTO domains (domain, forbidden) @@ -296,8 +296,8 @@ package provide cookiejar $::http::cookiejar_version } } } - if {$utf ne [tcl::idna decode [string tolower $idna]]} { - log warn "mismatch in IDNA handling for $idna ($line, $utf, [tcl::idna decode $idna])" + if {$utf ne [::tcl::idna decode [string tolower $idna]]} { + log warn "mismatch in IDNA handling for $idna ($line, $utf, [::tcl::idna decode $idna])" } } } @@ -347,7 +347,7 @@ package provide cookiejar $::http::cookiejar_version method getCookies {proto host path} { set result {} set paths [splitPath $path] - set domains [splitDomain [string tolower [tcl::idna encode $host]]] + set domains [splitDomain [string tolower [::tcl::idna encode $host]]] set secure [string equal -nocase $proto "https"] # Open question: how to move these manipulations into the database # engine (if that's where they *should* be). @@ -409,7 +409,7 @@ package provide cookiejar $::http::cookiejar_version return 0 } - method storeCookie {name val options} { + method storeCookie {name value options} { set now [clock seconds] db transaction { if {[my BadDomain $options]} { @@ -421,36 +421,36 @@ package provide cookiejar $::http::cookiejar_version db eval { INSERT OR REPLACE INTO sessionCookies ( secure, domain, path, key, value, originonly, creation, lastuse) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, $now, $now); + VALUES ($secure, $domain, $path, $name, $value, $hostonly, $now, $now); DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $key AND secure <= $secure + WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure } incr deletions [db changes] - log debug "defined session cookie for [locn $secure $domain $path $key]" + log debug "defined session cookie for [locn $secure $domain $path $name]" } elseif {$expires < $now} { db eval { DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $key + WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure; } set del [db changes] db eval { DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $key + WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure; } incr deletions [incr del [db changes]] - log debug "deleted $del cookies for [locn $secure $domain $path $key]" + log debug "deleted $del cookies for [locn $secure $domain $path $name]" } else { db eval { INSERT OR REPLACE INTO persistentCookies ( secure, domain, path, key, value, originonly, expiry, creation) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires, $now); + VALUES ($secure, $domain, $path, $name, $value, $hostonly, $expires, $now); DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $key AND secure <= $secure + WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure } incr deletions [db changes] - log debug "defined persistent cookie for [locn $secure $domain $path $key], expires at [clock format $expires]" + log debug "defined persistent cookie for [locn $secure $domain $path $name], expires at [clock format $expires]" } } } @@ -487,7 +487,7 @@ package provide cookiejar $::http::cookiejar_version forward Database db method lookup {{host ""} {key ""}} { - set host [string tolower [tcl::idna encode $host]] + set host [string tolower [::tcl::idna encode $host]] db transaction { if {$host eq ""} { set result {} @@ -495,7 +495,7 @@ package provide cookiejar $::http::cookiejar_version SELECT DISTINCT domain FROM cookies ORDER BY domain } { - lappend result [tcl::idna decode [string tolower $domain]] + lappend result [::tcl::idna decode [string tolower $domain]] } return $result } elseif {$key eq ""} { diff --git a/tests/httpcookie.test b/tests/httpcookie.test new file mode 100644 index 0000000..d2c4de8 --- /dev/null +++ b/tests/httpcookie.test @@ -0,0 +1,157 @@ +# Commands covered: http::cookiejar +# +# This file contains a collection of tests for the cookiejar package. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. +# +# Copyright (c) 2014 Donal K. Fellows. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require tcltest 2 +namespace import -force ::tcltest::* + +testConstraint cookiejar [expr {![catch { + package require cookiejar +}]}] + +test http-cookiejar-1.1 {cookie storage: packaging} cookiejar { + package require cookiejar +} 0.1 +test http-cookiejar-1.2 {cookie storage: packaging} cookiejar { + package require cookiejar + package require cookiejar +} 0.1 + +test http-cookiejar-2.1 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar +} -returnCodes error -result {wrong # args: should be "http::cookiejar method ?arg ...?"} +test http-cookiejar-2.2 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar ? +} -returnCodes error -result {unknown method "?": must be create, destroy, loglevel or new} +test http-cookiejar-2.3 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar loglevel +} -result info +test http-cookiejar-2.4 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar loglevel ? +} -returnCodes error -result {bad log level "?": must be debug, info, warn, or error} +test http-cookiejar-2.5 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar loglevel ? ? +} -returnCodes error -result {wrong # args: should be "http::cookiejar loglevel ?level?"} +test http-cookiejar-2.6 {cookie storage: basics} -setup { + set old [http::cookiejar loglevel] +} -constraints cookiejar -body { + list [http::cookiejar loglevel] [http::cookiejar loglevel debug] \ + [http::cookiejar loglevel] [http::cookiejar loglevel error] \ + [http::cookiejar loglevel] +} -cleanup { + http::cookiejar loglevel $old +} -result {info debug debug error error} +test http-cookiejar-2.7 {cookie storage: basics} -setup { + set old [http::cookiejar loglevel] +} -constraints cookiejar -body { + list [http::cookiejar loglevel] [http::cookiejar loglevel d] \ + [http::cookiejar loglevel i] [http::cookiejar loglevel w] \ + [http::cookiejar loglevel e] +} -cleanup { + http::cookiejar loglevel $old +} -result {info debug info warn error} + +test http-cookiejar-3.1 {cookie storage: class} cookiejar { + info object isa object http::cookiejar +} 1 +test http-cookiejar-3.2 {cookie storage: class} cookiejar { + info object isa class http::cookiejar +} 1 +test http-cookiejar-3.3 {cookie storage: class} cookiejar { + lsort [info object methods http::cookiejar] +} loglevel +test http-cookiejar-3.4 {cookie storage: class} cookiejar { + lsort [info object methods http::cookiejar -all] +} {create destroy loglevel new} +test http-cookiejar-3.5 {cookie storage: class} -setup { + catch {rename ::cookiejar ""} +} -constraints cookiejar -body { + namespace eval :: {http::cookiejar create cookiejar} +} -cleanup { + catch {rename ::cookiejar ""} +} -result ::cookiejar +test http-cookiejar-3.6 {cookie storage: class} -setup { + catch {rename ::cookiejar ""} +} -constraints cookiejar -body { + list [http::cookiejar create ::cookiejar] [info commands ::cookiejar] \ + [::cookiejar destroy] [info commands ::cookiejar] +} -cleanup { + catch {rename ::cookiejar ""} +} -result {::cookiejar ::cookiejar {} {}} +test http-cookiejar-3.7 {cookie storage: class} -setup { + catch {rename ::cookiejar ""} +} -constraints cookiejar -body { + http::cookiejar create ::cookiejar foo bar +} -returnCodes error -cleanup { + catch {rename ::cookiejar ""} +} -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"} + +test http-cookiejar-4.1 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar +} -returnCodes error -cleanup { + ::cookiejar destroy +} -result {wrong # args: should be "cookiejar method ?arg ...?"} +test http-cookiejar-4.2 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar ? +} -returnCodes error -cleanup { + ::cookiejar destroy +} -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup or storeCookie} +test http-cookiejar-4.3 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + lsort [info object methods cookiejar -all] +} -cleanup { + ::cookiejar destroy +} -result {destroy forceLoadDomainData getCookies lookup storeCookie} +test http-cookiejar-4.4 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar getCookies +} -returnCodes error -cleanup { + ::cookiejar destroy +} -result {wrong # args: should be "cookiejar getCookies proto host path"} +test http-cookiejar-4.5 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar getCookies http www.example.com / +} -cleanup { + ::cookiejar destroy +} -result {} +test http-cookiejar-4.6 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar storeCookie +} -returnCodes error -cleanup { + ::cookiejar destroy +} -result {wrong # args: should be "cookiejar storeCookie name value options"} +test http-cookiejar-4.7 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } +} -cleanup { + ::cookiejar destroy +} -result {} + +::tcltest::cleanupTests + +# Local variables: +# mode: tcl +# End: -- cgit v0.12 From a8069e81b796f9aeb06b21ceabf1ba9760eac3cf Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 24 Feb 2014 08:13:12 +0000 Subject: more functional testing --- tests/httpcookie.test | 166 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 166 insertions(+) diff --git a/tests/httpcookie.test b/tests/httpcookie.test index d2c4de8..6fd3073 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -149,6 +149,172 @@ test http-cookiejar-4.7 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {} +test http-cookiejar-4.8 {cookie storage} -setup { + http::cookiejar create ::cookiejar + oo::objdefine ::cookiejar export Database +} -constraints cookiejar -body { + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + # Poke inside implementation! + cookiejar Database eval {SELECT count(*) FROM sessionCookies} +} -cleanup { + ::cookiejar destroy +} -result 1 +test http-cookiejar-4.9 {cookie storage} -setup { + http::cookiejar create ::cookiejar + oo::objdefine ::cookiejar export Database +} -constraints cookiejar -body { + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + # Poke inside implementation! + cookiejar Database eval {SELECT count(*) FROM persistentCookies} +} -cleanup { + ::cookiejar destroy +} -result 0 +test http-cookiejar-4.10 {cookie storage} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar storeCookie foo bar [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] +} -cleanup { + ::cookiejar destroy +} -result {} +test http-cookiejar-4.11 {cookie storage} -setup { + http::cookiejar create ::cookiejar + oo::objdefine ::cookiejar export Database +} -constraints cookiejar -body { + cookiejar storeCookie foo bar [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] + # Poke inside implementation! + cookiejar Database eval {SELECT count(*) FROM sessionCookies} +} -cleanup { + ::cookiejar destroy +} -result 0 +test http-cookiejar-4.12 {cookie storage} -setup { + http::cookiejar create ::cookiejar + oo::objdefine ::cookiejar export Database +} -constraints cookiejar -body { + cookiejar storeCookie foo bar [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] + # Poke inside implementation! + cookiejar Database eval {SELECT count(*) FROM persistentCookies} +} -cleanup { + ::cookiejar destroy +} -result 1 +test http-cookiejar-4.13 {cookie storage} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + lappend result [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + lappend result [cookiejar getCookies http www.example.com /] +} -cleanup { + ::cookiejar destroy +} -result {{} {foo bar}} +test http-cookiejar-4.14 {cookie storage} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + lappend result [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo bar [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] + lappend result [cookiejar getCookies http www.example.com /] +} -cleanup { + ::cookiejar destroy +} -result {{} {foo bar}} +test http-cookiejar-4.15 {cookie storage} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + lappend result [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie foo bar [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] + lappend result [cookiejar getCookies http www.example.com /] +} -cleanup { + ::cookiejar destroy +} -result {{} {foo bar}} +test http-cookiejar-4.16 {cookie storage} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + lappend result [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo1 bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie foo2 bar [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] + lappend result [lsort -stride 2 [cookiejar getCookies http www.example.com /]] +} -cleanup { + ::cookiejar destroy +} -result {{} {foo1 bar foo2 bar}} ::tcltest::cleanupTests -- cgit v0.12 From 403350cc99d91dbd8a8d77188b16cc9cbd866492 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 25 Feb 2014 09:10:52 +0000 Subject: more tests and some fixes --- library/http/cookiejar.tcl | 33 +++++-- library/http/idna.tcl | 2 +- tests/http.test | 3 + tests/httpcookie.test | 213 +++++++++++++++++++++++++++++++++++++++++---- 4 files changed, 228 insertions(+), 23 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 3df52f0..e1d5fe4 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -234,12 +234,15 @@ package provide cookiejar $::http::cookiejar_version method InitDomainList {} { upvar 0 ::http::cookiejar_offline offline if {!$offline} { - set data [my GetDomainListOnline] - if {[string length $data]} { - my InstallDomainData $data - return + try { + set data [my GetDomainListOnline] + if {[string length $data]} { + my InstallDomainData $data + return + } + } on error {} { + log warn "attempting to fall back to built in version" } - log warn "attempting to fall back to built in version" } my InstallDomainData [my GetDomainListOffline] } @@ -317,8 +320,13 @@ package provide cookiejar $::http::cookiejar_version } destructor { - after cancel $aid - db close + catch { + after cancel $aid + } + catch { + db close + } + return } method GetCookiesForHostAndPath {listVar secure host path fullhost} { @@ -378,11 +386,22 @@ package provide cookiejar $::http::cookiejar_version method BadDomain options { if {![dict exists $options domain]} { + log error "no domain present in options" return 0 } dict with options {} if {$domain ne $origin} { log debug "cookie domain varies from origin ($domain, $origin)" + if {[string match .* $domain]} { + set dotd $domain + } else { + set dotd .$domain + } + if {![string equal -length [string length $dotd] \ + [string reverse $dotd] [string reverse $origin]]} { + log warn "bad cookie: domain not suffix of origin" + return 1 + } } if {![regexp {[^0-9.]} $domain]} { if {$domain eq $origin} { diff --git a/library/http/idna.tcl b/library/http/idna.tcl index 7dfb968..53e45ca 100644 --- a/library/http/idna.tcl +++ b/library/http/idna.tcl @@ -25,7 +25,7 @@ namespace eval ::tcl::idna { # Split term from RFC 3490, Sec 3.1 foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { if {[regexp {[^-A-Za-z0-9]} $part]} { - if {[regexp {[^-A-Za-z0-9\u0100-\uffff]} $part ch]} { + if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} { scan $ch %c c if {$ch < "!" || $ch > "~"} { set ch [format "\\u%04x" $c] diff --git a/tests/http.test b/tests/http.test index 0f76258..0f1546f 100644 --- a/tests/http.test +++ b/tests/http.test @@ -1046,6 +1046,9 @@ test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} { dict get $opt -errorcode } {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c} unset overlong +test http-idna-4.10 {IDNA encoding: edge cases} { + ::tcl::idna encode pass\u00e9.example.com +} xn--pass-epa.example.com test http-idna-5.1 {IDNA decoding} { ::tcl::idna decode abc.def diff --git a/tests/httpcookie.test b/tests/httpcookie.test index 6fd3073..c0e7419 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -93,28 +93,28 @@ test http-cookiejar-3.7 {cookie storage: class} -setup { catch {rename ::cookiejar ""} } -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"} -test http-cookiejar-4.1 {cookie storage} -setup { +test http-cookiejar-4.1 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { cookiejar } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar method ?arg ...?"} -test http-cookiejar-4.2 {cookie storage} -setup { +test http-cookiejar-4.2 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { cookiejar ? } -returnCodes error -cleanup { ::cookiejar destroy } -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup or storeCookie} -test http-cookiejar-4.3 {cookie storage} -setup { +test http-cookiejar-4.3 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { lsort [info object methods cookiejar -all] } -cleanup { ::cookiejar destroy } -result {destroy forceLoadDomainData getCookies lookup storeCookie} -test http-cookiejar-4.4 {cookie storage} -setup { +test http-cookiejar-4.4 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { cookiejar getCookies @@ -128,14 +128,14 @@ test http-cookiejar-4.5 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {} -test http-cookiejar-4.6 {cookie storage} -setup { +test http-cookiejar-4.6 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { cookiejar storeCookie } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar storeCookie name value options"} -test http-cookiejar-4.7 {cookie storage} -setup { +test http-cookiejar-4.7 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { cookiejar storeCookie foo bar { @@ -149,7 +149,7 @@ test http-cookiejar-4.7 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {} -test http-cookiejar-4.8 {cookie storage} -setup { +test http-cookiejar-4.8 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { @@ -166,7 +166,7 @@ test http-cookiejar-4.8 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result 1 -test http-cookiejar-4.9 {cookie storage} -setup { +test http-cookiejar-4.9 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { @@ -183,7 +183,7 @@ test http-cookiejar-4.9 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result 0 -test http-cookiejar-4.10 {cookie storage} -setup { +test http-cookiejar-4.10 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { cookiejar storeCookie foo bar [dict replace { @@ -197,7 +197,7 @@ test http-cookiejar-4.10 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {} -test http-cookiejar-4.11 {cookie storage} -setup { +test http-cookiejar-4.11 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { @@ -214,7 +214,7 @@ test http-cookiejar-4.11 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result 0 -test http-cookiejar-4.12 {cookie storage} -setup { +test http-cookiejar-4.12 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { @@ -231,7 +231,7 @@ test http-cookiejar-4.12 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result 1 -test http-cookiejar-4.13 {cookie storage} -setup { +test http-cookiejar-4.13 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { @@ -248,7 +248,7 @@ test http-cookiejar-4.13 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {{} {foo bar}} -test http-cookiejar-4.14 {cookie storage} -setup { +test http-cookiejar-4.14 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { @@ -265,7 +265,7 @@ test http-cookiejar-4.14 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {{} {foo bar}} -test http-cookiejar-4.15 {cookie storage} -setup { +test http-cookiejar-4.15 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { @@ -290,7 +290,7 @@ test http-cookiejar-4.15 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {{} {foo bar}} -test http-cookiejar-4.16 {cookie storage} -setup { +test http-cookiejar-4.16 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { @@ -315,6 +315,189 @@ test http-cookiejar-4.16 {cookie storage} -setup { } -cleanup { ::cookiejar destroy } -result {{} {foo1 bar foo2 bar}} +test http-cookiejar-4.17 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar lookup a b c d +} -returnCodes error -cleanup { + ::cookiejar destroy +} -result {wrong # args: should be "cookiejar lookup ?host? ?key?"} +test http-cookiejar-4.18 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + lappend result [cookiejar lookup] + lappend result [cookiejar lookup www.example.com] + lappend result [catch {cookiejar lookup www.example.com foo} value] $value + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + lappend result [cookiejar lookup] + lappend result [cookiejar lookup www.example.com] + lappend result [cookiejar lookup www.example.com foo] +} -cleanup { + ::cookiejar destroy +} -result {{} {} 1 {no such key for that host} www.example.com foo bar} +test http-cookiejar-4.19 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie bar foo { + persistent 0 + secure 0 + domain www.example.org + origin www.example.org + path / + hostonly 1 + } + lappend result [lsort [cookiejar lookup]] + lappend result [cookiejar lookup www.example.com] + lappend result [cookiejar lookup www.example.com foo] + lappend result [cookiejar lookup www.example.org] + lappend result [cookiejar lookup www.example.org bar] +} -cleanup { + ::cookiejar destroy +} -result {{www.example.com www.example.org} foo bar bar foo} +test http-cookiejar-4.20 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + cookiejar storeCookie foo1 bar1 { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie foo2 bar2 [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+5}]] + lappend result [cookiejar lookup] + lappend result [lsort [cookiejar lookup www.example.com]] + lappend result [cookiejar lookup www.example.com foo1] + lappend result [cookiejar lookup www.example.com foo2] +} -cleanup { + ::cookiejar destroy +} -result {www.example.com {foo1 foo2} bar1 bar2} +test http-cookiejar-4.21 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + cookiejar storeCookie foo1 bar1 { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie foo2 bar2 { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + lappend result [cookiejar lookup] + lappend result [lsort [cookiejar lookup www.example.com]] + lappend result [cookiejar lookup www.example.com foo1] + lappend result [cookiejar lookup www.example.com foo2] +} -cleanup { + ::cookiejar destroy +} -result {www.example.com {foo1 foo2} bar1 bar2} +test http-cookiejar-4.22 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + cookiejar forceLoadDomainData x y z +} -returnCodes error -cleanup { + ::cookiejar destroy +} -result {wrong # args: should be "cookiejar forceLoadDomainData"} +test http-cookiejar-4.23 {cookie storage: instance} -setup { + http::cookiejar create ::cookiejar + set result {} +} -constraints cookiejar -body { + cookiejar forceLoadDomainData +} -cleanup { + ::cookiejar destroy +} -result {} + +test http-cookiejar-5.1 {cookie storage: constraints} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar forceLoadDomainData + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain com + origin com + path / + hostonly 1 + } + cookiejar lookup +} -cleanup { + ::cookiejar destroy +} -result {} +test http-cookiejar-5.2 {cookie storage: constraints} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar forceLoadDomainData + cookiejar storeCookie foo bar { + persistent 0 + secure 0 + domain foo.example.com + origin bar.example.org + path / + hostonly 1 + } + cookiejar lookup +} -cleanup { + ::cookiejar destroy +} -result {} +test http-cookiejar-5.3 {cookie storage: constraints} -setup { + http::cookiejar create ::cookiejar +} -constraints cookiejar -body { + cookiejar forceLoadDomainData + cookiejar storeCookie foo1 bar { + persistent 0 + secure 0 + domain com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie foo2 bar { + persistent 0 + secure 0 + domain example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar lookup +} -cleanup { + ::cookiejar destroy +} -result {example.com} ::tcltest::cleanupTests -- cgit v0.12 From b3e0829c502c2912317a0521963b481e3b982604 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 26 Feb 2014 08:58:05 +0000 Subject: start writing integration tests --- library/http/cookiejar.tcl | 38 ++++++++++++-------- tests/httpcookie.test | 86 ++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 107 insertions(+), 17 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index e1d5fe4..2b1f722 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -79,11 +79,12 @@ namespace eval ::http { set ms [format %03d [expr {$ms % 1000}]] clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1 } - proc log {level msg} { + proc log {level msg args} { namespace upvar ::http cookiejar_loglevel loglevel set who [uplevel 1 self] set map {debug 0 info 1 warn 2 error 3} if {[string map $map $level] >= [string map $map $loglevel]} { + set msg [format $msg {*}$args] ::http::Log "[isoNow] [string toupper $level] cookiejar($who) - ${msg}" } } @@ -185,7 +186,7 @@ package provide cookiejar $::http::cookiejar_version db eval { SELECT COUNT(*) AS cookieCount FROM persistentCookies } - log info "$storeorigin with $cookieCount entries" + log info "%s with %s entries" $storeorigin $cookieCount set aid [after $purgeinterval [namespace current]::my PurgeCookies] @@ -199,13 +200,14 @@ package provide cookiejar $::http::cookiejar_version method GetDomainListOnline {} { upvar 0 ::http::cookiejar_domainlist url - log debug "loading domain list from $url" + log debug "loading domain list from %s" $url set tok [::http::geturl $url] try { if {[::http::ncode $tok] == 200} { return [::http::data $tok] } else { - log error "failed to fetch list of forbidden cookie domains from ${url}: [::http::error $tok]" + log error "failed to fetch list of forbidden cookie domains from %s: %s" \ + $url [::http::error $tok] return {} } } finally { @@ -214,7 +216,7 @@ package provide cookiejar $::http::cookiejar_version } method GetDomainListOffline {} { upvar 0 ::http::cookiejar_domainfile filename - log debug "loading domain list from $filename" + log debug "loading domain list from %s" $filename try { set f [open $filename] try { @@ -227,7 +229,8 @@ package provide cookiejar $::http::cookiejar_version close $f } } on error {msg opt} { - log error "failed to read list of forbidden cookie domains from ${filename}: $msg" + log error "failed to read list of forbidden cookie domains from %s: %s" \ + $filename $msg return -options $opt $msg } } @@ -300,12 +303,13 @@ package provide cookiejar $::http::cookiejar_version } } if {$utf ne [::tcl::idna decode [string tolower $idna]]} { - log warn "mismatch in IDNA handling for $idna ($line, $utf, [::tcl::idna decode $idna])" + log warn "mismatch in IDNA handling for %s (%d, %s, %s)" \ + $idna $line $utf [::tcl::idna decode $idna] } } } set n [expr {[db total_changes] - $n}] - log debug "processed $n inserts generated from domain list" + log debug "processed %d inserts generated from domain list" $n } # This forces the rebuild of the domain data, loading it from @@ -331,7 +335,7 @@ package provide cookiejar $::http::cookiejar_version method GetCookiesForHostAndPath {listVar secure host path fullhost} { upvar 1 $listVar result - log debug "check for cookies for [locn $secure $host $path]" + log debug "check for cookies for %s" [locn $secure $host $path] db eval { SELECT key, value FROM persistentCookies WHERE domain = $host AND path = $path AND secure <= $secure @@ -391,7 +395,8 @@ package provide cookiejar $::http::cookiejar_version } dict with options {} if {$domain ne $origin} { - log debug "cookie domain varies from origin ($domain, $origin)" + log debug "cookie domain varies from origin (%s, %s)" \ + $domain $origin if {[string match .* $domain]} { set dotd $domain } else { @@ -445,7 +450,8 @@ package provide cookiejar $::http::cookiejar_version WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure } incr deletions [db changes] - log debug "defined session cookie for [locn $secure $domain $path $name]" + log debug "defined session cookie for %s" \ + [locn $secure $domain $path $name] } elseif {$expires < $now} { db eval { DELETE FROM persistentCookies @@ -459,7 +465,8 @@ package provide cookiejar $::http::cookiejar_version AND secure <= $secure; } incr deletions [incr del [db changes]] - log debug "deleted $del cookies for [locn $secure $domain $path $name]" + log debug "deleted %d cookies for %s" \ + $del [locn $secure $domain $path $name] } else { db eval { INSERT OR REPLACE INTO persistentCookies ( @@ -469,7 +476,9 @@ package provide cookiejar $::http::cookiejar_version WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure } incr deletions [db changes] - log debug "defined persistent cookie for [locn $secure $domain $path $name], expires at [clock format $expires]" + log debug "defined persistent cookie for %s, expires at %s" \ + [locn $secure $domain $path $name] \ + [clock format $expires] } } } @@ -478,9 +487,10 @@ package provide cookiejar $::http::cookiejar_version namespace upvar ::http \ cookiejar_vacuumtrigger trigger \ cookiejar_purgeinterval interval + catch {after cancel $aid} set aid [after $interval [namespace current]::my PurgeCookies] set now [clock seconds] - log debug "purging cookies that expired before [clock format $now]" + log debug "purging cookies that expired before %s" [clock format $now] db transaction { db eval { DELETE FROM persistentCookies WHERE expiry < $now diff --git a/tests/httpcookie.test b/tests/httpcookie.test index c0e7419..1733fd4 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -444,8 +444,8 @@ test http-cookiejar-4.23 {cookie storage: instance} -setup { test http-cookiejar-5.1 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar -} -constraints cookiejar -body { cookiejar forceLoadDomainData +} -constraints cookiejar -body { cookiejar storeCookie foo bar { persistent 0 secure 0 @@ -460,8 +460,8 @@ test http-cookiejar-5.1 {cookie storage: constraints} -setup { } -result {} test http-cookiejar-5.2 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar -} -constraints cookiejar -body { cookiejar forceLoadDomainData +} -constraints cookiejar -body { cookiejar storeCookie foo bar { persistent 0 secure 0 @@ -476,8 +476,8 @@ test http-cookiejar-5.2 {cookie storage: constraints} -setup { } -result {} test http-cookiejar-5.3 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar -} -constraints cookiejar -body { cookiejar forceLoadDomainData +} -constraints cookiejar -body { cookiejar storeCookie foo1 bar { persistent 0 secure 0 @@ -498,6 +498,86 @@ test http-cookiejar-5.3 {cookie storage: constraints} -setup { } -cleanup { ::cookiejar destroy } -result {example.com} +test http-cookiejar-5.4 {cookie storage: constraints} -setup { + http::cookiejar create ::cookiejar + cookiejar forceLoadDomainData +} -constraints cookiejar -body { + cookiejar storeCookie foo bar1 { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie foo bar2 { + persistent 0 + secure 0 + domain example.com + origin www.example.com + path / + hostonly 1 + } + lsort [cookiejar lookup] +} -cleanup { + ::cookiejar destroy +} -result {example.com www.example.com} + +test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { + http::cookiejar create ::cookiejar + oo::objdefine cookiejar export PurgeCookies + set result {} + proc values cookies { + global result + lappend result [lsort [lmap {k v} $cookies {set v}]] + } +} -constraints cookiejar -body { + values [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo session { + persistent 0 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + values [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo cookie [dict replace { + persistent 1 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+1}]] + values [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo session-global { + persistent 0 + secure 0 + domain example.com + origin www.example.com + path / + hostonly 0 + } + values [cookiejar getCookies http www.example.com /] + after 2500 + update + values [cookiejar getCookies http www.example.com /] + cookiejar PurgeCookies + values [cookiejar getCookies http www.example.com /] + cookiejar storeCookie foo go-away { + persistent 1 + secure 0 + domain example.com + origin www.example.com + path / + hostonly 0 + expires 0 + } + values [cookiejar getCookies http www.example.com /] +} -cleanup { + ::cookiejar destroy +} -result {{} session cookie {cookie session-global} {cookie session-global} session-global {}} ::tcltest::cleanupTests -- cgit v0.12 From 1575eb36c1ca196aefccf4813d1767c439dccb1f Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 3 Mar 2014 23:22:12 +0000 Subject: working towards a more consistent way of handling options in the cookiejar API --- library/http/cookiejar.tcl | 57 ++++++++++----- library/http/http.tcl | 11 ++- tests/httpcookie.test | 168 ++++++++++++++++++++++++++++----------------- 3 files changed, 149 insertions(+), 87 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 2b1f722..f1a7f7a 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -85,7 +85,8 @@ namespace eval ::http { set map {debug 0 info 1 warn 2 error 3} if {[string map $map $level] >= [string map $map $loglevel]} { set msg [format $msg {*}$args] - ::http::Log "[isoNow] [string toupper $level] cookiejar($who) - ${msg}" + set LVL [string toupper $level] + ::http::Log "[isoNow] $LVL cookiejar($who) - $msg" } } } @@ -96,6 +97,25 @@ package provide cookiejar $::http::cookiejar_version # The implementation of the cookiejar package ::oo::define ::http::cookiejar { + self method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} { + set tbl { + -domainfile {cookiejar_domainfile} + -domainlist {cookiejar_domainlist} + -offline {cookiejar_offline} + -purgeinterval {cookiejar_purgeinterval} + -vacuumtrigger {cookiejar_vacuumtrigger} + } + if {$optionName eq "\u0000\u0000"} { + return [dict keys $tbl] + } + set opt [::tcl::prefix match -message "option" [dict keys $tbl] $optionName] + lassign [dict get $tbl $opt] varname + namespace upvar ::http $varname var + if {$optionValue ne "\u0000\u0000"} { + set var $optionValue + } + return $var + } self method loglevel {{level "\u0000\u0000"}} { namespace upvar ::http cookiejar_loglevel loglevel if {$level ne "\u0000\u0000"} { @@ -205,11 +225,10 @@ package provide cookiejar $::http::cookiejar_version try { if {[::http::ncode $tok] == 200} { return [::http::data $tok] - } else { - log error "failed to fetch list of forbidden cookie domains from %s: %s" \ - $url [::http::error $tok] - return {} } + log error "failed to fetch list of forbidden cookie domains from %s: %s" \ + $url [::http::error $tok] + return {} } finally { ::http::cleanup $tok } @@ -339,7 +358,7 @@ package provide cookiejar $::http::cookiejar_version db eval { SELECT key, value FROM persistentCookies WHERE domain = $host AND path = $path AND secure <= $secure - AND (NOT originonly OR domain = $fullhost) + AND (NOT originonly OR domain = $fullhost) } { lappend result $key $value } @@ -347,7 +366,7 @@ package provide cookiejar $::http::cookiejar_version db eval { SELECT id, key, value FROM sessionCookies WHERE domain = $host AND path = $path AND secure <= $secure - AND (NOT originonly OR domain = $fullhost) + AND (NOT originonly OR domain = $fullhost) } { lappend result $key $value db eval { @@ -433,51 +452,53 @@ package provide cookiejar $::http::cookiejar_version return 0 } - method storeCookie {name value options} { - set now [clock seconds] + method storeCookie {options} { db transaction { if {[my BadDomain $options]} { return } set now [clock seconds] + set persistent [dict exists $options expires] dict with options {} if {!$persistent} { db eval { INSERT OR REPLACE INTO sessionCookies ( secure, domain, path, key, value, originonly, creation, lastuse) - VALUES ($secure, $domain, $path, $name, $value, $hostonly, $now, $now); + VALUES ($secure, $domain, $path, $key, $value, $hostonly, $now, $now); DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure } incr deletions [db changes] log debug "defined session cookie for %s" \ - [locn $secure $domain $path $name] + [locn $secure $domain $path $key] } elseif {$expires < $now} { db eval { DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $name + WHERE domain = $domain AND path = $path AND key = $key AND secure <= $secure; } set del [db changes] db eval { DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $name + WHERE domain = $domain AND path = $path AND key = $key AND secure <= $secure; } incr deletions [incr del [db changes]] log debug "deleted %d cookies for %s" \ - $del [locn $secure $domain $path $name] + $del [locn $secure $domain $path $key] } else { db eval { INSERT OR REPLACE INTO persistentCookies ( secure, domain, path, key, value, originonly, expiry, creation) - VALUES ($secure, $domain, $path, $name, $value, $hostonly, $expires, $now); + VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires, $now); DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $name AND secure <= $secure + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure } incr deletions [db changes] log debug "defined persistent cookie for %s, expires at %s" \ - [locn $secure $domain $path $name] \ + [locn $secure $domain $path $key] \ [clock format $expires] } } diff --git a/library/http/http.tcl b/library/http/http.tcl index 81a008a..8720be1 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1207,7 +1207,7 @@ proc http::ParseCookie {token value} { # Convert the options into a list before feeding into the cookie store; # ugly, but quite easy. - set realopts {persistent 0 hostonly 1 path / secure 0 httponly 0} + set realopts {hostonly 1 path / secure 0 httponly 0} dict set realopts origin $state(host) dict set realopts domain $state(host) foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { @@ -1218,13 +1218,11 @@ proc http::ParseCookie {token value} { #Sun, 06 Nov 1994 08:49:37 GMT dict set realopts expires \ [clock scan $opt -format "%a, %d %b %Y %T %Z"] - dict set realopts persistent 1 }] && [catch { # Google does this one #Mon, 01-Jan-1990 00:00:00 GMT dict set realopts expires \ [clock scan $opt -format "%a, %d-%b-%Y %T %Z"] - dict set realopts persistent 1 }] && [catch { # This is in the RFC, but it is also in the original # Netscape cookie spec, now online at: @@ -1232,12 +1230,10 @@ proc http::ParseCookie {token value} { #Sunday, 06-Nov-94 08:49:37 GMT dict set realopts expires \ [clock scan $opt -format "%A, %d-%b-%y %T %Z"] - dict set realopts persistent 1 }]} {catch { #Sun Nov 6 08:49:37 1994 dict set realopts expires \ [clock scan $opt -gmt 1 -format "%a %b %d %T %Y"] - dict set realopts persistent 1 }} } Max-Age=* { @@ -1245,7 +1241,6 @@ proc http::ParseCookie {token value} { set opt [string range $opt 8 end] if {[string is integer -strict $opt]} { dict set realopts expires [expr {[clock seconds] + $opt}] - dict set realopts persistent 1 } } Domain=* { @@ -1267,7 +1262,9 @@ proc http::ParseCookie {token value} { } } } - {*}$http(-cookiejar) storeCookie $cookiename $cookieval $realopts + dict set realopts key $cookiename + dict set realopts value $cookieval + {*}$http(-cookiejar) storeCookie $realopts } # http::getTextLine -- diff --git a/tests/httpcookie.test b/tests/httpcookie.test index 1733fd4..3ea4d55 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -29,7 +29,7 @@ test http-cookiejar-2.1 {cookie storage: basics} -constraints cookiejar -body { } -returnCodes error -result {wrong # args: should be "http::cookiejar method ?arg ...?"} test http-cookiejar-2.2 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar ? -} -returnCodes error -result {unknown method "?": must be create, destroy, loglevel or new} +} -returnCodes error -result {unknown method "?": must be configure, create, destroy, loglevel or new} test http-cookiejar-2.3 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar loglevel } -result info @@ -66,10 +66,10 @@ test http-cookiejar-3.2 {cookie storage: class} cookiejar { } 1 test http-cookiejar-3.3 {cookie storage: class} cookiejar { lsort [info object methods http::cookiejar] -} loglevel +} {configure loglevel} test http-cookiejar-3.4 {cookie storage: class} cookiejar { lsort [info object methods http::cookiejar -all] -} {create destroy loglevel new} +} {configure create destroy loglevel new} test http-cookiejar-3.5 {cookie storage: class} -setup { catch {rename ::cookiejar ""} } -constraints cookiejar -body { @@ -92,6 +92,21 @@ test http-cookiejar-3.7 {cookie storage: class} -setup { } -returnCodes error -cleanup { catch {rename ::cookiejar ""} } -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"} +test http-cookiejar-3.8 {cookie storage: class} cookiejar { + http::cookiejar configure +} {-domainfile -domainlist -offline -purgeinterval -vacuumtrigger} +test http-cookiejar-3.9 {cookie storage: class} -constraints cookiejar -body { + http::cookiejar configure a b c d e +} -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} +test http-cookiejar-3.10 {cookie storage: class} -constraints cookiejar -body { + http::cookiejar configure a +} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -offline, -purgeinterval, or -vacuumtrigger} +test http-cookiejar-3.11 {cookie storage: class} -constraints cookiejar -body { + http::cookiejar configure -d +} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -offline, -purgeinterval, or -vacuumtrigger} +test http-cookiejar-3.12 {cookie storage: class} -constraints cookiejar -body { + http::cookiejar configure -off +} -match glob -result * test http-cookiejar-4.1 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar @@ -134,12 +149,13 @@ test http-cookiejar-4.6 {cookie storage: instance} -setup { cookiejar storeCookie } -returnCodes error -cleanup { ::cookiejar destroy -} -result {wrong # args: should be "cookiejar storeCookie name value options"} +} -result {wrong # args: should be "cookiejar storeCookie options"} test http-cookiejar-4.7 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -153,8 +169,9 @@ test http-cookiejar-4.8 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -170,8 +187,9 @@ test http-cookiejar-4.9 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -186,8 +204,9 @@ test http-cookiejar-4.9 {cookie storage: instance} -setup { test http-cookiejar-4.10 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar } -constraints cookiejar -body { - cookiejar storeCookie foo bar [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -201,8 +220,9 @@ test http-cookiejar-4.11 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { - cookiejar storeCookie foo bar [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -218,8 +238,9 @@ test http-cookiejar-4.12 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database } -constraints cookiejar -body { - cookiejar storeCookie foo bar [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -236,8 +257,9 @@ test http-cookiejar-4.13 {cookie storage: instance} -setup { set result {} } -constraints cookiejar -body { lappend result [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -253,8 +275,9 @@ test http-cookiejar-4.14 {cookie storage: instance} -setup { set result {} } -constraints cookiejar -body { lappend result [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo bar [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -270,16 +293,18 @@ test http-cookiejar-4.15 {cookie storage: instance} -setup { set result {} } -constraints cookiejar -body { lappend result [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com path / hostonly 1 } - cookiejar storeCookie foo bar [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -295,16 +320,18 @@ test http-cookiejar-4.16 {cookie storage: instance} -setup { set result {} } -constraints cookiejar -body { lappend result [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo1 bar { - persistent 0 + cookiejar storeCookie { + key foo1 + value bar secure 0 domain www.example.com origin www.example.com path / hostonly 1 } - cookiejar storeCookie foo2 bar [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo2 + value bar secure 0 domain www.example.com origin www.example.com @@ -329,8 +356,9 @@ test http-cookiejar-4.18 {cookie storage: instance} -setup { lappend result [cookiejar lookup] lappend result [cookiejar lookup www.example.com] lappend result [catch {cookiejar lookup www.example.com foo} value] $value - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com @@ -347,16 +375,18 @@ test http-cookiejar-4.19 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain www.example.com origin www.example.com path / hostonly 1 } - cookiejar storeCookie bar foo { - persistent 0 + cookiejar storeCookie { + key bar + value foo secure 0 domain www.example.org origin www.example.org @@ -375,16 +405,18 @@ test http-cookiejar-4.20 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { - cookiejar storeCookie foo1 bar1 { - persistent 0 + cookiejar storeCookie { + key foo1 + value bar1 secure 0 domain www.example.com origin www.example.com path / hostonly 1 } - cookiejar storeCookie foo2 bar2 [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo2 + value bar2 secure 0 domain www.example.com origin www.example.com @@ -402,16 +434,18 @@ test http-cookiejar-4.21 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar set result {} } -constraints cookiejar -body { - cookiejar storeCookie foo1 bar1 { - persistent 0 + cookiejar storeCookie { + key foo1 + value bar1 secure 0 domain www.example.com origin www.example.com path / hostonly 1 } - cookiejar storeCookie foo2 bar2 { - persistent 0 + cookiejar storeCookie { + key foo2 + value bar2 secure 0 domain www.example.com origin www.example.com @@ -446,8 +480,9 @@ test http-cookiejar-5.1 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData } -constraints cookiejar -body { - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain com origin com @@ -462,8 +497,9 @@ test http-cookiejar-5.2 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData } -constraints cookiejar -body { - cookiejar storeCookie foo bar { - persistent 0 + cookiejar storeCookie { + key foo + value bar secure 0 domain foo.example.com origin bar.example.org @@ -478,16 +514,18 @@ test http-cookiejar-5.3 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData } -constraints cookiejar -body { - cookiejar storeCookie foo1 bar { - persistent 0 + cookiejar storeCookie { + key foo1 + value bar secure 0 domain com origin www.example.com path / hostonly 1 } - cookiejar storeCookie foo2 bar { - persistent 0 + cookiejar storeCookie { + key foo2 + value bar secure 0 domain example.com origin www.example.com @@ -502,16 +540,18 @@ test http-cookiejar-5.4 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData } -constraints cookiejar -body { - cookiejar storeCookie foo bar1 { - persistent 0 + cookiejar storeCookie { + key foo + value bar1 secure 0 domain www.example.com origin www.example.com path / hostonly 1 } - cookiejar storeCookie foo bar2 { - persistent 0 + cookiejar storeCookie { + key foo + value bar2 secure 0 domain example.com origin www.example.com @@ -533,8 +573,9 @@ test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { } } -constraints cookiejar -body { values [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo session { - persistent 0 + cookiejar storeCookie { + key foo + value session secure 0 domain www.example.com origin www.example.com @@ -542,8 +583,9 @@ test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { hostonly 1 } values [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo cookie [dict replace { - persistent 1 + cookiejar storeCookie [dict replace { + key foo + value cookie secure 0 domain www.example.com origin www.example.com @@ -551,8 +593,9 @@ test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { hostonly 1 } expires [expr {[clock seconds]+1}]] values [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo session-global { - persistent 0 + cookiejar storeCookie { + key foo + value session-global secure 0 domain example.com origin www.example.com @@ -565,8 +608,9 @@ test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { values [cookiejar getCookies http www.example.com /] cookiejar PurgeCookies values [cookiejar getCookies http www.example.com /] - cookiejar storeCookie foo go-away { - persistent 1 + cookiejar storeCookie { + key foo + value go-away secure 0 domain example.com origin www.example.com -- cgit v0.12 From 9597c478f9a01087b8969f960e14adf9df328eeb Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 4 Mar 2014 08:11:02 +0000 Subject: safer setter mechanism --- library/http/cookiejar.tcl | 31 ++++++++++++++++++++++++------- tests/httpcookie.test | 21 +++++++++++++++++++++ 2 files changed, 45 insertions(+), 7 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index f1a7f7a..5c25e28 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -39,6 +39,23 @@ namespace eval ::http { ::oo::class create cookiejar } + namespace eval [info object namespace cookiejar] { + proc setInt {*var val} { + upvar 1 ${*var} var + if {[catch {incr dummy $val} msg]} { + return -code error $msg + } + set var $val + } + proc setBool {*var val} { + upvar 1 ${*var} var + if {[catch {if {$val} {}} msg]} { + return -code error $msg + } + set var [expr {!!$val}] + } + } + # Some support procedures, none particularly useful in general namespace eval cookiejar_support { # Set up a logger if the http package isn't actually loaded yet. @@ -99,20 +116,20 @@ package provide cookiejar $::http::cookiejar_version ::oo::define ::http::cookiejar { self method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} { set tbl { - -domainfile {cookiejar_domainfile} - -domainlist {cookiejar_domainlist} - -offline {cookiejar_offline} - -purgeinterval {cookiejar_purgeinterval} - -vacuumtrigger {cookiejar_vacuumtrigger} + -domainfile {cookiejar_domainfile set} + -domainlist {cookiejar_domainlist set} + -offline {cookiejar_offline setBool} + -purgeinterval {cookiejar_purgeinterval setInt} + -vacuumtrigger {cookiejar_vacuumtrigger setInt} } if {$optionName eq "\u0000\u0000"} { return [dict keys $tbl] } set opt [::tcl::prefix match -message "option" [dict keys $tbl] $optionName] - lassign [dict get $tbl $opt] varname + lassign [dict get $tbl $opt] varname setter namespace upvar ::http $varname var if {$optionValue ne "\u0000\u0000"} { - set var $optionValue + $setter var $optionValue } return $var } diff --git a/tests/httpcookie.test b/tests/httpcookie.test index 3ea4d55..ba39c1c 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -107,6 +107,27 @@ test http-cookiejar-3.11 {cookie storage: class} -constraints cookiejar -body { test http-cookiejar-3.12 {cookie storage: class} -constraints cookiejar -body { http::cookiejar configure -off } -match glob -result * +test http-cookiejar-3.13 {cookie storage: class} -setup { + set oldval [http::cookiejar configure -offline] +} -constraints cookiejar -body { + http::cookiejar configure -offline true +} -cleanup { + catch {http::cookiejar configure -offline $oldval} +} -result 1 +test http-cookiejar-3.14 {cookie storage: class} -setup { + set oldval [http::cookiejar configure -offline] +} -constraints cookiejar -body { + http::cookiejar configure -offline nonbool +} -cleanup { + catch {http::cookiejar configure -offline $oldval} +} -returnCodes error -result {expected boolean value but got "nonbool"} +test http-cookiejar-3.15 {cookie storage: class} -setup { + set oldval [http::cookiejar configure -purgeinterval] +} -constraints cookiejar -body { + http::cookiejar configure -purge nonint +} -cleanup { + catch {http::cookiejar configure -purgeinterval $oldval} +} -returnCodes error -result {expected integer but got "nonint"} test http-cookiejar-4.1 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar -- cgit v0.12 From 666e80e5bd56c2edbfb3560924cdf2a73170e485 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Mar 2014 22:28:12 +0000 Subject: more checks of domain data loading --- library/http/cookiejar.tcl | 24 +++++++++++------- tests/httpcookie.test | 62 ++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 69 insertions(+), 17 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 5c25e28..a4ee78a 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -25,7 +25,7 @@ namespace eval ::http { # TODO: is this the _right_ list of domains to use? Or is there an alias # for it that will persist longer? variable cookiejar_domainlist \ - http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1 + http://publicsuffix.org/list/effective_tld_names.dat variable cookiejar_domainfile \ [file join [file dirname [info script]] effective_tld_names.txt.gz] # The list is directed to from http://publicsuffix.org/list/ @@ -142,7 +142,7 @@ package provide cookiejar $::http::cookiejar_version return $loglevel } - variable aid deletions + variable purgeTimer deletions constructor {{path ""}} { namespace import ::http::cookiejar_support::* namespace upvar ::http cookiejar_purgeinterval purgeinterval @@ -194,6 +194,7 @@ package provide cookiejar $::http::cookiejar_version CREATE INDEX sessionLookup ON sessionCookies (domain, path); --;# View to allow for simple looking up of a cookie. + --;# Deletion policy: NOT SUPPORTED via this view. CREATE TEMP VIEW cookies AS SELECT id, domain, path, key, value, originonly, secure, 1 AS persistent @@ -225,7 +226,7 @@ package provide cookiejar $::http::cookiejar_version } log info "%s with %s entries" $storeorigin $cookieCount - set aid [after $purgeinterval [namespace current]::my PurgeCookies] + my PostponePurge # TODO: domain list refresh policy if {$path ne "" && ![db exists { @@ -235,6 +236,12 @@ package provide cookiejar $::http::cookiejar_version } } + method PostponePurge {} { + namespace upvar ::http cookiejar_purgeinterval interval + catch {after cancel $purgeTimer} + set purgeTimer [after $interval [namespace code {my PurgeCookies}]] + } + method GetDomainListOnline {} { upvar 0 ::http::cookiejar_domainlist url log debug "loading domain list from %s" $url @@ -345,7 +352,7 @@ package provide cookiejar $::http::cookiejar_version } } set n [expr {[db total_changes] - $n}] - log debug "processed %d inserts generated from domain list" $n + log info "constructed domain info with %d entries" $n } # This forces the rebuild of the domain data, loading it from @@ -361,7 +368,7 @@ package provide cookiejar $::http::cookiejar_version destructor { catch { - after cancel $aid + after cancel $purgeTimer } catch { db close @@ -525,8 +532,7 @@ package provide cookiejar $::http::cookiejar_version namespace upvar ::http \ cookiejar_vacuumtrigger trigger \ cookiejar_purgeinterval interval - catch {after cancel $aid} - set aid [after $interval [namespace current]::my PurgeCookies] + my PostponePurge set now [clock seconds] log debug "purging cookies that expired before %s" [clock format $now] db transaction { @@ -534,9 +540,9 @@ package provide cookiejar $::http::cookiejar_version DELETE FROM persistentCookies WHERE expiry < $now } incr deletions [db changes] + ### TODO: Cap the total number of cookies and session cookies, + ### purging least frequently used } - ### TODO: Cap the total number of cookies and session cookies, - ### purging least frequently used # Once we've deleted a fair bit, vacuum the database. Must be done # outside a transaction. diff --git a/tests/httpcookie.test b/tests/httpcookie.test index ba39c1c..ceca43f 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -92,36 +92,64 @@ test http-cookiejar-3.7 {cookie storage: class} -setup { } -returnCodes error -cleanup { catch {rename ::cookiejar ""} } -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"} -test http-cookiejar-3.8 {cookie storage: class} cookiejar { +test http-cookiejar-3.8 {cookie storage: class} -setup { + catch {rename ::cookiejar ""} + set f [makeFile "" cookiejar] + file delete $f +} -constraints cookiejar -body { + http::cookiejar create ::cookiejar $f +} -cleanup { + catch {rename ::cookiejar ""} + removeFile $f +} -result ::cookiejar +test http-cookiejar-3.9 {cookie storage: class} -setup { + catch {rename ::cookiejar ""} + set f [makeFile "bogus content for a database" cookiejar] +} -constraints cookiejar -body { + http::cookiejar create ::cookiejar $f +} -returnCodes error -cleanup { + catch {rename ::cookiejar ""} + removeFile $f +} -result {file is encrypted or is not a database} +test http-cookiejar-3.10 {cookie storage: class} -setup { + catch {rename ::cookiejar ""} + set dir [makeDirectory cookiejar] +} -constraints cookiejar -body { + http::cookiejar create ::cookiejar $dir +} -returnCodes error -cleanup { + catch {rename ::cookiejar ""} + removeDirectory $dir +} -result {unable to open database file} +test http-cookiejar-3.11 {cookie storage: class} cookiejar { http::cookiejar configure } {-domainfile -domainlist -offline -purgeinterval -vacuumtrigger} -test http-cookiejar-3.9 {cookie storage: class} -constraints cookiejar -body { +test http-cookiejar-3.12 {cookie storage: class} -constraints cookiejar -body { http::cookiejar configure a b c d e } -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} -test http-cookiejar-3.10 {cookie storage: class} -constraints cookiejar -body { +test http-cookiejar-3.13 {cookie storage: class} -constraints cookiejar -body { http::cookiejar configure a } -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -offline, -purgeinterval, or -vacuumtrigger} -test http-cookiejar-3.11 {cookie storage: class} -constraints cookiejar -body { +test http-cookiejar-3.14 {cookie storage: class} -constraints cookiejar -body { http::cookiejar configure -d } -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -offline, -purgeinterval, or -vacuumtrigger} -test http-cookiejar-3.12 {cookie storage: class} -constraints cookiejar -body { +test http-cookiejar-3.15 {cookie storage: class} -constraints cookiejar -body { http::cookiejar configure -off } -match glob -result * -test http-cookiejar-3.13 {cookie storage: class} -setup { +test http-cookiejar-3.16 {cookie storage: class} -setup { set oldval [http::cookiejar configure -offline] } -constraints cookiejar -body { http::cookiejar configure -offline true } -cleanup { catch {http::cookiejar configure -offline $oldval} } -result 1 -test http-cookiejar-3.14 {cookie storage: class} -setup { +test http-cookiejar-3.17 {cookie storage: class} -setup { set oldval [http::cookiejar configure -offline] } -constraints cookiejar -body { http::cookiejar configure -offline nonbool } -cleanup { catch {http::cookiejar configure -offline $oldval} } -returnCodes error -result {expected boolean value but got "nonbool"} -test http-cookiejar-3.15 {cookie storage: class} -setup { +test http-cookiejar-3.18 {cookie storage: class} -setup { set oldval [http::cookiejar configure -purgeinterval] } -constraints cookiejar -body { http::cookiejar configure -purge nonint @@ -496,6 +524,24 @@ test http-cookiejar-4.23 {cookie storage: instance} -setup { } -cleanup { ::cookiejar destroy } -result {} +test http-cookiejar-4.23.a {cookie storage: instance} -setup { + set off [http::cookiejar configure -offline] +} -constraints cookiejar -body { + http::cookiejar configure -offline 1 + [http::cookiejar create ::cookiejar] destroy +} -cleanup { + catch {::cookiejar destroy} + http::cookiejar configure -offline $off +} -result {} +test http-cookiejar-4.23.b {cookie storage: instance} -setup { + set off [http::cookiejar configure -offline] +} -constraints cookiejar -body { + http::cookiejar configure -offline 0 + [http::cookiejar create ::cookiejar] destroy +} -cleanup { + catch {::cookiejar destroy} + http::cookiejar configure -offline $off +} -result {} test http-cookiejar-5.1 {cookie storage: constraints} -setup { http::cookiejar create ::cookiejar -- cgit v0.12 From c60bcbe1737477923bc616621a61177b5121bcbc Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 10 Mar 2014 09:00:31 +0000 Subject: Reorganize log level management, start testing persistence, refactor code to not put so much in ::http namespace --- library/http/cookiejar.tcl | 149 +++++++++++++++++++++++--------------------- tests/httpcookie.test | 151 ++++++++++++++++++++++++++++----------------- 2 files changed, 173 insertions(+), 127 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index a4ee78a..a0225cc 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -17,47 +17,52 @@ package require tcl::idna 1.0 # Configuration for the cookiejar package, plus basic support procedures. # -namespace eval ::http { +# This is the class that we are creating +if {![llength [info commands ::http::cookiejar]]} { + ::oo::class create ::http::cookiejar +} + +namespace eval [info object namespace ::http::cookiejar] { + proc setInt {*var val} { + upvar 1 ${*var} var + if {[catch {incr dummy $val} msg]} { + return -code error $msg + } + set var $val + } + proc setBool {*var val} { + upvar 1 ${*var} var + if {[catch {if {$val} {}} msg]} { + return -code error $msg + } + set var [expr {!!$val}] + } + + proc setLog {*var val} { + upvar 1 ${*var} var + set var [::tcl::prefix match -message "log level" \ + {debug info warn error} $val] + } + # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles - variable cookiejar_version 0.1 + variable version 0.1 # TODO: is this the _right_ list of domains to use? Or is there an alias # for it that will persist longer? - variable cookiejar_domainlist \ + variable domainlist \ http://publicsuffix.org/list/effective_tld_names.dat - variable cookiejar_domainfile \ + variable domainfile \ [file join [file dirname [info script]] effective_tld_names.txt.gz] # The list is directed to from http://publicsuffix.org/list/ - variable cookiejar_loglevel info - variable cookiejar_vacuumtrigger 200 - variable cookiejar_offline false - variable cookiejar_purgeinterval 60000 - - # This is the class that we are creating - if {![llength [info commands cookiejar]]} { - ::oo::class create cookiejar - } - - namespace eval [info object namespace cookiejar] { - proc setInt {*var val} { - upvar 1 ${*var} var - if {[catch {incr dummy $val} msg]} { - return -code error $msg - } - set var $val - } - proc setBool {*var val} { - upvar 1 ${*var} var - if {[catch {if {$val} {}} msg]} { - return -code error $msg - } - set var [expr {!!$val}] - } - } + variable loglevel info + variable vacuumtrigger 200 + variable offline false + variable purgeinterval 60000 + variable domaincache {} # Some support procedures, none particularly useful in general - namespace eval cookiejar_support { + namespace eval support { # Set up a logger if the http package isn't actually loaded yet. if {![llength [info commands ::http::Log]]} { proc ::http::Log args { @@ -97,55 +102,52 @@ namespace eval ::http { clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1 } proc log {level msg args} { - namespace upvar ::http cookiejar_loglevel loglevel - set who [uplevel 1 self] + namespace upvar [info object namespace ::http::cookiejar] \ + loglevel loglevel + set who [uplevel 1 self class] + set mth [uplevel 1 self method] set map {debug 0 info 1 warn 2 error 3} if {[string map $map $level] >= [string map $map $loglevel]} { set msg [format $msg {*}$args] set LVL [string toupper $level] - ::http::Log "[isoNow] $LVL cookiejar($who) - $msg" + ::http::Log "[isoNow] $LVL $who $mth - $msg" } } } } # Now we have enough information to provide the package. -package provide cookiejar $::http::cookiejar_version +package provide cookiejar \ + [set [info object namespace ::http::cookiejar]::version] # The implementation of the cookiejar package ::oo::define ::http::cookiejar { - self method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} { - set tbl { - -domainfile {cookiejar_domainfile set} - -domainlist {cookiejar_domainlist set} - -offline {cookiejar_offline setBool} - -purgeinterval {cookiejar_purgeinterval setInt} - -vacuumtrigger {cookiejar_vacuumtrigger setInt} - } - if {$optionName eq "\u0000\u0000"} { - return [dict keys $tbl] - } - set opt [::tcl::prefix match -message "option" [dict keys $tbl] $optionName] - lassign [dict get $tbl $opt] varname setter - namespace upvar ::http $varname var - if {$optionValue ne "\u0000\u0000"} { - $setter var $optionValue - } - return $var - } - self method loglevel {{level "\u0000\u0000"}} { - namespace upvar ::http cookiejar_loglevel loglevel - if {$level ne "\u0000\u0000"} { - set loglevel [::tcl::prefix match -message "log level" \ - {debug info warn error} $level] + self { + method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} { + set tbl { + -domainfile {domainfile set} + -domainlist {domainlist set} + -loglevel {loglevel setLog} + -offline {offline setBool} + -purgeinterval {purgeinterval setInt} + -vacuumtrigger {vacuumtrigger setInt} + } + if {$optionName eq "\u0000\u0000"} { + return [dict keys $tbl] + } + set opt [::tcl::prefix match -message "option" [dict keys $tbl] $optionName] + lassign [dict get $tbl $opt] varname setter + namespace upvar [namespace current] $varname var + if {$optionValue ne "\u0000\u0000"} { + $setter var $optionValue + } + return $var } - return $loglevel } variable purgeTimer deletions constructor {{path ""}} { - namespace import ::http::cookiejar_support::* - namespace upvar ::http cookiejar_purgeinterval purgeinterval + namespace import [info object namespace [self class]]::support::* if {$path eq ""} { sqlite3 [namespace current]::db :memory: @@ -237,17 +239,25 @@ package provide cookiejar $::http::cookiejar_version } method PostponePurge {} { - namespace upvar ::http cookiejar_purgeinterval interval + namespace upvar [info object namespace [self class]] \ + purgeinterval interval catch {after cancel $purgeTimer} set purgeTimer [after $interval [namespace code {my PurgeCookies}]] } method GetDomainListOnline {} { - upvar 0 ::http::cookiejar_domainlist url + namespace upvar [info object namespace [self class]] \ + domainlist url domaincache cache + lassign $cache when what + if {$when > [clock seconds] - 3600} { + log debug "using cached value created at [clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1]" + return $what + } log debug "loading domain list from %s" $url set tok [::http::geturl $url] try { if {[::http::ncode $tok] == 200} { + set cache [list [clock seconds] [::http::data $tok]] return [::http::data $tok] } log error "failed to fetch list of forbidden cookie domains from %s: %s" \ @@ -258,7 +268,8 @@ package provide cookiejar $::http::cookiejar_version } } method GetDomainListOffline {} { - upvar 0 ::http::cookiejar_domainfile filename + namespace upvar [info object namespace [self class]] \ + domainfile filename log debug "loading domain list from %s" $filename try { set f [open $filename] @@ -278,7 +289,8 @@ package provide cookiejar $::http::cookiejar_version } } method InitDomainList {} { - upvar 0 ::http::cookiejar_offline offline + namespace upvar [info object namespace [self class]] \ + offline offline if {!$offline} { try { set data [my GetDomainListOnline] @@ -529,9 +541,8 @@ package provide cookiejar $::http::cookiejar_version } method PurgeCookies {} { - namespace upvar ::http \ - cookiejar_vacuumtrigger trigger \ - cookiejar_purgeinterval interval + namespace upvar [info object namespace [self class]] \ + vacuumtrigger trigger purgeinterval interval my PostponePurge set now [clock seconds] log debug "purging cookies that expired before %s" [clock format $now] diff --git a/tests/httpcookie.test b/tests/httpcookie.test index ceca43f..41ca07e 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -29,34 +29,65 @@ test http-cookiejar-2.1 {cookie storage: basics} -constraints cookiejar -body { } -returnCodes error -result {wrong # args: should be "http::cookiejar method ?arg ...?"} test http-cookiejar-2.2 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar ? -} -returnCodes error -result {unknown method "?": must be configure, create, destroy, loglevel or new} -test http-cookiejar-2.3 {cookie storage: basics} -constraints cookiejar -body { - http::cookiejar loglevel -} -result info +} -returnCodes error -result {unknown method "?": must be configure, create, destroy or new} +test http-cookiejar-2.3 {cookie storage: basics} cookiejar { + http::cookiejar configure +} {-domainfile -domainlist -loglevel -offline -purgeinterval -vacuumtrigger} test http-cookiejar-2.4 {cookie storage: basics} -constraints cookiejar -body { - http::cookiejar loglevel ? -} -returnCodes error -result {bad log level "?": must be debug, info, warn, or error} + http::cookiejar configure a b c d e +} -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} test http-cookiejar-2.5 {cookie storage: basics} -constraints cookiejar -body { - http::cookiejar loglevel ? ? -} -returnCodes error -result {wrong # args: should be "http::cookiejar loglevel ?level?"} -test http-cookiejar-2.6 {cookie storage: basics} -setup { - set old [http::cookiejar loglevel] + http::cookiejar configure a +} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, or -vacuumtrigger} +test http-cookiejar-2.6 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar configure -d +} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, or -vacuumtrigger} +test http-cookiejar-2.7 {cookie storage: basics} -setup { + set old [http::cookiejar configure -loglevel] } -constraints cookiejar -body { - list [http::cookiejar loglevel] [http::cookiejar loglevel debug] \ - [http::cookiejar loglevel] [http::cookiejar loglevel error] \ - [http::cookiejar loglevel] + list [http::cookiejar configure -loglevel] \ + [http::cookiejar configure -loglevel debug] \ + [http::cookiejar configure -loglevel] \ + [http::cookiejar configure -loglevel error] \ + [http::cookiejar configure -loglevel] } -cleanup { - http::cookiejar loglevel $old + http::cookiejar configure -loglevel $old } -result {info debug debug error error} -test http-cookiejar-2.7 {cookie storage: basics} -setup { - set old [http::cookiejar loglevel] +test http-cookiejar-2.8 {cookie storage: basics} -setup { + set old [http::cookiejar configure -loglevel] } -constraints cookiejar -body { - list [http::cookiejar loglevel] [http::cookiejar loglevel d] \ - [http::cookiejar loglevel i] [http::cookiejar loglevel w] \ - [http::cookiejar loglevel e] + list [http::cookiejar configure -loglevel] \ + [http::cookiejar configure -loglevel d] \ + [http::cookiejar configure -loglevel i] \ + [http::cookiejar configure -loglevel w] \ + [http::cookiejar configure -loglevel e] } -cleanup { - http::cookiejar loglevel $old + http::cookiejar configure -loglevel $old } -result {info debug info warn error} +test http-cookiejar-2.9 {cookie storage: basics} -constraints cookiejar -body { + http::cookiejar configure -off +} -match glob -result * +test http-cookiejar-2.10 {cookie storage: basics} -setup { + set oldval [http::cookiejar configure -offline] +} -constraints cookiejar -body { + http::cookiejar configure -offline true +} -cleanup { + catch {http::cookiejar configure -offline $oldval} +} -result 1 +test http-cookiejar-2.11 {cookie storage: basics} -setup { + set oldval [http::cookiejar configure -offline] +} -constraints cookiejar -body { + http::cookiejar configure -offline nonbool +} -cleanup { + catch {http::cookiejar configure -offline $oldval} +} -returnCodes error -result {expected boolean value but got "nonbool"} +test http-cookiejar-2.12 {cookie storage: basics} -setup { + set oldval [http::cookiejar configure -purgeinterval] +} -constraints cookiejar -body { + http::cookiejar configure -purge nonint +} -cleanup { + catch {http::cookiejar configure -purgeinterval $oldval} +} -returnCodes error -result {expected integer but got "nonint"} test http-cookiejar-3.1 {cookie storage: class} cookiejar { info object isa object http::cookiejar @@ -66,10 +97,10 @@ test http-cookiejar-3.2 {cookie storage: class} cookiejar { } 1 test http-cookiejar-3.3 {cookie storage: class} cookiejar { lsort [info object methods http::cookiejar] -} {configure loglevel} +} {configure} test http-cookiejar-3.4 {cookie storage: class} cookiejar { lsort [info object methods http::cookiejar -all] -} {configure create destroy loglevel new} +} {configure create destroy new} test http-cookiejar-3.5 {cookie storage: class} -setup { catch {rename ::cookiejar ""} } -constraints cookiejar -body { @@ -120,42 +151,6 @@ test http-cookiejar-3.10 {cookie storage: class} -setup { catch {rename ::cookiejar ""} removeDirectory $dir } -result {unable to open database file} -test http-cookiejar-3.11 {cookie storage: class} cookiejar { - http::cookiejar configure -} {-domainfile -domainlist -offline -purgeinterval -vacuumtrigger} -test http-cookiejar-3.12 {cookie storage: class} -constraints cookiejar -body { - http::cookiejar configure a b c d e -} -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} -test http-cookiejar-3.13 {cookie storage: class} -constraints cookiejar -body { - http::cookiejar configure a -} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -offline, -purgeinterval, or -vacuumtrigger} -test http-cookiejar-3.14 {cookie storage: class} -constraints cookiejar -body { - http::cookiejar configure -d -} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -offline, -purgeinterval, or -vacuumtrigger} -test http-cookiejar-3.15 {cookie storage: class} -constraints cookiejar -body { - http::cookiejar configure -off -} -match glob -result * -test http-cookiejar-3.16 {cookie storage: class} -setup { - set oldval [http::cookiejar configure -offline] -} -constraints cookiejar -body { - http::cookiejar configure -offline true -} -cleanup { - catch {http::cookiejar configure -offline $oldval} -} -result 1 -test http-cookiejar-3.17 {cookie storage: class} -setup { - set oldval [http::cookiejar configure -offline] -} -constraints cookiejar -body { - http::cookiejar configure -offline nonbool -} -cleanup { - catch {http::cookiejar configure -offline $oldval} -} -returnCodes error -result {expected boolean value but got "nonbool"} -test http-cookiejar-3.18 {cookie storage: class} -setup { - set oldval [http::cookiejar configure -purgeinterval] -} -constraints cookiejar -body { - http::cookiejar configure -purge nonint -} -cleanup { - catch {http::cookiejar configure -purgeinterval $oldval} -} -returnCodes error -result {expected integer but got "nonint"} test http-cookiejar-4.1 {cookie storage: instance} -setup { http::cookiejar create ::cookiejar @@ -689,6 +684,46 @@ test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { } -cleanup { ::cookiejar destroy } -result {{} session cookie {cookie session-global} {cookie session-global} session-global {}} + +test http-cookiejar-7.1 {cookie storage: persistence of persistent cookies} -setup { + catch {rename ::cookiejar ""} + set f [makeFile "" cookiejar] + file delete $f +} -constraints cookiejar -body { + http::cookiejar create ::cookiejar $f + ::cookiejar destroy + http::cookiejar create ::cookiejar $f +} -cleanup { + catch {rename ::cookiejar ""} + removeFile $f +} -result ::cookiejar +test http-cookiejar-7.2 {cookie storage: persistence of persistent cookies} -setup { + catch {rename ::cookiejar ""} + set f [makeFile "" cookiejar] + file delete $f + set result {} +} -constraints cookiejar -body { + http::cookiejar create ::cookiejar $f + cookiejar storeCookie [dict replace { + key foo + value cookie + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } expires [expr {[clock seconds]+1}]] + lappend result [::cookiejar getCookies http www.example.com /] + ::cookiejar destroy + http::cookiejar create ::cookiejar + lappend result [::cookiejar getCookies http www.example.com /] + ::cookiejar destroy + http::cookiejar create ::cookiejar $f + lappend result [::cookiejar getCookies http www.example.com /] +} -cleanup { + catch {rename ::cookiejar ""} + removeFile $f +} -result {{foo cookie} {} {foo cookie}} ::tcltest::cleanupTests -- cgit v0.12 From 4fb87dc8dec7a0e8d59a97e0e3f398ecc4cc6f46 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 31 Mar 2014 08:08:01 +0000 Subject: Better cookie option parsing that doesn't throw away critical information. --- library/http/http.tcl | 52 +++++++++++++++++++++++++++------------------------ 1 file changed, 28 insertions(+), 24 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 8720be1..620ade2 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1210,55 +1210,59 @@ proc http::ParseCookie {token value} { set realopts {hostonly 1 path / secure 0 httponly 0} dict set realopts origin $state(host) dict set realopts domain $state(host) - foreach opt [split [regsub -all {;\s+} $opts \u0000] \u0000] { - switch -glob -nocase -- $opt { - Expires=* { - set opt [string range $opt 8 end] + foreach option [split [regsub -all {;\s+} $opts \u0000] \u0000] { + regexp {^(.*?)(?:=(.*))?$} $option -> optname optval + switch -exact -- [string tolower $optname] { + expires { if {[catch { #Sun, 06 Nov 1994 08:49:37 GMT dict set realopts expires \ - [clock scan $opt -format "%a, %d %b %Y %T %Z"] + [clock scan $optval -format "%a, %d %b %Y %T %Z"] }] && [catch { # Google does this one #Mon, 01-Jan-1990 00:00:00 GMT dict set realopts expires \ - [clock scan $opt -format "%a, %d-%b-%Y %T %Z"] + [clock scan $optval -format "%a, %d-%b-%Y %T %Z"] }] && [catch { # This is in the RFC, but it is also in the original # Netscape cookie spec, now online at: # #Sunday, 06-Nov-94 08:49:37 GMT dict set realopts expires \ - [clock scan $opt -format "%A, %d-%b-%y %T %Z"] + [clock scan $optval -format "%A, %d-%b-%y %T %Z"] }]} {catch { #Sun Nov 6 08:49:37 1994 dict set realopts expires \ - [clock scan $opt -gmt 1 -format "%a %b %d %T %Y"] + [clock scan $optval -gmt 1 -format "%a %b %d %T %Y"] }} } - Max-Age=* { + max-age { # Normalize - set opt [string range $opt 8 end] - if {[string is integer -strict $opt]} { - dict set realopts expires [expr {[clock seconds] + $opt}] + if {[string is integer -strict $optval]} { + dict set realopts expires [expr {[clock seconds] + $optval}] } } - Domain=* { - set opt [string trimleft [string range $opt 7 end] "."] - if {$opt ne "" && ![string match *. $opt]} { - dict set realopts domain $opt - dict set realopts hostonly 0 + domain { + # From the domain-matches definition [RFC 2109, section 2]: + # Host A's name domain-matches host B's if [...] + # A is a FQDN string and has the form NB, where N is a + # non-empty name string, B has the form .B', and B' is a + # FQDN string. (So, x.y.com domain-matches .y.com but + # not y.com.) + if {$optval ne "" && ![string match *. $optval]} { + dict set realopts domain [string trimleft $optval "."] + dict set realopts hostonly [expr { + ! [string match .* $optval] + }] } } - Path=* { - set opt [string range $opt 5 end] - if {![string match /* $opt]} { - set opt $state(path) + path { + if {[string match /* $optval]} { + dict set realopts path $optval } - dict set realopts path $opt } - Secure - HttpOnly { - dict set realopts [string tolower $opt] 1 + secure - httponly { + dict set realopts [string tolower $optname] 1 } } } -- cgit v0.12 From c7e456e77d93bb89039ff214903039dee34a4ceb Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 1 Apr 2014 08:18:41 +0000 Subject: Limit number of cookies stored, deleting least recently used ones. --- library/http/cookiejar.tcl | 48 +++++++++++++++++++++++++++++++++++----------- tests/httpcookie.test | 6 +++--- 2 files changed, 40 insertions(+), 14 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index a0225cc..5a1ee2f 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -57,6 +57,7 @@ namespace eval [info object namespace ::http::cookiejar] { # The list is directed to from http://publicsuffix.org/list/ variable loglevel info variable vacuumtrigger 200 + variable retainlimit 100 variable offline false variable purgeinterval 60000 variable domaincache {} @@ -130,6 +131,7 @@ package provide cookiejar \ -loglevel {loglevel setLog} -offline {offline setBool} -purgeinterval {purgeinterval setInt} + -retain {retainlimit setInt} -vacuumtrigger {vacuumtrigger setInt} } if {$optionName eq "\u0000\u0000"} { @@ -171,6 +173,7 @@ package provide cookiejar \ value TEXT NOT NULL, originonly INTEGER NOT NULL, expiry INTEGER NOT NULL, + lastuse INTEGER NOT NULL, creation INTEGER NOT NULL); CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique ON persistentCookies (domain, path, key); @@ -391,18 +394,24 @@ package provide cookiejar \ method GetCookiesForHostAndPath {listVar secure host path fullhost} { upvar 1 $listVar result log debug "check for cookies for %s" [locn $secure $host $path] + set exact [expr {$host eq $fullhost}] db eval { SELECT key, value FROM persistentCookies WHERE domain = $host AND path = $path AND secure <= $secure AND (NOT originonly OR domain = $fullhost) + AND originonly = $exact } { lappend result $key $value + db eval { + UPDATE persistentCookies SET lastuse = $now WHERE id = $id + } } set now [clock seconds] db eval { SELECT id, key, value FROM sessionCookies WHERE domain = $host AND path = $path AND secure <= $secure AND (NOT originonly OR domain = $fullhost) + AND originonly = $exact } { lappend result $key $value db eval { @@ -499,11 +508,13 @@ package provide cookiejar \ if {!$persistent} { db eval { INSERT OR REPLACE INTO sessionCookies ( - secure, domain, path, key, value, originonly, creation, lastuse) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, $now, $now); + secure, domain, path, key, value, originonly, creation, + lastuse) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, + $now, $now); DELETE FROM persistentCookies WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure + AND secure <= $secure AND originonly = $hostonly } incr deletions [db changes] log debug "defined session cookie for %s" \ @@ -512,13 +523,13 @@ package provide cookiejar \ db eval { DELETE FROM persistentCookies WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure; + AND secure <= $secure AND originonly = $hostonly } set del [db changes] db eval { DELETE FROM sessionCookies WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure; + AND secure <= $secure AND originonly = $hostonly } incr deletions [incr del [db changes]] log debug "deleted %d cookies for %s" \ @@ -526,11 +537,13 @@ package provide cookiejar \ } else { db eval { INSERT OR REPLACE INTO persistentCookies ( - secure, domain, path, key, value, originonly, expiry, creation) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, $expires, $now); + secure, domain, path, key, value, originonly, expiry, + creation, lastuse) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, + $expires, $now, $now); DELETE FROM sessionCookies WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure + AND secure <= $secure AND originonly = $hostonly } incr deletions [db changes] log debug "defined persistent cookie for %s, expires at %s" \ @@ -542,7 +555,8 @@ package provide cookiejar \ method PurgeCookies {} { namespace upvar [info object namespace [self class]] \ - vacuumtrigger trigger purgeinterval interval + vacuumtrigger trigger purgeinterval interval \ + retainlimit retain my PostponePurge set now [clock seconds] log debug "purging cookies that expired before %s" [clock format $now] @@ -551,8 +565,20 @@ package provide cookiejar \ DELETE FROM persistentCookies WHERE expiry < $now } incr deletions [db changes] - ### TODO: Cap the total number of cookies and session cookies, - ### purging least frequently used + db eval { + DELETE FROM persistentCookies WHERE id IN ( + SELECT id FROM persistentCookies ORDER BY lastuse + LIMIT MAX(0, ( + SELECT COUNT(*) FROM persistentCookies) - $retain)) + } + incr deletions [db changes] + db eval { + DELETE FROM sessionCookies WHERE id IN ( + SELECT id FROM sessionCookies ORDER BY lastuse + LIMIT MAX(0, ( + SELECT COUNT(*) FROM sessionCookies) - $retain)) + } + incr deletions [db changes] } # Once we've deleted a fair bit, vacuum the database. Must be done diff --git a/tests/httpcookie.test b/tests/httpcookie.test index 41ca07e..b57638d 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -32,16 +32,16 @@ test http-cookiejar-2.2 {cookie storage: basics} -constraints cookiejar -body { } -returnCodes error -result {unknown method "?": must be configure, create, destroy or new} test http-cookiejar-2.3 {cookie storage: basics} cookiejar { http::cookiejar configure -} {-domainfile -domainlist -loglevel -offline -purgeinterval -vacuumtrigger} +} {-domainfile -domainlist -loglevel -offline -purgeinterval -retain -vacuumtrigger} test http-cookiejar-2.4 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar configure a b c d e } -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} test http-cookiejar-2.5 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar configure a -} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, or -vacuumtrigger} +} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, -retain, or -vacuumtrigger} test http-cookiejar-2.6 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar configure -d -} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, or -vacuumtrigger} +} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, -retain, or -vacuumtrigger} test http-cookiejar-2.7 {cookie storage: basics} -setup { set old [http::cookiejar configure -loglevel] } -constraints cookiejar -body { -- cgit v0.12 From 02e0c5c152d48bd9ee31664b92b0ff85b222667f Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 20 Apr 2014 15:28:24 +0000 Subject: more tinkering --- library/http/cookiejar.tcl | 323 +++++++++++++++++++++++++++++---------------- tests/httpcookie.test | 133 ++++++++++++++++++- 2 files changed, 333 insertions(+), 123 deletions(-) diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl index 5a1ee2f..1fc1ffe 100644 --- a/library/http/cookiejar.tcl +++ b/library/http/cookiejar.tcl @@ -30,6 +30,14 @@ namespace eval [info object namespace ::http::cookiejar] { } set var $val } + proc setInterval {trigger *var val} { + upvar 1 ${*var} var + if {![string is integer -strict $val] || $val < 1} { + return -code error "expected positive integer but got \"$val\"" + } + set var $val + {*}$trigger + } proc setBool {*var val} { upvar 1 ${*var} var if {[catch {if {$val} {}} msg]} { @@ -48,8 +56,6 @@ namespace eval [info object namespace ::http::cookiejar] { # Makefiles variable version 0.1 - # TODO: is this the _right_ list of domains to use? Or is there an alias - # for it that will persist longer? variable domainlist \ http://publicsuffix.org/list/effective_tld_names.dat variable domainfile \ @@ -60,6 +66,7 @@ namespace eval [info object namespace ::http::cookiejar] { variable retainlimit 100 variable offline false variable purgeinterval 60000 + variable refreshinterval 10000000 variable domaincache {} # Some support procedures, none particularly useful in general @@ -128,26 +135,41 @@ package provide cookiejar \ set tbl { -domainfile {domainfile set} -domainlist {domainlist set} + -domainrefresh {refreshinterval setInterval} -loglevel {loglevel setLog} -offline {offline setBool} - -purgeinterval {purgeinterval setInt} + -purgeold {purgeinterval setInterval} -retain {retainlimit setInt} -vacuumtrigger {vacuumtrigger setInt} } + dict lappend tbl -domainrefresh [namespace code { + my IntervalTrigger PostponeRefresh + }] + dict lappend tbl -purgeold [namespace code { + my IntervalTrigger PostponePurge + }] if {$optionName eq "\u0000\u0000"} { return [dict keys $tbl] } - set opt [::tcl::prefix match -message "option" [dict keys $tbl] $optionName] - lassign [dict get $tbl $opt] varname setter + set opt [::tcl::prefix match -message "option" \ + [dict keys $tbl] $optionName] + set setter [lassign [dict get $tbl $opt] varname] namespace upvar [namespace current] $varname var if {$optionValue ne "\u0000\u0000"} { - $setter var $optionValue + {*}$setter var $optionValue } return $var } + + method IntervalTrigger {method} { + # TODO: handle subclassing + foreach obj [info class instances [self]] { + [info object namespace $obj]::my $method + } + } } - variable purgeTimer deletions + variable purgeTimer deletions refreshTimer constructor {{path ""}} { namespace import [info object namespace [self class]]::support::* @@ -161,83 +183,100 @@ package provide cookiejar \ } set deletions 0 - db eval { - --;# Store the persistent cookies in this table. - --;# Deletion policy: once they expire, or if explicitly killed. - CREATE TABLE IF NOT EXISTS persistentCookies ( - id INTEGER PRIMARY KEY, - secure INTEGER NOT NULL, - domain TEXT NOT NULL COLLATE NOCASE, - path TEXT NOT NULL, - key TEXT NOT NULL, - value TEXT NOT NULL, - originonly INTEGER NOT NULL, - expiry INTEGER NOT NULL, - lastuse INTEGER NOT NULL, - creation INTEGER NOT NULL); - CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique - ON persistentCookies (domain, path, key); - CREATE INDEX IF NOT EXISTS persistentLookup - ON persistentCookies (domain, path); - - --;# Store the session cookies in this table. - --;# Deletion policy: at cookiejar instance deletion, if - --;# explicitly killed, or if the number of session cookies is too - --;# large and the cookie has not been used recently. - CREATE TEMP TABLE sessionCookies ( - id INTEGER PRIMARY KEY, - secure INTEGER NOT NULL, - domain TEXT NOT NULL COLLATE NOCASE, - path TEXT NOT NULL, - key TEXT NOT NULL, - originonly INTEGER NOT NULL, - value TEXT NOT NULL, - lastuse INTEGER NOT NULL, - creation INTEGER NOT NULL); - CREATE UNIQUE INDEX sessionUnique - ON sessionCookies (domain, path, key); - CREATE INDEX sessionLookup ON sessionCookies (domain, path); - - --;# View to allow for simple looking up of a cookie. - --;# Deletion policy: NOT SUPPORTED via this view. - CREATE TEMP VIEW cookies AS - SELECT id, domain, path, key, value, originonly, secure, - 1 AS persistent - FROM persistentCookies - UNION - SELECT id, domain, path, key, value, originonly, secure, - 0 AS persistent - FROM sessionCookies; - - --;# Encoded domain permission policy; if forbidden is 1, no - --;# cookie may be ever set for the domain, and if forbidden is 0, - --;# cookies *may* be created for the domain (overriding the - --;# forbiddenSuper table). - --;# Deletion policy: normally not modified. - CREATE TABLE IF NOT EXISTS domains ( - domain TEXT PRIMARY KEY NOT NULL, - forbidden INTEGER NOT NULL); - - --;# Domains that may not have a cookie defined for direct child - --;# domains of them. - --;# Deletion policy: normally not modified. - CREATE TABLE IF NOT EXISTS forbiddenSuper ( - domain TEXT PRIMARY KEY); - } - - set cookieCount "no" - db eval { - SELECT COUNT(*) AS cookieCount FROM persistentCookies - } - log info "%s with %s entries" $storeorigin $cookieCount + db transaction { + db eval { + --;# Store the persistent cookies in this table. + --;# Deletion policy: once they expire, or if explicitly + --;# killed. + CREATE TABLE IF NOT EXISTS persistentCookies ( + id INTEGER PRIMARY KEY, + secure INTEGER NOT NULL, + domain TEXT NOT NULL COLLATE NOCASE, + path TEXT NOT NULL, + key TEXT NOT NULL, + value TEXT NOT NULL, + originonly INTEGER NOT NULL, + expiry INTEGER NOT NULL, + lastuse INTEGER NOT NULL, + creation INTEGER NOT NULL); + CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique + ON persistentCookies (domain, path, key); + CREATE INDEX IF NOT EXISTS persistentLookup + ON persistentCookies (domain, path); + + --;# Store the session cookies in this table. + --;# Deletion policy: at cookiejar instance deletion, if + --;# explicitly killed, or if the number of session cookies is + --;# too large and the cookie has not been used recently. + CREATE TEMP TABLE sessionCookies ( + id INTEGER PRIMARY KEY, + secure INTEGER NOT NULL, + domain TEXT NOT NULL COLLATE NOCASE, + path TEXT NOT NULL, + key TEXT NOT NULL, + originonly INTEGER NOT NULL, + value TEXT NOT NULL, + lastuse INTEGER NOT NULL, + creation INTEGER NOT NULL); + CREATE UNIQUE INDEX sessionUnique + ON sessionCookies (domain, path, key); + CREATE INDEX sessionLookup ON sessionCookies (domain, path); + + --;# View to allow for simple looking up of a cookie. + --;# Deletion policy: NOT SUPPORTED via this view. + CREATE TEMP VIEW cookies AS + SELECT id, domain, ( + CASE originonly WHEN 1 THEN path ELSE '.' || path END + ) AS path, key, value, secure, 1 AS persistent + FROM persistentCookies + UNION + SELECT id, domain, ( + CASE originonly WHEN 1 THEN path ELSE '.' || path END + ) AS path, key, value, secure, 0 AS persistent + FROM sessionCookies; + + --;# Encoded domain permission policy; if forbidden is 1, no + --;# cookie may be ever set for the domain, and if forbidden + --;# is 0, cookies *may* be created for the domain (overriding + --;# the forbiddenSuper table). + --;# Deletion policy: normally not modified. + CREATE TABLE IF NOT EXISTS domains ( + domain TEXT PRIMARY KEY NOT NULL, + forbidden INTEGER NOT NULL); + + --;# Domains that may not have a cookie defined for direct + --;# child domains of them. + --;# Deletion policy: normally not modified. + CREATE TABLE IF NOT EXISTS forbiddenSuper ( + domain TEXT PRIMARY KEY); + + --;# When we last retrieved the domain list. + CREATE TABLE IF NOT EXISTS domainCacheMetadata ( + id INTEGER PRIMARY KEY, + retrievalDate INTEGER, + installDate INTEGER); + } - my PostponePurge + set cookieCount "no" + db eval { + SELECT COUNT(*) AS cookieCount FROM persistentCookies + } + log info "%s with %s entries" $storeorigin $cookieCount - # TODO: domain list refresh policy - if {$path ne "" && ![db exists { - SELECT 1 FROM domains - }]} then { - my InitDomainList + my PostponePurge + + if {$path ne ""} { + if {[db exists {SELECT 1 FROM domains}]} { + my RefreshDomains + } else { + my InitDomainList + my PostponeRefresh + } + } else { + set data [my GetDomainListOffline metadata] + my InstallDomainData $data $metadata + my PostponeRefresh + } } } @@ -248,29 +287,67 @@ package provide cookiejar \ set purgeTimer [after $interval [namespace code {my PurgeCookies}]] } - method GetDomainListOnline {} { + method PostponeRefresh {} { + namespace upvar [info object namespace [self class]] \ + refreshinterval interval + catch {after cancel $refreshTimer} + set refreshTimer [after $interval [namespace code {my RefreshDomains}]] + } + + method RefreshDomains {} { + # TODO: domain list refresh policy + my PostponeRefresh + } + + method HttpGet {url {timeout 0} {maxRedirects 5}} { + for {set r 0} {$r < $maxRedirects} {incr r} { + set tok [::http::geturl $url -timeout $timeout] + try { + if {[::http::status $tok] eq "timeout"} { + return -code error "connection timed out" + } elseif {[::http::ncode $tok] == 200} { + return [::http::data $tok] + } elseif {[::http::ncode $tok] >= 400} { + return -code error [::http::error $tok] + } elseif {[dict exists [::http::meta $tok] Location]} { + set url [dict get [::http::meta $tok] Location] + continue + } + return -code error \ + "unexpected state: [::http::code $tok]" + } finally { + ::http::cleanup $tok + } + } + return -code error "too many redirects" + } + method GetDomainListOnline {metaVar} { + upvar 1 $metaVar meta namespace upvar [info object namespace [self class]] \ domainlist url domaincache cache - lassign $cache when what + lassign $cache when data if {$when > [clock seconds] - 3600} { - log debug "using cached value created at [clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1]" - return $what + log debug "using cached value created at %s" \ + [clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1] + dict set meta retrievalDate $when + return $data } log debug "loading domain list from %s" $url - set tok [::http::geturl $url] try { - if {[::http::ncode $tok] == 200} { - set cache [list [clock seconds] [::http::data $tok]] - return [::http::data $tok] - } + set when [clock seconds] + set data [my HttpGet $url] + set cache [list $when $data] + # TODO: Should we use the Last-Modified header instead? + dict set meta retrievalDate $when + return $data + } on error msg { log error "failed to fetch list of forbidden cookie domains from %s: %s" \ - $url [::http::error $tok] + $url $msg return {} - } finally { - ::http::cleanup $tok } } - method GetDomainListOffline {} { + method GetDomainListOffline {metaVar} { + upvar 1 $metaVar meta namespace upvar [info object namespace [self class]] \ domainfile filename log debug "loading domain list from %s" $filename @@ -281,6 +358,7 @@ package provide cookiejar \ zlib push gunzip $f } fconfigure $f -encoding utf-8 + dict set meta retrievalDate [file mtime $filename] return [read $f] } finally { close $f @@ -296,19 +374,20 @@ package provide cookiejar \ offline offline if {!$offline} { try { - set data [my GetDomainListOnline] + set data [my GetDomainListOnline metadata] if {[string length $data]} { - my InstallDomainData $data + my InstallDomainData $data $metadata return } } on error {} { log warn "attempting to fall back to built in version" } } - my InstallDomainData [my GetDomainListOffline] + set data [my GetDomainListOffline metadata] + my InstallDomainData $data $metadata } - method InstallDomainData {data} { + method InstallDomainData {data meta} { set n [db total_changes] db transaction { foreach line [split $data "\n"] { @@ -365,6 +444,15 @@ package provide cookiejar \ $idna $line $utf [::tcl::idna decode $idna] } } + + dict with meta { + set installDate [clock seconds] + db eval { + INSERT OR REPLACE INTO domainCacheMetadata + (id, retrievalDate, installDate) + VALUES (1, $retrievalDate, $installDate); + } + } } set n [expr {[db total_changes] - $n}] log info "constructed domain info with %d entries" $n @@ -376,6 +464,9 @@ package provide cookiejar \ db eval { DELETE FROM domains; DELETE FROM forbiddenSuper; + INSERT OR REPLACE INTO domainCacheMetadata + (id, retrievalDate, installDate) + VALUES (1, -1, -1); } my InitDomainList } @@ -386,6 +477,9 @@ package provide cookiejar \ after cancel $purgeTimer } catch { + after cancel $refreshTimer + } + catch { db close } return @@ -423,7 +517,12 @@ package provide cookiejar \ method getCookies {proto host path} { set result {} set paths [splitPath $path] - set domains [splitDomain [string tolower [::tcl::idna encode $host]]] + if {[regexp {[^0-9.]} $host]} { + set domains [splitDomain [string tolower [::tcl::idna encode $host]]] + } else { + # Ugh, it's a numeric domain! Restrict it to just itself... + set domains [list $host] + } set secure [string equal -nocase $proto "https"] # Open question: how to move these manipulations into the database # engine (if that's where they *should* be). @@ -436,20 +535,13 @@ package provide cookiejar \ # do the splitting exactly right, and it's far easier to work with # strings in Tcl than in SQL. db transaction { - if {[regexp {[^0-9.]} $host]} { - foreach domain $domains { - foreach p $paths { - my GetCookiesForHostAndPath result $secure $domain $p $host - } - } - } else { - # Ugh, it's a numeric domain! Restrict it... + foreach domain $domains { foreach p $paths { - my GetCookiesForHostAndPath result $secure $host $p $host + my GetCookiesForHostAndPath result $secure $domain $p $host } } + return $result } - return $result } method BadDomain options { @@ -555,8 +647,7 @@ package provide cookiejar \ method PurgeCookies {} { namespace upvar [info object namespace [self class]] \ - vacuumtrigger trigger purgeinterval interval \ - retainlimit retain + vacuumtrigger trigger retainlimit retain my PostponePurge set now [clock seconds] log debug "purging cookies that expired before %s" [clock format $now] @@ -567,16 +658,14 @@ package provide cookiejar \ incr deletions [db changes] db eval { DELETE FROM persistentCookies WHERE id IN ( - SELECT id FROM persistentCookies ORDER BY lastuse - LIMIT MAX(0, ( - SELECT COUNT(*) FROM persistentCookies) - $retain)) + SELECT id FROM persistentCookies ORDER BY lastuse ASC + LIMIT -1 OFFSET $retain) } incr deletions [db changes] db eval { DELETE FROM sessionCookies WHERE id IN ( SELECT id FROM sessionCookies ORDER BY lastuse - LIMIT MAX(0, ( - SELECT COUNT(*) FROM sessionCookies) - $retain)) + LIMIT -1 OFFSET $retain) } incr deletions [db changes] } diff --git a/tests/httpcookie.test b/tests/httpcookie.test index b57638d..204c263 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -32,16 +32,16 @@ test http-cookiejar-2.2 {cookie storage: basics} -constraints cookiejar -body { } -returnCodes error -result {unknown method "?": must be configure, create, destroy or new} test http-cookiejar-2.3 {cookie storage: basics} cookiejar { http::cookiejar configure -} {-domainfile -domainlist -loglevel -offline -purgeinterval -retain -vacuumtrigger} +} {-domainfile -domainlist -domainrefresh -loglevel -offline -purgeold -retain -vacuumtrigger} test http-cookiejar-2.4 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar configure a b c d e } -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} test http-cookiejar-2.5 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar configure a -} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, -retain, or -vacuumtrigger} +} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger} test http-cookiejar-2.6 {cookie storage: basics} -constraints cookiejar -body { http::cookiejar configure -d -} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -loglevel, -offline, -purgeinterval, -retain, or -vacuumtrigger} +} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger} test http-cookiejar-2.7 {cookie storage: basics} -setup { set old [http::cookiejar configure -loglevel] } -constraints cookiejar -body { @@ -82,12 +82,41 @@ test http-cookiejar-2.11 {cookie storage: basics} -setup { catch {http::cookiejar configure -offline $oldval} } -returnCodes error -result {expected boolean value but got "nonbool"} test http-cookiejar-2.12 {cookie storage: basics} -setup { - set oldval [http::cookiejar configure -purgeinterval] + set oldval [http::cookiejar configure -purgeold] } -constraints cookiejar -body { http::cookiejar configure -purge nonint } -cleanup { - catch {http::cookiejar configure -purgeinterval $oldval} -} -returnCodes error -result {expected integer but got "nonint"} + catch {http::cookiejar configure -purgeold $oldval} +} -returnCodes error -result {expected positive integer but got "nonint"} +test http-cookiejar-2.13 {cookie storage: basics} -setup { + set oldval [http::cookiejar configure -domainrefresh] +} -constraints cookiejar -body { + http::cookiejar configure -domainref nonint +} -cleanup { + catch {http::cookiejar configure -domainrefresh $oldval} +} -returnCodes error -result {expected positive integer but got "nonint"} +test http-cookiejar-2.14 {cookie storage: basics} -setup { + set oldval [http::cookiejar configure -domainrefresh] +} -constraints cookiejar -body { + http::cookiejar configure -domainref -42 +} -cleanup { + catch {http::cookiejar configure -domainrefresh $oldval} +} -returnCodes error -result {expected positive integer but got "-42"} +test http-cookiejar-2.15 {cookie storage: basics} -setup { + set oldval [http::cookiejar configure -domainrefresh] + set result unset + set tracer [http::cookiejar create tracer] +} -constraints cookiejar -body { + oo::objdefine $tracer method PostponeRefresh {} { + set ::result set + next + } + http::cookiejar configure -domainref 12345 + return $result +} -cleanup { + $tracer destroy + catch {http::cookiejar configure -domainrefresh $oldval} +} -result set test http-cookiejar-3.1 {cookie storage: class} cookiejar { info object isa object http::cookiejar @@ -624,6 +653,98 @@ test http-cookiejar-5.4 {cookie storage: constraints} -setup { } -cleanup { ::cookiejar destroy } -result {example.com www.example.com} +test http-cookiejar-5.5 {cookie storage: constraints} -setup { + http::cookiejar create ::cookiejar + cookiejar forceLoadDomainData +} -constraints cookiejar -body { + cookiejar storeCookie { + key foo1 + value 1 + secure 0 + domain com + origin www.example.com + path / + hostonly 0 + } + cookiejar storeCookie { + key foo2 + value 2 + secure 0 + domain com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie { + key foo3 + value 3 + secure 0 + domain example.com + origin www.example.com + path / + hostonly 0 + } + cookiejar storeCookie { + key foo4 + value 4 + secure 0 + domain example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie { + key foo5 + value 5 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 0 + } + cookiejar storeCookie { + key foo6 + value 6 + secure 0 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie { + key foo7 + value 7 + secure 1 + domain www.example.com + origin www.example.com + path / + hostonly 0 + } + cookiejar storeCookie { + key foo8 + value 8 + secure 1 + domain www.example.com + origin www.example.com + path / + hostonly 1 + } + cookiejar storeCookie { + key foo9 + value 9 + secure 0 + domain sub.www.example.com + origin www.example.com + path / + hostonly 1 + } + list [cookiejar getCookies http www.example.com /] \ + [cookiejar getCookies http www2.example.com /] \ + [cookiejar getCookies https www.example.com /] \ + [cookiejar getCookies http sub.www.example.com /] +} -cleanup { + ::cookiejar destroy +} -result {{foo3 3 foo6 6} {foo3 3} {foo3 3 foo6 6 foo8 8} {foo3 3 foo5 5}} test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup { http::cookiejar create ::cookiejar -- cgit v0.12 From ccc37a91935f90ede0be48b9a71b93f54267e608 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 May 2014 06:58:21 +0000 Subject: Update Unicode tables to Unicode 7.0 beta --- generic/regc_locale.c | 637 ++++++++++--------- generic/tclUniData.c | 1620 ++++++++++++++++++++++++++----------------------- 2 files changed, 1194 insertions(+), 1063 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 0006635..a6966b5 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -137,97 +137,107 @@ static const crange alphaRangeTable[] = { {0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6}, {0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374}, {0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5}, - {0x3f7, 0x481}, {0x48a, 0x527}, {0x531, 0x556}, {0x561, 0x587}, + {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587}, {0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3}, {0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea}, - {0x800, 0x815}, {0x840, 0x858}, {0x8a2, 0x8ac}, {0x904, 0x939}, - {0x958, 0x961}, {0x971, 0x977}, {0x979, 0x97f}, {0x985, 0x98c}, - {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, - {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, - {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, - {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, - {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, - {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, - {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc33}, - {0xc35, 0xc39}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, - {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, - {0xd12, 0xd3a}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, - {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, - {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0}, - {0xec0, 0xec4}, {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c}, - {0xf88, 0xf8c}, {0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d}, - {0x106e, 0x1070}, {0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, - {0x10fc, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, - {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, - {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, - {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f4}, - {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, - {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, - {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877}, - {0x1880, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1950, 0x196d}, - {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19c1, 0x19c7}, {0x1a00, 0x1a16}, - {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, - {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, - {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, - {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, - {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, - {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, - {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, - {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, - {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, - {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, - {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, - {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, - {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, - {0x30fc, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, - {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fcc}, {0xa000, 0xa48c}, - {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, - {0xa67f, 0xa697}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, - {0xa78b, 0xa78e}, {0xa790, 0xa793}, {0xa7a0, 0xa7aa}, {0xa7f8, 0xa801}, - {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, - {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, - {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42}, - {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa80, 0xaaaf}, {0xaab9, 0xaabd}, - {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, - {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, - {0xabc0, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, - {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, - {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, - {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, - {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, - {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, - {0xffda, 0xffdc} + {0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b2}, {0x904, 0x939}, + {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, {0x993, 0x9a8}, + {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, {0xa05, 0xa0a}, + {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, {0xa72, 0xa74}, + {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0}, + {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, + {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, + {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xc05, 0xc0c}, + {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc85, 0xc8c}, + {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, + {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd7a, 0xd7f}, + {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, + {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97}, {0xe99, 0xe9f}, + {0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf}, + {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a}, + {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081}, + {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d}, + {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, + {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, + {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, + {0x1380, 0x138f}, {0x13a0, 0x13f4}, {0x1401, 0x166c}, {0x166f, 0x167f}, + {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, {0x1700, 0x170c}, + {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176c}, + {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8}, + {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, + {0x1980, 0x19ab}, {0x19c1, 0x19c7}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, + {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, + {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1ce9, 0x1cec}, + {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, + {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, + {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, + {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, + {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d}, + {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149}, + {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, + {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, + {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, + {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035}, + {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, + {0x3105, 0x312d}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, + {0x3400, 0x4db5}, {0x4e00, 0x9fcc}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, + {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d}, + {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa78e}, + {0xa790, 0xa7ad}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, + {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, + {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, + {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28}, + {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf}, + {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, + {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, + {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab5f}, {0xabc0, 0xabe2}, + {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, + {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, + {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, + {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74}, + {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe}, + {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc} #if TCL_UTF_MAX > 4 ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d}, {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0}, - {0x10300, 0x1031e}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10380, 0x1039d}, - {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, {0x10800, 0x10805}, - {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10900, 0x10915}, {0x10920, 0x10939}, + {0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375}, + {0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, + {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755}, + {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855}, + {0x10860, 0x10876}, {0x10880, 0x1089e}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, - {0x10a60, 0x10a7c}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, + {0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, + {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8}, - {0x11103, 0x11126}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11680, 0x116aa}, - {0x12000, 0x1236e}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44}, - {0x16f93, 0x16f9f}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, + {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, + {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x112b0, 0x112de}, {0x11305, 0x1130c}, + {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361}, + {0x11480, 0x114af}, {0x11580, 0x115ae}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, + {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x12000, 0x12398}, {0x13000, 0x1342e}, + {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, + {0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, + {0x16f93, 0x16f9f}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, + {0x1bc90, 0x1bc99}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, - {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, - {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, - {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, - {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, - {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2f800, 0x2fa1d} + {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1ee00, 0x1ee03}, + {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, + {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, + {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, + {0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, + {0x2f800, 0x2fa1d} #endif }; #define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange)) static const chr alphaCharTable[] = { - 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x386, 0x38c, - 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, 0x6ff, - 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, 0x8a0, + 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386, + 0x38c, 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, + 0x6ff, 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, 0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd, 0x9f0, 0x9f1, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xb0f, @@ -241,14 +251,16 @@ static const chr alphaCharTable[] = { 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, - 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, - 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44 + 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa7b0, 0xa7b1, 0xa8fb, 0xa9cf, 0xaa7a, + 0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xab64, 0xab65, 0xfb1d, 0xfb3e, + 0xfb40, 0xfb41, 0xfb43, 0xfb44 #if TCL_UTF_MAX > 4 ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x109be, 0x109bf, 0x10a00, - 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, - 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, - 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, - 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e + 0x11176, 0x111da, 0x1130f, 0x11310, 0x11332, 0x11333, 0x1133d, 0x114c4, 0x114c5, + 0x114c7, 0x11644, 0x118ff, 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, + 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, + 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, + 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e #endif }; @@ -259,11 +271,12 @@ static const chr alphaCharTable[] = { */ static const crange controlRangeTable[] = { - {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, + {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f}, {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb} #if TCL_UTF_MAX > 4 - ,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd} + ,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, + {0x100000, 0x10fffd} #endif }; @@ -286,15 +299,18 @@ static const crange digitRangeTable[] = { {0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9}, {0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef}, {0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef}, - {0xd66, 0xd6f}, {0xe50, 0xe59}, {0xed0, 0xed9}, {0xf20, 0xf29}, - {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9}, {0x1810, 0x1819}, - {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89}, {0x1a90, 0x1a99}, - {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49}, {0x1c50, 0x1c59}, - {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909}, {0xa9d0, 0xa9d9}, - {0xaa50, 0xaa59}, {0xabf0, 0xabf9}, {0xff10, 0xff19} + {0xd66, 0xd6f}, {0xde6, 0xdef}, {0xe50, 0xe59}, {0xed0, 0xed9}, + {0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9}, + {0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89}, + {0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49}, + {0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909}, + {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9}, + {0xff10, 0xff19} #if TCL_UTF_MAX > 4 ,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f}, - {0x111d0, 0x111d9}, {0x116c0, 0x116c9}, {0x1d7ce, 0x1d7ff} + {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x114d0, 0x114d9}, {0x11650, 0x11659}, + {0x116c0, 0x116c9}, {0x118e0, 0x118e9}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, + {0x1d7ce, 0x1d7ff} #endif }; @@ -317,15 +333,17 @@ static const crange punctRangeTable[] = { {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, - {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, + {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e42}, {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65} #if TCL_UTF_MAX > 4 - ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10b39, 0x10b3f}, {0x11047, 0x1104d}, - {0x110be, 0x110c1}, {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x12470, 0x12473} + ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f}, + {0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143}, + {0x111c5, 0x111c8}, {0x11238, 0x1123d}, {0x115c1, 0x115c9}, {0x11641, 0x11643}, + {0x12470, 0x12474}, {0x16b37, 0x16b3b} #endif }; @@ -345,7 +363,8 @@ static const chr punctCharTable[] = { 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d #if TCL_UTF_MAX > 4 - ,0x1039f, 0x103d0, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc + ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc, + 0x11174, 0x11175, 0x111cd, 0x114c6, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f #endif }; @@ -383,15 +402,16 @@ static const crange lowerRangeTable[] = { {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731}, - {0xa771, 0xa778}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a} + {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xfb00, 0xfb06}, + {0xfb13, 0xfb17}, {0xff41, 0xff5a} #if TCL_UTF_MAX > 4 - ,{0x10428, 0x1044f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, - {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, - {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, - {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, - {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, - {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, - {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9} + ,{0x10428, 0x1044f}, {0x118c0, 0x118df}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, + {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, + {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, + {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, + {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, + {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, + {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9} #endif }; @@ -427,39 +447,41 @@ static const chr lowerCharTable[] = { 0x4f1, 0x4f3, 0x4f5, 0x4f7, 0x4f9, 0x4fb, 0x4fd, 0x4ff, 0x501, 0x503, 0x505, 0x507, 0x509, 0x50b, 0x50d, 0x50f, 0x511, 0x513, 0x515, 0x517, 0x519, 0x51b, 0x51d, 0x51f, 0x521, 0x523, 0x525, - 0x527, 0x1e01, 0x1e03, 0x1e05, 0x1e07, 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f, - 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21, - 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, 0x1e2d, 0x1e2f, 0x1e31, 0x1e33, - 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, 0x1e3f, 0x1e41, 0x1e43, 0x1e45, - 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, 0x1e51, 0x1e53, 0x1e55, 0x1e57, - 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, 0x1e63, 0x1e65, 0x1e67, 0x1e69, - 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, 0x1e75, 0x1e77, 0x1e79, 0x1e7b, - 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, 0x1e87, 0x1e89, 0x1e8b, 0x1e8d, - 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1, 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9, - 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb, - 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd, - 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, 0x1ed9, 0x1edb, 0x1edd, 0x1edf, - 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, 0x1eeb, 0x1eed, 0x1eef, 0x1ef1, - 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb, 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe, - 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x210a, 0x210e, 0x210f, - 0x2113, 0x212f, 0x2134, 0x2139, 0x213c, 0x213d, 0x214e, 0x2184, 0x2c61, - 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c, 0x2c71, 0x2c73, 0x2c74, 0x2c81, - 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b, 0x2c8d, 0x2c8f, 0x2c91, 0x2c93, - 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d, 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5, - 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf, 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7, - 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1, 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9, - 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3, 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb, - 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4, 0x2cec, 0x2cee, 0x2cf3, 0x2d27, - 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647, 0xa649, 0xa64b, 0xa64d, 0xa64f, - 0xa651, 0xa653, 0xa655, 0xa657, 0xa659, 0xa65b, 0xa65d, 0xa65f, 0xa661, - 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b, 0xa66d, 0xa681, 0xa683, 0xa685, - 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f, 0xa691, 0xa693, 0xa695, 0xa697, - 0xa723, 0xa725, 0xa727, 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, - 0xa739, 0xa73b, 0xa73d, 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, - 0xa74b, 0xa74d, 0xa74f, 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, - 0xa75d, 0xa75f, 0xa761, 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, - 0xa76f, 0xa77a, 0xa77c, 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, - 0xa78e, 0xa791, 0xa793, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, 0xa7fa + 0x527, 0x529, 0x52b, 0x52d, 0x52f, 0x1e01, 0x1e03, 0x1e05, 0x1e07, + 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f, 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, + 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21, 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, + 0x1e2d, 0x1e2f, 0x1e31, 0x1e33, 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, + 0x1e3f, 0x1e41, 0x1e43, 0x1e45, 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, + 0x1e51, 0x1e53, 0x1e55, 0x1e57, 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, + 0x1e63, 0x1e65, 0x1e67, 0x1e69, 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, + 0x1e75, 0x1e77, 0x1e79, 0x1e7b, 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, + 0x1e87, 0x1e89, 0x1e8b, 0x1e8d, 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1, + 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9, 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, + 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb, 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, + 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd, 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, + 0x1ed9, 0x1edb, 0x1edd, 0x1edf, 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, + 0x1eeb, 0x1eed, 0x1eef, 0x1ef1, 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb, + 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe, 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, + 0x1ff7, 0x210a, 0x210e, 0x210f, 0x2113, 0x212f, 0x2134, 0x2139, 0x213c, + 0x213d, 0x214e, 0x2184, 0x2c61, 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c, + 0x2c71, 0x2c73, 0x2c74, 0x2c81, 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b, + 0x2c8d, 0x2c8f, 0x2c91, 0x2c93, 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d, + 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5, 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf, + 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7, 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1, + 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9, 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3, + 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb, 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4, + 0x2cec, 0x2cee, 0x2cf3, 0x2d27, 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647, + 0xa649, 0xa64b, 0xa64d, 0xa64f, 0xa651, 0xa653, 0xa655, 0xa657, 0xa659, + 0xa65b, 0xa65d, 0xa65f, 0xa661, 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b, + 0xa66d, 0xa681, 0xa683, 0xa685, 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f, + 0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727, + 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d, + 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f, + 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761, + 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c, + 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797, + 0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, + 0xa7fa, 0xab64, 0xab65 #if TCL_UTF_MAX > 4 ,0x1d4bb, 0x1d7cb #endif @@ -481,14 +503,15 @@ static const crange upperRangeTable[] = { {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, - {0xff21, 0xff3a} + {0xa7aa, 0xa7ad}, {0xff21, 0xff3a} #if TCL_UTF_MAX > 4 - ,{0x10400, 0x10427}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, - {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, - {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, - {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, - {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, - {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8} + ,{0x10400, 0x10427}, {0x118a0, 0x118bf}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, + {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, + {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, + {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, + {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, + {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, + {0x1d790, 0x1d7a8} #endif }; @@ -511,52 +534,54 @@ static const chr upperCharTable[] = { 0x20c, 0x20e, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21a, 0x21c, 0x21e, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22a, 0x22c, 0x22e, 0x230, 0x232, 0x23a, 0x23b, 0x23d, 0x23e, 0x241, 0x248, 0x24a, - 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x386, 0x38c, 0x38e, 0x38f, - 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4, 0x3e6, - 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa, 0x460, - 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470, 0x472, - 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a, 0x48c, - 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c, 0x49e, - 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae, 0x4b0, - 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0, 0x4c1, - 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2, 0x4d4, - 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4, 0x4e6, - 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6, 0x4f8, - 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508, 0x50a, - 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a, 0x51c, - 0x51e, 0x520, 0x522, 0x524, 0x526, 0x10c7, 0x10cd, 0x1e00, 0x1e02, - 0x1e04, 0x1e06, 0x1e08, 0x1e0a, 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14, - 0x1e16, 0x1e18, 0x1e1a, 0x1e1c, 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26, - 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e, 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38, - 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40, 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a, - 0x1e4c, 0x1e4e, 0x1e50, 0x1e52, 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c, - 0x1e5e, 0x1e60, 0x1e62, 0x1e64, 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e, - 0x1e70, 0x1e72, 0x1e74, 0x1e76, 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80, - 0x1e82, 0x1e84, 0x1e86, 0x1e88, 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92, - 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2, 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac, - 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4, 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe, - 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6, 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0, - 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8, 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2, - 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea, 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4, - 0x1ef6, 0x1ef8, 0x1efa, 0x1efc, 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f, - 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x213e, 0x213f, 0x2145, - 0x2183, 0x2c60, 0x2c67, 0x2c69, 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84, - 0x2c86, 0x2c88, 0x2c8a, 0x2c8c, 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96, - 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e, 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8, - 0x2caa, 0x2cac, 0x2cae, 0x2cb0, 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba, - 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2, 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc, - 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4, 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde, - 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced, 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646, - 0xa648, 0xa64a, 0xa64c, 0xa64e, 0xa650, 0xa652, 0xa654, 0xa656, 0xa658, - 0xa65a, 0xa65c, 0xa65e, 0xa660, 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a, - 0xa66c, 0xa680, 0xa682, 0xa684, 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e, - 0xa690, 0xa692, 0xa694, 0xa696, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, - 0xa72c, 0xa72e, 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, - 0xa740, 0xa742, 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, - 0xa752, 0xa754, 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, - 0xa764, 0xa766, 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, - 0xa77e, 0xa780, 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, - 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7aa + 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x37f, 0x386, 0x38c, 0x38e, + 0x38f, 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4, + 0x3e6, 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa, + 0x460, 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470, + 0x472, 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a, + 0x48c, 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c, + 0x49e, 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae, + 0x4b0, 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0, + 0x4c1, 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2, + 0x4d4, 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4, + 0x4e6, 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6, + 0x4f8, 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508, + 0x50a, 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a, + 0x51c, 0x51e, 0x520, 0x522, 0x524, 0x526, 0x528, 0x52a, 0x52c, + 0x52e, 0x10c7, 0x10cd, 0x1e00, 0x1e02, 0x1e04, 0x1e06, 0x1e08, 0x1e0a, + 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14, 0x1e16, 0x1e18, 0x1e1a, 0x1e1c, + 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26, 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e, + 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38, 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40, + 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a, 0x1e4c, 0x1e4e, 0x1e50, 0x1e52, + 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c, 0x1e5e, 0x1e60, 0x1e62, 0x1e64, + 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e, 0x1e70, 0x1e72, 0x1e74, 0x1e76, + 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80, 0x1e82, 0x1e84, 0x1e86, 0x1e88, + 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92, 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2, + 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac, 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4, + 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe, 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6, + 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0, 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8, + 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2, 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea, + 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4, 0x1ef6, 0x1ef8, 0x1efa, 0x1efc, + 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f, 0x2102, 0x2107, 0x2115, 0x2124, + 0x2126, 0x2128, 0x213e, 0x213f, 0x2145, 0x2183, 0x2c60, 0x2c67, 0x2c69, + 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84, 0x2c86, 0x2c88, 0x2c8a, 0x2c8c, + 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96, 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e, + 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8, 0x2caa, 0x2cac, 0x2cae, 0x2cb0, + 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba, 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2, + 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc, 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4, + 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde, 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced, + 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646, 0xa648, 0xa64a, 0xa64c, 0xa64e, + 0xa650, 0xa652, 0xa654, 0xa656, 0xa658, 0xa65a, 0xa65c, 0xa65e, 0xa660, + 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a, 0xa66c, 0xa680, 0xa682, 0xa684, + 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e, 0xa690, 0xa692, 0xa694, 0xa696, + 0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e, + 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742, + 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754, + 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766, + 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780, + 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798, + 0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b0, + 0xa7b1 #if TCL_UTF_MAX > 4 ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538, 0x1d539, 0x1d546, 0x1d7ca @@ -570,34 +595,34 @@ static const chr upperCharTable[] = { */ static const crange graphRangeTable[] = { - {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37e}, - {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x527}, {0x531, 0x556}, - {0x559, 0x55f}, {0x561, 0x587}, {0x591, 0x5c7}, {0x5d0, 0x5ea}, - {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d}, - {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x800, 0x82d}, - {0x830, 0x83e}, {0x840, 0x85b}, {0x8a2, 0x8ac}, {0x8e4, 0x8fe}, - {0x900, 0x977}, {0x979, 0x97f}, {0x981, 0x983}, {0x985, 0x98c}, - {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, - {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03}, - {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42}, - {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83}, - {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0}, - {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd}, - {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c}, - {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44}, - {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a}, - {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, - {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa}, - {0xc01, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, - {0xc2a, 0xc33}, {0xc35, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, - {0xc4a, 0xc4d}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc7f}, - {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, - {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, - {0xce0, 0xce3}, {0xce6, 0xcef}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, - {0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e}, - {0xd60, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96}, - {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, - {0xdd8, 0xddf}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, + {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f}, + {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556}, + {0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7}, + {0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, + {0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, + {0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b2}, + {0x8e4, 0x983}, {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, + {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, + {0x9e6, 0x9fb}, {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, + {0xa2a, 0xa30}, {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, + {0xa66, 0xa75}, {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, + {0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, + {0xac7, 0xac9}, {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, + {0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, + {0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, + {0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, + {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, + {0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c}, + {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44}, + {0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc60, 0xc63}, {0xc66, 0xc6f}, + {0xc78, 0xc7f}, {0xc81, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, + {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, + {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef}, + {0xd01, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a}, + {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e}, {0xd60, 0xd63}, + {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, + {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, + {0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, @@ -606,105 +631,123 @@ static const crange graphRangeTable[] = { {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, - {0x13a0, 0x13f4}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f0}, + {0x13a0, 0x13f4}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877}, - {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1920, 0x192b}, + {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, - {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, - {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, - {0x1d00, 0x1de6}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, - {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, - {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, - {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, - {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20ba}, {0x20d0, 0x20f0}, - {0x2100, 0x2189}, {0x2190, 0x23f3}, {0x2400, 0x2426}, {0x2440, 0x244a}, - {0x2460, 0x26ff}, {0x2701, 0x2b4c}, {0x2b50, 0x2b59}, {0x2c00, 0x2c2e}, - {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, - {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, - {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, - {0x2dd8, 0x2dde}, {0x2de0, 0x2e3b}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, - {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096}, - {0x3099, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba}, - {0x31c0, 0x31e3}, {0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5}, - {0x4dc0, 0x9fcc}, {0xa000, 0xa48c}, {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, - {0xa640, 0xa697}, {0xa69f, 0xa6f7}, {0xa700, 0xa78e}, {0xa790, 0xa793}, - {0xa7a0, 0xa7aa}, {0xa7f8, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, - {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fb}, {0xa900, 0xa953}, - {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xaa00, 0xaa36}, - {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaa7b}, {0xaa80, 0xaac2}, - {0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, - {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xabc0, 0xabed}, {0xabf0, 0xabf9}, - {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, - {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, - {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, - {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe26}, - {0xfe30, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, - {0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, - {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee} + {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, + {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, + {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, + {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, + {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, + {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, + {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bd}, + {0x20d0, 0x20f0}, {0x2100, 0x2189}, {0x2190, 0x23fa}, {0x2400, 0x2426}, + {0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, + {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, + {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, + {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, + {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, + {0x2de0, 0x2e42}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, + {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, + {0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, + {0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fcc}, + {0xa000, 0xa48c}, {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa69d}, + {0xa69f, 0xa6f7}, {0xa700, 0xa78e}, {0xa790, 0xa7ad}, {0xa7f7, 0xa82b}, + {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, + {0xa8e0, 0xa8fb}, {0xa900, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, + {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, + {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06}, + {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, + {0xab30, 0xab5f}, {0xabc0, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, + {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, + {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, + {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, + {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, + {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, + {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, + {0xfe20, 0xfe2d}, {0xfe30, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, + {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, + {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, + {0xffe8, 0xffee} #if TCL_UTF_MAX > 4 ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d}, {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133}, - {0x10137, 0x1018a}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c}, - {0x102a0, 0x102d0}, {0x10300, 0x1031e}, {0x10320, 0x10323}, {0x10330, 0x1034a}, - {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, {0x10400, 0x1049d}, - {0x104a0, 0x104a9}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855}, - {0x10857, 0x1085f}, {0x10900, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7}, - {0x10a00, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, - {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a7f}, - {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b7f}, - {0x10c00, 0x10c48}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f}, - {0x11080, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, - {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11180, 0x111c8}, {0x111d0, 0x111d9}, - {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x12000, 0x1236e}, {0x12400, 0x12462}, - {0x12470, 0x12473}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44}, - {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, - {0x1d129, 0x1d172}, {0x1d17b, 0x1d1dd}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, - {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, - {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, - {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, - {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, - {0x1d7ce, 0x1d7ff}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, - {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, - {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, - {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, - {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0be}, {0x1f0c1, 0x1f0cf}, - {0x1f0d1, 0x1f0df}, {0x1f100, 0x1f10a}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, - {0x1f170, 0x1f19a}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, - {0x1f300, 0x1f320}, {0x1f330, 0x1f335}, {0x1f337, 0x1f37c}, {0x1f380, 0x1f393}, - {0x1f3a0, 0x1f3c4}, {0x1f3c6, 0x1f3ca}, {0x1f3e0, 0x1f3f0}, {0x1f400, 0x1f43e}, - {0x1f442, 0x1f4f7}, {0x1f4f9, 0x1f4fc}, {0x1f500, 0x1f53d}, {0x1f540, 0x1f543}, - {0x1f550, 0x1f567}, {0x1f5fb, 0x1f640}, {0x1f645, 0x1f64f}, {0x1f680, 0x1f6c5}, - {0x1f700, 0x1f773}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, - {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef} + {0x10137, 0x1018c}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c}, + {0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a}, + {0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, + {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x10500, 0x10527}, {0x10530, 0x10563}, + {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805}, + {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10857, 0x1089e}, {0x108a7, 0x108af}, + {0x10900, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x10a00, 0x10a03}, + {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a}, + {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, + {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, + {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, + {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, + {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, + {0x11136, 0x11143}, {0x11150, 0x11176}, {0x11180, 0x111c8}, {0x111d0, 0x111da}, + {0x111e1, 0x111f4}, {0x11200, 0x11211}, {0x11213, 0x1123d}, {0x112b0, 0x112ea}, + {0x112f0, 0x112f9}, {0x11301, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, + {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, + {0x1135d, 0x11363}, {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11480, 0x114c7}, + {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115c9}, {0x11600, 0x11644}, + {0x11650, 0x11659}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x118a0, 0x118f2}, + {0x11ac0, 0x11af8}, {0x12000, 0x12398}, {0x12400, 0x1246e}, {0x12470, 0x12474}, + {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, + {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, + {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, + {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, + {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, + {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1dd}, {0x1d200, 0x1d245}, + {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, + {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, + {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, + {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, + {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1d7ff}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, + {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, + {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, + {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, + {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093}, + {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5}, + {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f19a}, + {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, {0x1f300, 0x1f32c}, + {0x1f330, 0x1f37d}, {0x1f380, 0x1f3ce}, {0x1f3d4, 0x1f3f7}, {0x1f400, 0x1f4fe}, + {0x1f500, 0x1f54a}, {0x1f550, 0x1f579}, {0x1f57b, 0x1f5a3}, {0x1f5a5, 0x1f642}, + {0x1f645, 0x1f6cf}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f3}, {0x1f700, 0x1f773}, + {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, + {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, + {0x2b740, 0x2b81d}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef} #endif }; #define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange)) static const chr graphCharTable[] = { - 0x38c, 0x589, 0x58a, 0x58f, 0x85e, 0x8a0, 0x98f, 0x990, 0x9b2, - 0x9c7, 0x9c8, 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, - 0xa35, 0xa36, 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, - 0xab2, 0xab3, 0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, - 0xb56, 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, - 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xc58, - 0xc59, 0xc82, 0xc83, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2, 0xd02, - 0xd03, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, - 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, - 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, - 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa9de, - 0xa9df, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd + 0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, + 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, + 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, + 0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, + 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, + 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xc58, 0xc59, 0xcd5, + 0xcd6, 0xcde, 0xcf1, 0xcf2, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, + 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, + 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, + 0x1773, 0x1940, 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, + 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa7b0, 0xa7b1, 0xab64, 0xab65, 0xfb3e, + 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd #if TCL_UTF_MAX > 4 - ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f, 0x109be, 0x109bf, - 0x10a05, 0x10a06, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, - 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, - 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, - 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, - 0x1f251, 0x1f440 + ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f, + 0x109be, 0x109bf, 0x10a05, 0x10a06, 0x111cd, 0x1130f, 0x11310, 0x11332, 0x11333, + 0x11347, 0x11348, 0x11357, 0x118ff, 0x16a6e, 0x16a6f, 0x1b000, 0x1b001, 0x1d49e, + 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, + 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, + 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, + 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251 #endif }; diff --git a/generic/tclUniData.c b/generic/tclUniData.c index a0d4ccc..78e7d17 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -30,35 +30,35 @@ static const unsigned short pageMap[] = { 1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344, 1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728, 1760, 1792, 1792, 1824, 1792, 1856, 1888, 1920, 1952, 1984, 2016, 2048, - 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2016, 2400, - 2432, 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, - 2816, 2848, 2752, 2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, - 3168, 1792, 3200, 3232, 3264, 1792, 3296, 3328, 3360, 3392, 3424, 3456, - 3488, 1792, 1344, 3520, 3552, 3584, 3616, 3648, 3680, 3712, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3744, 1344, 3776, 3808, - 3840, 1344, 3872, 1344, 3904, 3936, 3968, 1344, 1344, 4000, 4032, 1344, + 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, + 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, + 2848, 2880, 2784, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, + 3200, 1792, 3232, 3264, 3296, 1792, 3328, 3360, 3392, 3424, 3456, 3488, + 3520, 1792, 1344, 3552, 3584, 3616, 3648, 3680, 3712, 3744, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3776, 1344, 3808, 3840, + 3872, 1344, 3904, 1344, 3936, 3968, 4000, 1344, 1344, 4032, 4064, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 4064, 4096, 1344, 1344, 4128, 4160, 4192, - 4224, 4256, 1344, 4288, 4320, 4352, 4384, 1344, 4416, 4448, 1344, 4480, - 1344, 4512, 4544, 4576, 4608, 4640, 1344, 4672, 4704, 4736, 4768, 1344, - 4800, 4832, 4864, 4896, 1792, 1792, 4928, 4960, 4992, 5024, 5056, 5088, - 1344, 5120, 1344, 5152, 5184, 5216, 1792, 1792, 5248, 5280, 5312, 5344, - 5376, 5408, 5440, 5376, 704, 5472, 224, 224, 224, 224, 5504, 224, 224, - 224, 5536, 5568, 5600, 5632, 5664, 5696, 5728, 5760, 5792, 5824, 5856, - 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240, - 6272, 6304, 6304, 6304, 6304, 6304, 6304, 6304, 6304, 6336, 6368, 4736, - 6400, 6432, 6464, 6496, 6528, 4736, 6560, 6592, 6624, 6656, 6688, 6720, - 6752, 4736, 4736, 4736, 4736, 4736, 6784, 6816, 6848, 4736, 4736, 4736, - 6880, 4736, 4736, 4736, 4736, 6912, 4736, 4736, 6944, 6976, 4736, 7008, - 7040, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 6304, 6304, 6304, - 6304, 7072, 6304, 7104, 7136, 6304, 6304, 6304, 6304, 6304, 6304, 6304, - 6304, 4736, 7168, 7200, 1792, 1792, 1792, 1792, 1792, 7232, 7264, 7296, - 7328, 224, 224, 224, 7360, 7392, 7424, 1344, 7456, 7488, 7520, 7520, - 704, 7552, 7584, 1792, 1792, 7616, 4736, 4736, 7648, 4736, 4736, 4736, - 4736, 4736, 4736, 7680, 7712, 7744, 7776, 3104, 1344, 7808, 4032, 1344, - 7840, 7872, 7904, 1344, 1344, 7936, 7968, 4736, 8000, 8032, 8064, 8096, - 4736, 8064, 8128, 4736, 8032, 4736, 4736, 4736, 4736, 4736, 4736, 4736, - 4736, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 4096, 4128, 1344, 1344, 4160, 4192, 4224, + 4256, 4288, 1344, 4320, 4352, 4384, 4416, 1344, 4448, 4480, 1344, 4512, + 1344, 4544, 4576, 4608, 4640, 4672, 1344, 4704, 4736, 4768, 4800, 1344, + 4832, 4864, 4896, 4928, 1792, 1792, 4960, 4992, 5024, 5056, 5088, 5120, + 1344, 5152, 1344, 5184, 5216, 5248, 1792, 1792, 5280, 5312, 5344, 5376, + 5408, 5440, 5472, 5408, 704, 5504, 224, 224, 224, 224, 5536, 224, 224, + 224, 5568, 5600, 5632, 5664, 5696, 5728, 5760, 5792, 5824, 5856, 5888, + 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240, 6272, + 6304, 6336, 6336, 6336, 6336, 6336, 6336, 6336, 6336, 6368, 6400, 4768, + 6432, 6464, 6496, 6528, 6560, 4768, 6592, 6624, 6656, 6688, 6720, 6752, + 6784, 4768, 4768, 4768, 4768, 4768, 6816, 6848, 6880, 4768, 4768, 4768, + 6912, 4768, 4768, 4768, 4768, 4768, 4768, 4768, 6944, 6976, 4768, 7008, + 7040, 4768, 4768, 4768, 4768, 4768, 4768, 4768, 4768, 6336, 6336, 6336, + 6336, 7072, 6336, 7104, 7136, 6336, 6336, 6336, 6336, 6336, 6336, 6336, + 6336, 4768, 7168, 7200, 7232, 7264, 7296, 7328, 1792, 7360, 7392, 7424, + 7456, 224, 224, 224, 7488, 7520, 7552, 1344, 7584, 7616, 7648, 7648, + 704, 7680, 7712, 7744, 1792, 7776, 4768, 4768, 7808, 4768, 4768, 4768, + 4768, 4768, 4768, 7840, 7872, 7904, 7936, 3136, 1344, 7968, 4064, 1344, + 8000, 8032, 8064, 1344, 1344, 8096, 8128, 4768, 8160, 8192, 8224, 8256, + 4768, 8224, 8288, 4768, 8192, 4768, 4768, 4768, 4768, 4768, 4768, 4768, + 4768, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -75,7 +75,7 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 4512, 4736, 4736, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 4544, 4768, 4768, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -129,16 +129,16 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8160, - 1792, 8192, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8320, + 1792, 8352, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 8224, 4736, 8256, 5216, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 8288, 8320, 224, 8352, 8384, 1344, 1344, 8416, 8448, 8480, 224, - 8512, 8544, 8576, 1792, 8608, 8640, 8672, 1344, 8704, 8736, 8768, 8800, - 8832, 1632, 8864, 8896, 4544, 1888, 8928, 8960, 1792, 1344, 8992, 9024, - 9056, 1344, 9088, 9120, 9152, 9184, 9216, 1792, 1792, 1792, 1792, 1344, - 9248, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 8384, 4768, 8416, 5248, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 8448, 8480, 224, 8512, 8544, 1344, 1344, 8576, 8608, 8640, 224, + 8672, 8704, 8736, 1792, 8768, 8800, 8832, 1344, 8864, 8896, 8928, 8960, + 8992, 1632, 9024, 9056, 9088, 1888, 9120, 9152, 9184, 1344, 9216, 9248, + 9280, 1344, 9312, 9344, 9376, 9408, 9440, 9472, 9504, 1792, 1792, 1344, + 9536, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -167,72 +167,72 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 9280, 9312, 9344, 9376, 9376, 9376, 9376, 9376, 9376, 9376, - 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, - 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, - 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, - 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, - 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, - 9408, 9408, 9408, 9408, 9408, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 9440, 1344, 1344, 9472, 1792, 9504, 9536, 9568, - 1344, 1344, 9600, 9632, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 9664, 9696, 1344, 9728, 1344, 9760, 9792, 9824, 9856, 9888, - 9920, 1344, 1344, 1344, 9952, 9984, 64, 10016, 10048, 10080, 10112, - 10144, 10176 + 1344, 1344, 9568, 9600, 9632, 9664, 9664, 9664, 9664, 9664, 9664, 9664, + 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, + 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, + 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, + 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, + 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9664, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, 9696, + 9696, 9696, 9696, 9696, 9696, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 9728, 1344, 1344, 9760, 1792, 9792, 9824, 9856, + 1344, 1344, 9888, 9920, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 9952, 9984, 1344, 10016, 1344, 10048, 10080, 10112, 10144, + 10176, 10208, 1344, 1344, 1344, 10240, 10272, 64, 10304, 10336, 10368, + 4576, 10400, 10432 #if TCL_UTF_MAX > 3 - ,10208, 10240, 10272, 1792, 1344, 1344, 1344, 7968, 10304, 10336, 10368, - 10400, 10432, 1792, 10464, 10496, 1792, 1792, 1792, 1792, 4544, 1344, - 10528, 1792, 10112, 10560, 10592, 1792, 10624, 1344, 10656, 1792, 10688, - 10720, 10752, 1344, 10784, 10816, 1792, 1792, 1792, 1792, 1792, 1792, + ,10464, 10496, 10528, 1792, 1344, 1344, 1344, 8128, 10560, 10592, 10624, + 10656, 10688, 10720, 10752, 10784, 1792, 1792, 1792, 1792, 9088, 1344, + 10816, 10848, 1344, 10880, 10912, 10944, 10976, 1344, 11008, 1792, + 11040, 11072, 11104, 1344, 11136, 11168, 1792, 1792, 1344, 11200, 1344, + 11232, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 7616, 4544, 10048, 1792, 1792, 1792, 1792, 11264, + 11296, 11328, 11360, 4576, 11392, 1792, 1792, 11424, 11456, 1792, 1792, + 1344, 11488, 1792, 1792, 11520, 11552, 11584, 11616, 11648, 1792, 11680, + 11712, 1344, 11744, 11776, 11808, 11840, 11872, 1792, 1792, 1344, 1344, + 11904, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 11936, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 11968, 12000, 12032, + 12064, 5088, 12096, 12128, 12160, 12192, 12224, 12256, 12288, 5088, + 12320, 12352, 12384, 12416, 12448, 1792, 1792, 1792, 9984, 12480, 12512, + 2400, 2304, 12544, 12576, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1344, 12608, 12640, 1792, 1792, 1792, 1792, 1792, 1344, 12672, + 12704, 1792, 1344, 12736, 12768, 1792, 1344, 12800, 11168, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 12832, 12864, 12896, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1344, 12928, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 10848, 10880, 10912, - 1792, 1792, 1792, 1792, 1792, 10944, 10976, 1792, 1792, 1344, 11008, - 1792, 1792, 11040, 11072, 11104, 11136, 1792, 1792, 1792, 1792, 1344, - 11168, 11200, 11232, 1792, 1792, 1792, 1792, 1344, 1344, 11264, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 11296, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 11328, 11360, 11392, 11424, 5056, 11456, - 11488, 11520, 11552, 11584, 11616, 1792, 5056, 11648, 11680, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1344, 11712, 10816, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11744, 1792, 1792, - 1792, 1792, 10368, 10368, 10368, 11776, 1792, 1792, 1792, 1792, 1792, + 1344, 1344, 1344, 1344, 1344, 12928, 1792, 1792, 1792, 10624, 10624, + 10624, 12960, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 11744, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 12992, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -266,13 +266,13 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 11808, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 12928, 4576, + 13024, 1792, 1792, 9984, 13056, 1344, 13088, 13120, 13152, 13184, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1344, 1344, 11840, 11872, 11904, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1344, 1344, 13216, 13248, 13280, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -314,8 +314,8 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 11936, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 13312, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -323,6 +323,8 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 13344, + 13376, 13408, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -335,14 +337,14 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 4768, 4768, 4768, 4768, 4768, 4768, 4768, 7840, 4768, 13440, + 4768, 13472, 13504, 13536, 13568, 1792, 4768, 4768, 13600, 1792, 1792, + 1792, 1792, 1792, 4768, 4768, 13632, 13664, 1792, 1792, 1792, 1792, + 13696, 13728, 13760, 13792, 13824, 13856, 13888, 13920, 13952, 13984, + 14016, 14048, 14080, 13696, 13728, 14112, 13792, 14144, 14176, 14208, + 13920, 14240, 14272, 14304, 14336, 14368, 14400, 14432, 14464, 14496, + 14528, 14560, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 7680, 4736, - 11968, 4736, 12000, 12032, 12064, 12096, 1792, 4736, 4736, 12128, 1792, - 1792, 1792, 1792, 1792, 4736, 4736, 12160, 12192, 1792, 1792, 1792, - 1792, 12224, 12256, 12288, 12320, 12352, 12384, 12416, 12448, 12480, - 12512, 12544, 12576, 12608, 12224, 12256, 12640, 12320, 12672, 12704, - 12736, 12448, 12768, 12800, 12832, 12864, 12896, 12928, 12960, 12992, - 13024, 13056, 13088, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -351,26 +353,24 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, + 1344, 1344, 1344, 1344, 1344, 14592, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 14624, 14656, 14688, 14720, 14752, 14784, 1792, 14816, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 4768, 14848, 4768, 4768, 7808, + 14880, 14912, 7840, 14944, 14976, 4768, 14848, 15008, 1792, 1792, 15040, + 15072, 15008, 15104, 1792, 1792, 1792, 1792, 1792, 4768, 15136, 4768, + 13568, 4768, 4768, 15168, 15200, 4768, 4768, 4768, 4768, 4768, 4768, + 4768, 8192, 4768, 4768, 15232, 7776, 4768, 15264, 4768, 4768, 4768, + 4768, 15296, 4768, 4768, 4768, 15328, 15360, 4768, 4768, 4768, 7808, + 4768, 4768, 15392, 1792, 14848, 4768, 15424, 4768, 15456, 15488, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 13120, 13152, 13184, 13216, 13248, 13280, 1792, 13312, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 4736, 13344, 4736, 4736, 7648, - 13376, 13408, 1792, 13440, 13472, 4736, 13344, 13504, 1792, 1792, 13536, - 13568, 13504, 13600, 1792, 1792, 1792, 1792, 1792, 4736, 13632, 4736, - 13664, 7648, 4736, 13696, 13728, 4736, 8032, 13760, 4736, 4736, 4736, - 4736, 13792, 4736, 12096, 13824, 13856, 1792, 1792, 1792, 13888, 4736, - 4736, 13920, 1792, 4736, 4736, 13952, 1792, 4736, 4736, 4736, 7648, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -480,8 +480,9 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 7488, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 7616, + 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -491,8 +492,8 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4000, 1344, 1344, - 1344, 1344, 1344, 1344, 10784, 1792, 1792, 1792, 1792, 1792, 1792, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4032, 1344, + 1344, 1344, 1344, 1344, 1344, 11136, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -535,8 +536,8 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 10784 + 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 11136 #endif /* TCL_UTF_MAX > 3 */ }; @@ -577,324 +578,327 @@ static const unsigned char groupMap[] = { 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 21, 55, 23, 24, 56, 57, 58, 58, 23, 24, 59, 60, 61, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 62, 63, 64, 65, - 66, 21, 67, 67, 21, 68, 21, 69, 21, 21, 21, 21, 67, 21, 21, 70, 21, - 71, 72, 21, 73, 74, 21, 75, 21, 21, 21, 74, 21, 76, 77, 21, 21, 78, - 21, 21, 21, 21, 21, 21, 21, 79, 21, 21, 80, 21, 21, 80, 21, 21, 21, - 21, 80, 81, 82, 82, 83, 21, 21, 21, 21, 21, 84, 21, 15, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 11, 11, 11, 11, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 85, 85, 85, 85, 85, 11, 11, 11, 11, 11, 11, 11, 85, - 11, 85, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 87, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 23, 24, 23, - 24, 85, 11, 23, 24, 0, 0, 85, 42, 42, 42, 3, 0, 0, 0, 0, 0, 11, 11, - 88, 3, 89, 89, 89, 0, 90, 0, 91, 91, 21, 10, 10, 10, 10, 10, 10, 10, + 66, 21, 67, 67, 21, 68, 21, 69, 70, 21, 21, 21, 67, 71, 21, 72, 21, + 73, 74, 21, 75, 76, 21, 77, 78, 21, 21, 76, 21, 79, 80, 21, 21, 81, + 21, 21, 21, 21, 21, 21, 21, 82, 21, 21, 83, 21, 21, 83, 21, 21, 21, + 84, 83, 85, 86, 86, 87, 21, 21, 21, 21, 21, 88, 21, 15, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 89, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 90, 90, 90, 90, 11, 11, 11, 11, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 90, 90, 90, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 90, 90, 90, 90, 90, 11, 11, 11, 11, 11, 11, 11, 90, + 11, 90, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 92, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 23, 24, 23, + 24, 90, 11, 23, 24, 0, 0, 90, 42, 42, 42, 3, 93, 0, 0, 0, 0, 11, 11, + 94, 3, 95, 95, 95, 0, 96, 0, 97, 97, 21, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 0, 10, 10, 10, 10, 10, 10, - 10, 10, 10, 92, 93, 93, 93, 21, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 13, 13, 13, 13, 13, 13, 13, 94, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 95, 96, 96, 97, 98, 99, 100, 100, 100, 101, 102, 103, 23, 24, 23, + 10, 10, 10, 98, 99, 99, 99, 21, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 13, 13, 100, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 101, 102, 102, 103, 104, 105, 106, 106, 106, 107, 108, 109, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, - 23, 24, 23, 24, 104, 105, 106, 21, 107, 108, 7, 23, 24, 109, 23, 24, - 21, 54, 54, 54, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, - 110, 110, 110, 110, 110, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 23, 24, 23, 24, 23, 24, 110, 111, 112, 113, 114, 115, 7, 23, 24, 116, + 23, 24, 21, 54, 54, 54, 117, 117, 117, 117, 117, 117, 117, 117, 117, + 117, 117, 117, 117, 117, 117, 117, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, - 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 13, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, - 105, 105, 105, 105, 23, 24, 14, 86, 86, 86, 86, 86, 111, 111, 23, 24, + 13, 13, 13, 13, 13, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 23, 24, 14, 91, 91, 91, 91, 91, 118, + 118, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 119, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 120, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 112, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 113, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 114, - 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, - 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, - 114, 114, 114, 114, 114, 114, 114, 114, 114, 0, 0, 85, 3, 3, 3, 3, - 3, 3, 0, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, - 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, - 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 21, 0, - 3, 8, 0, 0, 0, 0, 4, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 8, 86, 3, 86, 86, 3, 86, 86, 3, 86, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 3, 3, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 0, 7, 7, 7, 3, 3, - 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 17, - 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 86, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 15, 86, 86, 86, - 86, 86, 86, 86, 17, 14, 86, 86, 86, 86, 86, 86, 85, 85, 86, 86, 14, - 86, 86, 86, 86, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 14, - 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 17, 15, 86, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 85, 85, 14, 3, 3, 3, 85, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, - 86, 86, 86, 85, 86, 86, 86, 86, 86, 86, 86, 86, 86, 85, 86, 86, 86, - 85, 86, 86, 86, 86, 86, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 0, 0, 3, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 86, 86, 86, 116, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 86, 116, 86, 15, 116, 116, 116, 86, 86, 86, 86, 86, 86, - 86, 86, 116, 116, 116, 116, 86, 116, 116, 15, 86, 86, 86, 86, 86, 86, - 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 3, 3, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 3, 85, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, - 15, 15, 15, 15, 0, 86, 116, 116, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 86, 15, 116, 116, 116, 86, - 86, 86, 86, 0, 0, 116, 116, 0, 0, 116, 116, 86, 15, 0, 0, 0, 0, 0, - 0, 0, 0, 116, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 86, 86, 0, 0, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, - 0, 0, 0, 0, 0, 86, 86, 116, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, - 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 15, 0, 15, 15, 0, 15, 15, 0, 0, 86, 0, 116, 116, 116, 86, 86, 0, 0, - 0, 0, 86, 86, 0, 0, 86, 86, 86, 0, 0, 0, 86, 0, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 86, 86, 15, 15, 15, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, - 116, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, - 15, 15, 0, 0, 86, 15, 116, 116, 116, 86, 86, 86, 86, 86, 0, 86, 86, - 116, 0, 116, 116, 86, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 15, 15, 86, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, - 15, 0, 0, 86, 15, 116, 86, 116, 86, 86, 86, 86, 0, 0, 116, 116, 0, - 0, 116, 116, 86, 0, 0, 0, 0, 0, 0, 0, 0, 86, 116, 0, 0, 0, 0, 15, 15, - 0, 15, 15, 15, 86, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, - 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 15, 0, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, - 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, - 116, 86, 116, 116, 0, 0, 0, 116, 116, 116, 0, 116, 116, 116, 86, 0, - 0, 15, 0, 0, 0, 0, 0, 0, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14, - 4, 14, 0, 0, 0, 0, 0, 0, 116, 116, 116, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 0, 15, 86, 86, - 86, 116, 116, 116, 116, 0, 86, 86, 86, 0, 86, 86, 86, 86, 0, 0, 0, - 0, 0, 0, 0, 86, 86, 0, 15, 15, 0, 0, 0, 0, 0, 0, 15, 15, 86, 86, 0, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, - 18, 18, 18, 18, 14, 0, 0, 116, 116, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 86, 15, 116, 86, 116, - 116, 116, 116, 116, 0, 86, 116, 116, 0, 116, 116, 86, 86, 0, 0, 0, - 0, 0, 0, 0, 116, 116, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 86, 86, 0, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 116, - 116, 116, 86, 86, 86, 86, 0, 116, 116, 116, 0, 116, 116, 116, 86, 15, - 0, 0, 0, 0, 0, 0, 0, 0, 116, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 86, 86, - 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 0, 0, 0, - 14, 15, 15, 15, 15, 15, 15, 0, 0, 116, 116, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 0, 0, 0, 0, 116, 116, 116, - 86, 86, 86, 0, 86, 0, 116, 116, 116, 116, 116, 116, 116, 116, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 116, 116, 3, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 24, 23, 24, 0, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, + 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, + 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 0, + 0, 90, 3, 3, 3, 3, 3, 3, 0, 122, 122, 122, 122, 122, 122, 122, 122, + 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, + 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, + 122, 122, 21, 0, 3, 8, 0, 0, 14, 14, 4, 0, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 8, 91, 3, 91, 91, 3, 91, 91, 3, 91, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, + 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 90, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 91, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 3, 15, 91, 91, 91, 91, 91, 91, 91, 17, 14, 91, 91, 91, 91, 91, + 91, 90, 90, 91, 91, 14, 91, 91, 91, 91, 15, 15, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 15, 15, 15, 14, 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 0, 17, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 90, 90, 14, 3, 3, 3, 90, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 91, 91, 91, 91, 90, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 90, 91, 91, 91, 90, 91, 91, 91, 91, 91, 0, 0, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, + 91, 91, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 123, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 123, 91, 15, 123, 123, + 123, 91, 91, 91, 91, 91, 91, 91, 91, 123, 123, 123, 123, 91, 123, 123, + 15, 91, 91, 91, 91, 91, 91, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 91, 91, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 90, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 123, 123, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, + 91, 15, 123, 123, 123, 91, 91, 91, 91, 0, 0, 123, 123, 0, 0, 123, 123, + 91, 15, 0, 0, 0, 0, 0, 0, 0, 0, 123, 0, 0, 0, 0, 15, 15, 0, 15, 15, + 15, 91, 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, + 18, 18, 18, 18, 14, 4, 0, 0, 0, 0, 0, 91, 91, 123, 0, 15, 15, 15, 15, + 15, 15, 0, 0, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, + 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 0, 0, 91, 0, 123, + 123, 123, 91, 91, 0, 0, 0, 0, 91, 91, 0, 0, 91, 91, 91, 0, 0, 0, 91, + 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 91, 91, 15, 15, 15, 91, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 91, 91, 123, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 91, 15, 123, 123, 123, 91, + 91, 91, 91, 91, 0, 91, 91, 123, 0, 123, 123, 91, 0, 0, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 91, 91, 0, 0, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 91, 123, 123, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, + 15, 15, 15, 15, 15, 0, 0, 91, 15, 123, 91, 123, 91, 91, 91, 91, 0, + 0, 123, 123, 0, 0, 123, 123, 91, 0, 0, 0, 0, 0, 0, 0, 0, 91, 123, 0, + 0, 0, 0, 15, 15, 0, 15, 15, 15, 91, 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 14, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 91, 15, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, + 15, 15, 0, 0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, + 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 123, 123, 91, 123, 123, 0, 0, 0, 123, 123, 123, 0, 123, + 123, 123, 91, 0, 0, 15, 0, 0, 0, 0, 0, 0, 123, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, + 14, 14, 14, 14, 14, 4, 14, 0, 0, 0, 0, 0, 91, 123, 123, 123, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 15, 91, 91, 91, 123, 123, 123, 123, 0, 91, 91, 91, 0, 91, + 91, 91, 91, 0, 0, 0, 0, 0, 0, 0, 91, 91, 0, 15, 15, 0, 0, 0, 0, 0, + 0, 15, 15, 91, 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 14, 0, 91, 123, 123, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, + 0, 91, 15, 123, 91, 123, 123, 123, 123, 123, 0, 91, 123, 123, 0, 123, + 123, 91, 91, 0, 0, 0, 0, 0, 0, 0, 123, 123, 0, 0, 0, 0, 0, 0, 0, 15, + 0, 15, 15, 91, 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 86, 15, 15, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, - 4, 15, 15, 15, 15, 15, 15, 85, 86, 86, 86, 86, 86, 86, 86, 86, 3, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 0, - 15, 15, 0, 15, 0, 0, 15, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 0, 15, 0, 0, 15, 15, 0, 15, - 15, 15, 15, 86, 15, 15, 86, 86, 86, 86, 86, 86, 0, 86, 86, 15, 0, 0, - 15, 15, 15, 15, 15, 0, 85, 0, 86, 86, 86, 86, 86, 86, 0, 0, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 86, 86, 14, - 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 14, 86, 14, 86, 14, 86, 5, 6, 5, 6, 116, 116, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 3, - 86, 86, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 0, 14, 14, 14, 14, 14, 14, 14, 14, 86, 14, 14, 14, - 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 86, 86, - 86, 86, 116, 86, 86, 86, 86, 86, 86, 116, 86, 86, 116, 116, 86, 86, - 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, - 15, 15, 116, 116, 86, 86, 15, 15, 15, 15, 86, 86, 86, 15, 116, 116, - 116, 15, 15, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15, 86, 86, - 86, 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116, - 116, 86, 86, 116, 116, 116, 116, 116, 116, 86, 15, 116, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 116, 116, 116, 86, 14, 14, 117, 117, 117, 117, 117, - 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, - 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, - 117, 117, 117, 117, 117, 0, 117, 0, 0, 0, 0, 0, 117, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 3, 85, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 0, 15, 123, 123, 123, 91, 91, 91, 91, 0, 123, 123, 123, + 0, 123, 123, 123, 91, 15, 0, 0, 0, 0, 0, 0, 0, 0, 123, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 91, 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, + 18, 18, 18, 18, 18, 0, 0, 0, 14, 15, 15, 15, 15, 15, 15, 0, 0, 123, + 123, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, + 0, 91, 0, 0, 0, 0, 123, 123, 123, 91, 91, 91, 0, 91, 0, 123, 123, 123, + 123, 123, 123, 123, 123, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 0, 0, 123, 123, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 15, 15, 91, 91, + 91, 91, 91, 91, 91, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 90, 91, + 91, 91, 91, 91, 91, 91, 91, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, + 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 0, 15, 15, 0, 15, 0, 0, 15, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, + 15, 0, 15, 0, 15, 0, 0, 15, 15, 0, 15, 15, 15, 15, 91, 15, 15, 91, + 91, 91, 91, 91, 91, 0, 91, 91, 15, 0, 0, 15, 15, 15, 15, 15, 0, 90, + 0, 91, 91, 91, 91, 91, 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, + 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 14, 3, 14, 14, 14, 91, 91, 14, 14, 14, 14, 14, 14, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 91, + 14, 91, 14, 91, 5, 6, 5, 6, 123, 123, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 86, 86, 86, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 15, 15, 15, + 15, 15, 15, 0, 0, 0, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 123, 91, 91, 91, 91, 91, 3, 91, 91, 15, 15, 15, 15, 15, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 91, 14, 14, 14, 14, 14, 14, 0, 14, 14, 3, 3, + 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 123, 123, 91, 91, 91, 91, 123, 91, 91, 91, 91, + 91, 91, 123, 91, 91, 123, 123, 91, 91, 15, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 123, 123, 91, 91, 15, + 15, 15, 15, 91, 91, 91, 15, 123, 123, 123, 15, 15, 123, 123, 123, 123, + 123, 123, 123, 15, 15, 15, 91, 91, 91, 91, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 91, 123, 123, 91, 91, 123, 123, 123, 123, + 123, 123, 91, 15, 123, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 123, 123, 123, + 91, 14, 14, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 0, + 124, 0, 0, 0, 0, 0, 124, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 3, 90, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, + 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, + 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, + 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 91, 91, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 8, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 5, 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, - 3, 118, 118, 118, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, - 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 3, 3, 0, + 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 6, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 125, 125, 125, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 91, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, - 0, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, - 116, 86, 86, 86, 86, 86, 86, 86, 116, 116, 116, 116, 116, 116, 116, - 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, - 3, 85, 3, 3, 3, 4, 15, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, - 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 17, 0, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 91, 91, 91, 3, 3, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 91, 91, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, 123, 91, 91, 91, 91, + 91, 91, 91, 123, 123, 123, 123, 123, 123, 123, 123, 91, 123, 123, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 3, 3, 3, 90, 3, 3, 3, 4, 15, + 91, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8, + 3, 3, 3, 3, 91, 91, 91, 17, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 90, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, - 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 91, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, - 86, 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, - 116, 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 91, 91, 91, 123, 123, 123, 123, 91, 91, 123, 123, + 123, 0, 0, 0, 0, 123, 123, 91, 123, 123, 123, 123, 123, 123, 91, 91, + 91, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, - 15, 15, 15, 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, + 123, 123, 123, 123, 123, 123, 123, 123, 123, 15, 15, 15, 15, 15, 15, + 15, 123, 123, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, + 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, - 116, 86, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, - 86, 86, 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, - 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, - 0, 86, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, - 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, - 86, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 86, 116, 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, - 116, 116, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, - 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, - 116, 116, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, - 116, 116, 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, - 116, 116, 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, - 86, 86, 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 91, 91, 123, 123, 91, 0, 0, 3, 3, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 123, 91, 123, 91, 91, 91, 91, 91, 91, 91, 0, 91, 123, 91, 123, + 123, 91, 91, 91, 91, 91, 91, 91, 91, 123, 123, 123, 123, 123, 123, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 91, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, + 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 90, 3, 3, 3, 3, 3, 3, 0, 0, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 118, 0, 91, 91, 91, 91, + 123, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 123, 91, + 91, 91, 91, 91, 123, 91, 123, 123, 123, 123, 123, 91, 123, 123, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, + 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, + 91, 91, 123, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 123, + 91, 91, 91, 91, 123, 123, 91, 91, 123, 91, 91, 91, 15, 15, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 91, 123, 91, 91, 123, 123, 123, 91, 123, 91, 91, 91, 123, 123, 0, 0, + 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 123, 123, 123, 123, 123, + 123, 123, 123, 91, 91, 91, 91, 91, 91, 91, 91, 123, 123, 91, 91, 0, + 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, + 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 90, 90, 90, 90, 90, 90, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 91, 91, 91, 3, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 123, 91, 91, 91, 91, 91, 91, 91, 15, 15, 15, + 15, 91, 15, 15, 15, 15, 123, 123, 91, 15, 15, 0, 91, 91, 0, 0, 0, 0, + 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 90, 90, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 90, 126, 21, 21, 21, 127, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, - 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, - 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, - 21, 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, - 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, - 124, 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, - 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, - 123, 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, - 123, 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, - 123, 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, - 123, 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, - 126, 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, - 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, - 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, - 131, 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, - 131, 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, - 133, 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, - 136, 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, - 137, 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, - 138, 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, - 140, 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, + 21, 21, 21, 90, 90, 90, 90, 90, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 0, 0, + 0, 91, 91, 91, 91, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 128, 21, + 21, 129, 21, 130, 130, 130, 130, 130, 130, 130, 130, 131, 131, 131, + 131, 131, 131, 131, 131, 130, 130, 130, 130, 130, 130, 0, 0, 131, 131, + 131, 131, 131, 131, 0, 0, 130, 130, 130, 130, 130, 130, 130, 130, 131, + 131, 131, 131, 131, 131, 131, 131, 130, 130, 130, 130, 130, 130, 130, + 130, 131, 131, 131, 131, 131, 131, 131, 131, 130, 130, 130, 130, 130, + 130, 0, 0, 131, 131, 131, 131, 131, 131, 0, 0, 21, 130, 21, 130, 21, + 130, 21, 130, 0, 131, 0, 131, 0, 131, 0, 131, 130, 130, 130, 130, 130, + 130, 130, 130, 131, 131, 131, 131, 131, 131, 131, 131, 132, 132, 133, + 133, 133, 133, 134, 134, 135, 135, 136, 136, 137, 137, 0, 0, 130, 130, + 130, 130, 130, 130, 130, 130, 138, 138, 138, 138, 138, 138, 138, 138, + 130, 130, 130, 130, 130, 130, 130, 130, 138, 138, 138, 138, 138, 138, + 138, 138, 130, 130, 130, 130, 130, 130, 130, 130, 138, 138, 138, 138, + 138, 138, 138, 138, 130, 130, 21, 139, 21, 0, 21, 21, 131, 131, 140, + 140, 141, 11, 142, 11, 11, 11, 21, 139, 21, 0, 21, 21, 143, 143, 143, + 143, 141, 11, 11, 11, 130, 130, 21, 21, 0, 0, 21, 21, 131, 131, 144, + 144, 0, 11, 11, 11, 130, 130, 21, 21, 21, 112, 21, 21, 131, 131, 145, + 145, 116, 11, 11, 11, 0, 0, 21, 139, 21, 0, 21, 21, 146, 146, 147, + 147, 141, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, - 3, 3, 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 148, 149, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, - 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, - 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, - 100, 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, - 100, 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, - 100, 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, - 21, 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, - 147, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, - 148, 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, - 149, 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, + 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 90, 0, 0, + 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 90, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 90, 90, 90, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 118, 118, 118, 118, 91, 118, 118, 118, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 14, 106, 14, 14, 14, 14, 106, 14, 14, 21, 106, 106, + 106, 21, 21, 106, 106, 106, 21, 14, 106, 14, 14, 7, 106, 106, 106, + 106, 106, 14, 14, 14, 14, 14, 14, 106, 14, 150, 14, 106, 14, 151, 152, + 106, 106, 14, 21, 106, 106, 153, 106, 21, 15, 15, 15, 15, 21, 14, 14, + 21, 21, 106, 106, 7, 7, 7, 7, 7, 106, 21, 21, 21, 21, 14, 7, 14, 14, + 154, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 155, 155, 155, 155, 155, 155, 155, 155, 155, 155, 155, 155, 155, + 155, 155, 155, 156, 156, 156, 156, 156, 156, 156, 156, 156, 156, 156, + 156, 156, 156, 156, 156, 125, 125, 125, 23, 24, 125, 125, 125, 125, 18, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, @@ -914,209 +918,222 @@ static const unsigned char groupMap[] = { 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 150, 150, 150, 150, 150, 150, 150, 150, - 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, - 150, 150, 150, 150, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, - 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, - 151, 151, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 157, 157, 157, 157, 157, 157, 157, + 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, + 157, 157, 157, 157, 157, 158, 158, 158, 158, 158, 158, 158, 158, 158, + 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, + 158, 158, 158, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, + 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, + 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, - 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, - 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, + 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 0, 0, 0, 0, 0, 0, 114, 114, 114, 114, 114, 114, 114, 114, - 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, - 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, - 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 0, 115, 115, - 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, - 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, - 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, - 115, 115, 115, 0, 23, 24, 152, 153, 154, 155, 156, 23, 24, 23, 24, - 23, 24, 157, 158, 159, 160, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21, - 21, 85, 85, 161, 161, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23, - 24, 23, 24, 86, 86, 86, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3, - 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, - 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, - 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 0, 162, 0, 0, 0, - 0, 0, 162, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 85, - 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, - 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6, - 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 8, 8, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, + 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 0, 0, 2, 3, 3, 3, 14, 85, 15, 118, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, - 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 118, 118, 118, 118, - 118, 118, 118, 118, 118, 86, 86, 86, 86, 116, 116, 8, 85, 85, 85, 85, - 85, 14, 14, 118, 118, 118, 85, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, + 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, + 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, + 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, + 121, 121, 121, 121, 121, 121, 0, 122, 122, 122, 122, 122, 122, 122, + 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, + 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, + 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 0, 23, + 24, 159, 160, 161, 162, 163, 23, 24, 23, 24, 23, 24, 164, 165, 166, + 167, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21, 21, 90, 90, 168, 168, + 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23, 24, 23, 24, 91, 91, + 91, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3, 169, 169, 169, 169, + 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, + 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, + 169, 169, 169, 169, 169, 169, 0, 169, 0, 0, 0, 0, 0, 169, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 86, 86, 11, 11, 85, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 90, 3, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, + 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6, 5, + 6, 3, 3, 3, 3, 3, 90, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3, 3, + 3, 8, 3, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 90, 15, 125, 5, 6, 5, 6, 5, 6, + 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 125, 125, + 125, 125, 125, 125, 125, 125, 125, 91, 91, 91, 91, 123, 123, 8, 90, + 90, 90, 90, 90, 14, 14, 125, 125, 125, 90, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 3, 85, 85, 85, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 0, 91, 91, 11, 11, 90, 90, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, - 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, + 15, 15, 15, 15, 3, 90, 90, 90, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, - 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 14, 14, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 3, 3, 3, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 15, 86, 111, 111, 111, 3, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 3, 85, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 86, 15, 15, - 15, 15, 15, 15, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 86, - 86, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, + 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 90, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 90, 3, 3, 3, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 15, 91, 118, 118, 118, 3, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 3, 90, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 90, + 90, 0, 91, 15, 15, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, + 125, 125, 125, 91, 91, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 11, 11, 23, 24, 23, 24, 23, 24, - 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, - 23, 24, 23, 24, 23, 24, 85, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24, - 23, 24, 163, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 85, 11, 11, 23, - 24, 164, 21, 0, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 165, 0, 0, 0, 0, 0, 0, 0, 0, + 11, 11, 11, 11, 11, 90, 90, 90, 90, 90, 90, 90, 90, 90, 11, 11, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 90, 21, 21, 21, 21, 21, + 21, 21, 21, 23, 24, 23, 24, 170, 23, 24, 23, 24, 23, 24, 23, 24, 23, + 24, 90, 11, 11, 23, 24, 171, 21, 0, 23, 24, 23, 24, 21, 21, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, + 24, 172, 173, 174, 175, 0, 0, 176, 177, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 85, 21, 15, 15, 15, 15, - 15, 15, 15, 86, 15, 15, 15, 86, 15, 15, 15, 15, 86, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 116, 116, 86, 86, 116, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18, - 18, 18, 18, 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, - 3, 0, 0, 0, 0, 0, 0, 0, 0, 116, 116, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 116, 116, 116, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 86, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 15, 15, 15, 15, 15, 15, 3, 3, 3, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 86, 116, 116, 86, 86, 86, 86, 116, 116, 86, - 116, 116, 116, 116, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 85, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 86, 86, 86, 86, 86, 86, 116, 116, 86, 86, 116, 116, 86, - 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 86, 15, 15, 15, 15, 15, - 15, 15, 15, 86, 116, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3, - 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 85, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 116, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 86, - 86, 86, 15, 15, 86, 86, 15, 15, 15, 15, 15, 86, 86, 15, 86, 15, 0, + 0, 0, 0, 0, 0, 15, 90, 90, 21, 15, 15, 15, 15, 15, 15, 15, 91, 15, + 15, 15, 91, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 123, 123, 91, + 91, 123, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, + 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, + 0, 123, 123, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, + 123, 123, 123, 123, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 15, 15, 15, 15, 15, 15, 3, + 3, 3, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 91, + 91, 91, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 123, 123, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 123, 123, 91, + 91, 91, 91, 123, 123, 91, 123, 123, 123, 123, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 0, 90, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, + 3, 3, 15, 15, 15, 15, 15, 91, 90, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 91, 123, 123, 91, 91, 123, + 123, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 91, 15, 15, 15, + 15, 15, 15, 15, 15, 91, 123, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, + 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 90, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 123, 91, 123, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 91, 15, 91, 91, 91, 15, 15, 91, 91, 15, 15, 15, 15, 15, 91, 91, + 15, 91, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 15, 15, 90, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 123, 91, 91, 123, 123, 3, 3, 15, 90, 90, 123, 91, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 11, 90, 90, 90, 90, 0, 0, 0, 0, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 15, 15, 85, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, - 86, 86, 116, 116, 3, 3, 15, 85, 85, 116, 86, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 116, 116, 86, 116, 116, 86, 116, 116, - 3, 116, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 0, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, - 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, - 166, 166, 166, 166, 166, 166, 166, 166, 167, 167, 167, 167, 167, 167, - 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, - 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 0, 0, 15, 15, 15, 123, 123, 91, 123, 123, 91, 123, 123, 3, 123, 91, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 0, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, + 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, + 178, 178, 178, 178, 178, 178, 179, 179, 179, 179, 179, 179, 179, 179, + 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, + 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, - 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, - 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, 91, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 6, + 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 0, 0, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 3, 3, 3, 3, 3, 5, - 6, 3, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, - 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, 3, - 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, 3, 3, 3, 4, - 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, - 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 5, - 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 85, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, - 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, - 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 0, 0, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 3, 3, 3, 3, 3, 3, 3, 5, 6, + 3, 0, 0, 0, 0, 0, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 0, 0, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, + 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, + 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, 3, 3, + 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, + 5, 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 90, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 90, 90, 0, 0, 15, 15, 15, 15, + 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, + 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, + 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0 #if TCL_UTF_MAX > 3 ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, @@ -1127,213 +1144,282 @@ static const unsigned char groupMap[] = { 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, - 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, - 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, - 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 18, + 14, 14, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, + 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, + 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, + 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 18, 18, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 118, 15, 15, 15, 15, 15, 15, 15, 15, 118, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, 15, 15, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 118, 118, 118, 118, 118, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 168, 168, 168, 168, 168, 168, 168, 168, 168, - 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, - 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, - 168, 168, 168, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, - 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, - 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, - 169, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 91, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 91, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 125, 15, 15, 15, 15, 15, 15, 15, 15, + 125, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, + 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 125, 125, 125, + 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 180, 180, 180, 180, 180, 180, + 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, + 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, + 180, 180, 180, 180, 180, 180, 181, 181, 181, 181, 181, 181, 181, 181, + 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, + 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, + 181, 181, 181, 181, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, + 0, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, + 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, + 18, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, + 18, 18, 18, 18, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 91, 91, 91, 0, 91, 91, 0, 0, 0, 0, 0, 91, 91, 91, 91, 15, 15, 15, + 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 91, 91, 91, 0, 0, 0, 0, 91, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, + 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 86, 86, 86, 0, 86, 86, 0, 0, 0, 0, 0, 86, 86, 86, 86, 15, 15, - 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 86, 86, 86, 0, 0, 0, 0, 86, 18, 18, 18, 18, 18, 18, 18, 18, - 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, + 15, 15, 15, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, - 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, + 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 116, 86, 116, 15, + 18, 0, 123, 91, 123, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 123, 123, 123, 91, 91, 91, 91, 123, 123, 91, 91, 3, 3, 17, 3, 3, + 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, - 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 116, 86, - 86, 86, 86, 116, 116, 86, 86, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 86, 86, - 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, + 0, 0, 0, 0, 91, 91, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86, 86, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 123, 91, 91, 91, + 91, 91, 91, 91, 91, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, 15, 15, - 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, - 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 116, 86, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 118, 118, 118, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 123, 123, 123, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 123, 123, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 3, 0, 0, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 15, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 123, 123, + 123, 91, 91, 91, 123, 123, 91, 123, 91, 91, 3, 3, 3, 3, 3, 3, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 123, 123, + 123, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 91, 123, 123, 123, 123, 0, 0, 123, + 123, 0, 0, 123, 123, 123, 0, 0, 0, 0, 0, 0, 0, 0, 0, 123, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 123, 123, 0, 0, 91, 91, 91, 91, 91, 91, 91, + 0, 0, 0, 91, 91, 91, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 123, 123, 123, + 91, 91, 91, 91, 91, 91, 123, 91, 123, 123, 123, 123, 91, 91, 123, 91, + 91, 15, 15, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 123, 123, 123, 91, 91, 91, 91, 0, 0, 123, 123, 123, + 123, 91, 91, 123, 91, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 123, 123, 123, 91, + 91, 91, 91, 91, 91, 91, 91, 123, 123, 91, 123, 91, 91, 3, 3, 3, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 123, 91, + 123, 123, 91, 91, 91, 91, 91, 91, 123, 91, 0, 0, 0, 0, 0, 0, 0, 0, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, + 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, + 125, 125, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, + 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 91, 91, 91, + 91, 91, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91, 91, 91, 91, 91, 91, 3, + 3, 3, 3, 3, 14, 14, 14, 14, 90, 90, 90, 90, 3, 14, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, 18, 18, 18, 18, 18, + 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, - 116, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, - 86, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 116, 116, 86, 86, 86, 14, 14, 14, 116, - 116, 116, 116, 116, 116, 17, 17, 17, 17, 17, 17, 17, 17, 86, 86, 86, - 86, 86, 86, 86, 86, 14, 14, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, 86, 86, 86, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, + 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, + 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, + 123, 123, 123, 123, 123, 123, 123, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 91, 91, 91, 91, 90, 90, 90, 90, 90, 90, 90, 90, 90, + 90, 90, 90, 90, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 14, + 91, 91, 3, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 123, 123, 91, 91, 91, + 14, 14, 14, 123, 123, 123, 123, 123, 123, 17, 17, 17, 17, 17, 17, 17, + 17, 91, 91, 91, 91, 91, 91, 91, 91, 14, 14, 91, 91, 91, 91, 91, 91, + 91, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 91, 91, 91, + 91, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 86, 86, 86, - 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, + 14, 91, 91, 91, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, + 21, 21, 21, 21, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 106, + 0, 106, 106, 0, 0, 106, 0, 0, 106, 106, 0, 0, 106, 106, 106, 106, 0, + 106, 106, 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 0, - 100, 100, 0, 0, 100, 0, 0, 100, 100, 0, 0, 100, 100, 100, 100, 0, 100, - 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 0, 21, 0, 21, 21, - 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, + 21, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 100, 100, 0, 100, 100, 100, 100, 0, 0, - 100, 100, 100, 100, 100, 100, 100, 100, 0, 100, 100, 100, 100, 100, - 100, 100, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, 0, 100, 100, - 100, 100, 0, 100, 100, 100, 100, 100, 0, 100, 0, 0, 0, 100, 100, 100, - 100, 100, 100, 100, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 106, 106, 0, 106, 106, 106, 106, 0, + 0, 106, 106, 106, 106, 106, 106, 106, 106, 0, 106, 106, 106, 106, 106, + 106, 106, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 106, 106, 0, 106, 106, + 106, 106, 0, 106, 106, 106, 106, 106, 0, 106, 0, 0, 0, 106, 106, 106, + 106, 106, 106, 106, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, + 21, 21, 21, 21, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 0, 0, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 21, 21, 21, 21, 21, 21, 0, 0, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, - 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, - 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, + 21, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, - 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, + 106, 106, 106, 106, 106, 106, 106, 106, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 21, 0, 0, 9, 9, 9, 9, 9, 9, + 21, 21, 7, 21, 21, 21, 21, 21, 21, 106, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, + 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 91, 91, 91, + 91, 91, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, + 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0, 15, 0, 15, 0, 15, 15, 15, + 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 15, + 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, + 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, - 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0, - 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15, - 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, - 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, - 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, - 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, - 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0 + 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 #endif /* TCL_UTF_MAX > 3 */ }; @@ -1361,11 +1447,12 @@ static const int groups[] = { 53057, -24702, 54081, 53569, -41598, 54593, -33150, 54849, 55873, 55617, 56129, -14206, 609, 451, 674, 20354, -24767, -14271, -33215, 2763585, -41663, 2762817, -2768510, -49855, 17729, 18241, -2760318, - -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, 53122, - -10823550, -10830718, 53634, 54146, -2750078, -2751614, 54658, - 54914, -2745982, 55938, 17794, 55682, 18306, 56194, 4, 6, -21370, - 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258, 2113, - 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662, -15295, + -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, -10833534, + -10832510, 53122, -10823550, -10830718, 53634, 54146, -2750078, + -10829950, -2751614, 54658, 54914, -2745982, 55938, -10824062, + 17794, 55682, 18306, 56194, -10817918, 4, 6, -21370, 29761, 9793, + 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258, 2113, 16002, + 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662, 29826, -15295, 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418, 8, 1859649, 10, -9044862, -976254, 15234, -1949375, -1918, -1983, -18814, -21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879, @@ -1373,7 +1460,8 @@ static const int groups[] = { -1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813, -2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679, -2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -10830783, - 18, 17, 10305, 10370 + -10833599, -10832575, -10830015, -10817983, -10824127, 18, 17, + 10305, 10370 }; #if TCL_UTF_MAX > 3 -- cgit v0.12 From d7b8af55e7a45674c4feb7b912bf4c7ef214855e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 May 2014 07:39:44 +0000 Subject: int -> size_t for hash tables --- generic/tcl.h | 6 +++--- generic/tclHash.c | 15 ++++++++------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index d695ec8..a3f02f7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1072,11 +1072,11 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of diff --git a/generic/tclHash.c b/generic/tclHash.c index 90be511..e75749b 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -640,7 +640,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; register Tcl_HashEntry *hPtr; char *result, *p; @@ -675,16 +675,17 @@ Tcl_HashStats( */ result = ckalloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%d entries in table, %d buckets\n", - tablePtr->numEntries, tablePtr->numBuckets); + sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" + TCL_LL_MODIFIER "d buckets\n", + (Tcl_WideInt) tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", - i, count[i]); + sprintf(p, "number of buckets with %" TCL_LL_MODIFIER "d entries: %" TCL_LL_MODIFIER "d\n", + (Tcl_WideInt) i, (Tcl_WideInt) count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %d\n", - NUM_COUNTERS, overflow); + sprintf(p, "number of buckets with %" TCL_LL_MODIFIER "d or more entries: %" TCL_LL_MODIFIER "d\n", + (Tcl_WideInt) NUM_COUNTERS, (Tcl_WideInt) overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); return result; -- cgit v0.12 From 96dd5baf98be0ff9470e8547c9b3c8905c225621 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 1 Sep 2014 07:15:40 +0000 Subject: Adding the ability for the Tcl core to build self-contained Zip-based executables * Integrated a pure-C implementation of ZipVfs * Modified Tcl_AppInit() to look for a zipvfs mounted on the executable --- changes | 2 + generic/tcl.decls | 16 + generic/tclDecls.h | 17 + generic/tclMain.c | 6 + generic/tclStubInit.c | 3 + generic/tclZipVfs.c | 2429 ++++++++++++++++++++++++++++++++++++++++++++ unix/Makefile.in | 15 +- unix/tclAppInit.c | 27 +- win/Makefile.in | 13 +- win/makefile.bc | 1 + win/makefile.vc | 4 + win/tclAppInit.c | 22 + win/tclkit.exe.manifest.in | 51 + win/tclkit.rc | 82 ++ 14 files changed, 2684 insertions(+), 4 deletions(-) create mode 100755 generic/tclZipVfs.c create mode 100644 win/tclkit.exe.manifest.in create mode 100644 win/tclkit.rc diff --git a/changes b/changes index ba0854b..8f11f4b 100644 --- a/changes +++ b/changes @@ -8452,3 +8452,5 @@ include ::oo::class (fellows) 2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux) --- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details + +2014-08-29 (TIP TBD) Added a C Implementation of ZipVFS to provide Tcl/Wishkit building capbilities in the core (hypnotoad) \ No newline at end of file diff --git a/generic/tcl.decls b/generic/tcl.decls index 1829249..8352afa 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2326,6 +2326,22 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # +# ZipVfs +declare 631 { + int Tcl_Zvfs_Init(Tcl_Interp *interp) +} + +declare 632 { + int Tcl_Zvfs_Mount( + Tcl_Interp *interp, + CONST char *zArchive, + CONST char *zMountPoint + ) +} + +declare 633 { + int Tcl_Zvfs_Umount(CONST char *zArchive) +} ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 91c0add..75dd554 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1815,6 +1815,14 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); +/* 631 */ +EXTERN int Tcl_Zvfs_Init(Tcl_Interp *interp); +/* 632 */ +EXTERN int Tcl_Zvfs_Mount(Tcl_Interp *interp, + CONST char *zArchive, + CONST char *zMountPoint); +/* 633 */ +EXTERN int Tcl_Zvfs_Umount(CONST char *zArchive); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2481,6 +2489,9 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ + int (*tcl_Zvfs_Init) (Tcl_Interp *interp); /* 631 */ + int (*tcl_Zvfs_Mount) (Tcl_Interp *interp, CONST char *zArchive, CONST char *zMountPoint); /* 632 */ + int (*tcl_Zvfs_Umount) (CONST char *zArchive); /* 633 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3773,6 +3784,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FSUnloadFile) /* 629 */ #define Tcl_ZlibStreamSetCompressionDictionary \ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ +#define Tcl_Zvfs_Init \ + (tclStubsPtr->tcl_Zvfs_Init) /* 631 */ +#define Tcl_Zvfs_Mount \ + (tclStubsPtr->tcl_Zvfs_Mount) /* 632 */ +#define Tcl_Zvfs_Umount \ + (tclStubsPtr->tcl_Zvfs_Umount) /* 633 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclMain.c b/generic/tclMain.c index 360f5e9..0bf2e8d 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -382,6 +382,12 @@ Tcl_MainEx( */ Tcl_Preserve(interp); + + /* + * Check if this shell has an attached VFS + */ + CONST char *cp=Tcl_GetNameOfExecutable(); + if (appInitProc(interp) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7a84cba..b061ba6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1412,6 +1412,9 @@ const TclStubs tclStubs = { Tcl_FindSymbol, /* 628 */ Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ + Tcl_Zvfs_Init, /* 631 */ + Tcl_Zvfs_Mount, /* 632 */ + Tcl_Zvfs_Umount, /* 633 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c new file mode 100755 index 0000000..0456b4a --- /dev/null +++ b/generic/tclZipVfs.c @@ -0,0 +1,2429 @@ +/* +** Copyright (c) 2000 D. Richard Hipp +** Copyright (c) 2007 PDQ Interfaces Inc. +** Copyright (c) 2013 Sean Woods +** +** This file is now released under the BSD style license +** outlined in the included file license.terms. +** +************************************************************************* +** A ZIP archive virtual filesystem for Tcl. +** +** This package of routines enables Tcl to use a Zip file as +** a virtual file system. Each of the content files of the Zip +** archive appears as a real file to Tcl. +** +** Well, almost... Actually, the virtual file system is limited +** in a number of ways. The only things you can do are "stat" +** and "read" file content files. You cannot use "cd". +** But it turns out that "stat" +** and "read" are sufficient for most purposes. +** +** This version has been modified to run under Tcl 8.6 +** +*/ +#include "tcl.h" +#include +#include +#include +#include +#include +#include + +#ifdef TCL_FILESYSTEM_VERSION_1 +#define USE_TCL_VFS 1 +#endif + +/* +** Size of the decompression input buffer +*/ +#define COMPR_BUF_SIZE 8192 +static int maptolower=0; +static int openarch=0; /* Set to 1 when opening archive. */ + +/* +** All static variables are collected into a structure named "local". +** That way, it is clear in the code when we are using a static +** variable because its name begins with "local.". +*/ +static struct { + Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The + ** The key is the virtual filename. The data + ** an an instance of the ZvfsFile structure. */ + Tcl_HashTable archiveHash; /* One entry for each archive. Key is the name. + ** data is the ZvfsArchive structure */ + int isInit; /* True after initialization */ +} local; + +/* +** Each ZIP archive file that is mounted is recorded as an instance +** of this structure +*/ +typedef struct ZvfsArchive { + char *zName; /* Name of the archive */ + char *zMountPoint; /* Where this archive is mounted */ + struct ZvfsFile *pFiles; /* List of files in that archive */ +} ZvfsArchive; + +/* +** Particulars about each virtual file are recorded in an instance +** of the following structure. +*/ +typedef struct ZvfsFile { + char *zName; /* The full pathname of the virtual file */ + ZvfsArchive *pArchive; /* The ZIP archive holding this file data */ + int iOffset; /* Offset into the ZIP archive of the data */ + int nByte; /* Uncompressed size of the virtual file */ + int nByteCompr; /* Compressed size of the virtual file */ + time_t timestamp; /* Modification time */ + int isdir; /* Set to 2 if directory, or 1 if mount */ + int depth; /* Number of slashes in path. */ + int permissions; /* File permissions. */ + struct ZvfsFile *pNext; /* Next file in the same archive */ + struct ZvfsFile *pNextName; /* A doubly-linked list of files with the same */ + struct ZvfsFile *pPrevName; /* name. Only the first is in local.fileHash */ +} ZvfsFile; + +/* +** Information about each file within a ZIP archive is stored in +** an instance of the following structure. A list of these structures +** forms a table of contents for the archive. +*/ +typedef struct ZFile ZFile; +struct ZFile { + char *zName; /* Name of the file */ + int isSpecial; /* Not really a file in the ZIP archive */ + int dosTime; /* Modification time (DOS format) */ + int dosDate; /* Modification date (DOS format) */ + int iOffset; /* Offset into the ZIP archive of the data */ + int nByte; /* Uncompressed size of the virtual file */ + int nByteCompr; /* Compressed size of the virtual file */ + int nExtra; /* Extra space in the TOC header */ + int iCRC; /* Cyclic Redundancy Check of the data */ + int permissions; /* File permissions. */ + int flags; /* Deletion = bit 0. */ + ZFile *pNext; /* Next file in the same archive */ +}; + +EXTERN int Tcl_Zvfs_Mount(Tcl_Interp *interp,CONST char *zArchive,CONST char *zMountPoint); +EXTERN int Tcl_Zvfs_Umount(CONST char *zArchive); +EXTERN int Tcl_Zvfs_Init(Tcl_Interp *interp); +EXTERN int Tcl_Zvfs_SafeInit(Tcl_Interp *interp); +/* +** Macros to read 16-bit and 32-bit big-endian integers into the +** native format of this local processor. B is an array of +** characters and the integer begins at the N-th character of +** the array. +*/ +#define INT16(B, N) (B[N] + (B[N+1]<<8)) +#define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24)) + +/* +** Write a 16- or 32-bit integer as little-endian into the given buffer. +*/ +static void put16(char *z, int v){ + z[0] = v & 0xff; + z[1] = (v>>8) & 0xff; +} +static void put32(char *z, int v){ + z[0] = v & 0xff; + z[1] = (v>>8) & 0xff; + z[2] = (v>>16) & 0xff; + z[3] = (v>>24) & 0xff; +} + +/* +** Make a new ZFile structure with space to hold a name of the number of +** characters given. Return a pointer to the new structure. +*/ +static ZFile *newZFile(int nName, ZFile **ppList){ + ZFile *pNew; + + pNew = (ZFile*)Tcl_Alloc( sizeof(*pNew) + nName + 1 ); + memset(pNew, 0, sizeof(*pNew)); + pNew->zName = (char*)&pNew[1]; + pNew->pNext = *ppList; + *ppList = pNew; + return pNew; +} + +/* +** Delete an entire list of ZFile structures +*/ +static void deleteZFileList(ZFile *pList){ + ZFile *pNext; + while( pList ){ + pNext = pList->pNext; + Tcl_Free((char*)pList); + pList = pNext; + } +} + +/* Convert DOS time to unix time. */ +static void UnixTimeDate(struct tm *tm, int *dosDate, int *dosTime){ + *dosDate = ((((tm->tm_year-80)<<9)&0xfe00) | (((tm->tm_mon+1)<<5)&0x1e0) | (tm->tm_mday&0x1f)); + *dosTime = (((tm->tm_hour<<11)&0xf800) | ((tm->tm_min<<5)&0x7e0) | (tm->tm_sec&0x1f)); +} + +/* Convert DOS time to unix time. */ +static time_t DosTimeDate(int dosDate, int dosTime){ + time_t now; + struct tm *tm; + now=time(NULL); + tm = localtime(&now); + tm->tm_year=(((dosDate&0xfe00)>>9) + 80); + tm->tm_mon=((dosDate&0x1e0)>>5); + tm->tm_mday=(dosDate & 0x1f); + tm->tm_hour=(dosTime&0xf800)>>11; + tm->tm_min=(dosTime&0x7e0)>>5; + tm->tm_sec=(dosTime&0x1f); + return mktime(tm); +} + +/* +** Translate a DOS time and date stamp into a human-readable string. +*/ +static void translateDosTimeDate(char *zStr, int dosDate, int dosTime){ + static char *zMonth[] = { "nil", + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + }; + + sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", + dosDate & 0x1f, + zMonth[ ((dosDate&0x1e0)>>5) ], + ((dosDate&0xfe00)>>9) + 1980, + (dosTime&0xf800)>>11, + (dosTime&0x7e)>>5, + dosTime&0x1f + ); +} + +/* Return count of char ch in str */ +int strchrcnt(char *str, char ch) { + int cnt=0; + char *cp=str; + while ((cp=strchr(cp,ch))) { cp++; cnt++; } + return cnt; +} + + +/* +** Concatenate zTail onto zRoot to form a pathname. zRoot will begin +** with "/". After concatenation, simplify the pathname be removing +** unnecessary ".." and "." directories. Under windows, make all +** characters lower case. +** +** Resulting pathname is returned. Space to hold the returned path is +** obtained form Tcl_Alloc() and should be freed by the calling function. +*/ +static char *CanonicalPath(const char *zRoot, const char *zTail){ + char *zPath; + int i, j, c; + +#ifdef __WIN32__ + if( isalpha(zTail[0]) && zTail[1]==':' ){ zTail += 2; } + if( zTail[0]=='\\' ){ zRoot = ""; zTail++; } +#endif + if( zTail[0]=='/' ){ zRoot = ""; zTail++; } + zPath = Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 ); + if( zPath==0 ) return 0; + if (zTail[0]) { + sprintf(zPath, "%s/%s", zRoot, zTail); + } else { + strcpy(zPath, zRoot); + } + for(i=j=0; (c = zPath[i])!=0; i++){ +#ifdef __WIN32__ + if( isupper(c) ) { if (maptolower) c = tolower(c); } + else if( c=='\\' ) c = '/'; +#endif + if( c=='/' ){ + int c2 = zPath[i+1]; + if( c2=='/' ) continue; + if( c2=='.' ){ + int c3 = zPath[i+2]; + if( c3=='/' || c3==0 ){ + i++; + continue; + } + if( c3=='.' && (zPath[i+3]=='.' || zPath[i+3]==0) ){ + i += 2; + while( j>0 && zPath[j-1]!='/' ){ j--; } + continue; + } + } + } + zPath[j++] = c; + } + if( j==0 ){ zPath[j++] = '/'; } +// if (j>1 && zPath[j-1] == '/') j--; + zPath[j] = 0; + return zPath; +} + +/* +** Construct an absolute pathname where memory is obtained from Tcl_Alloc +** that means the same file as the pathname given. +*/ +static char *AbsolutePath(const char *zRelative){ + Tcl_DString pwd; + char *zResult; + int len; + Tcl_DStringInit(&pwd); + if (zRelative[0] == '~' && zRelative[1] == '/') { + /* TODO: do this for all paths??? */ + if (Tcl_TranslateFileName(0, zRelative, &pwd) != NULL) { + zResult = CanonicalPath( "", Tcl_DStringValue(&pwd)); + goto done; + } + } else if( zRelative[0] != '/'){ +#ifdef __WIN32__ + if(!(zRelative[0]=='\\' || (zRelative[0] && zRelative[1] == ':'))) { + /*Tcl_GetCwd(0, &pwd); */ + } +#else + Tcl_GetCwd(0, &pwd); +#endif + } + zResult = CanonicalPath( Tcl_DStringValue(&pwd), zRelative); +done: + Tcl_DStringFree(&pwd); + len=strlen(zResult); + if (len > 0 && zResult[len-1] == '/') + zResult[len-1] = 0; + return zResult; +} + +int ZvfsReadTOCStart( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + Tcl_Channel chan, + ZFile **pList, + int *iStart +) { + char *zArchiveName = 0; /* A copy of zArchive */ + int nFile; /* Number of files in the archive */ + int iPos; /* Current position in the archive file */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + int isNew; /* Flag to tell use when a hash entry is new */ + unsigned char zBuf[100]; /* Space into which to read from the ZIP archive */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZFile *p; + int zipStart; + + if (!chan) { + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){ + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { + return TCL_ERROR; + } + + /* Read the "End Of Central Directory" record from the end of the + ** ZIP archive. + */ + iPos = Tcl_Seek(chan, -22, SEEK_END); + Tcl_Read(chan, zBuf, 22); + if (memcmp(zBuf, "\120\113\05\06", 4)) { + /* Tcl_AppendResult(interp, "not a ZIP archive", NULL); */ + return TCL_BREAK; + } + + /* Compute the starting location of the directory for the ZIP archive + ** in iPos then seek to that location. + */ + zipStart = iPos; + nFile = INT16(zBuf,8); + iPos -= INT32(zBuf,12); + Tcl_Seek(chan, iPos, SEEK_SET); + + while(1) { + int lenName; /* Length of the next filename */ + int lenExtra; /* Length of "extra" data for next file */ + int iData; /* Offset to start of file data */ + int dosTime; + int dosDate; + int isdir; + ZvfsFile *pZvfs; /* A new virtual file */ + char *zFullPath; /* Full pathname of the virtual file */ + char zName[1024]; /* Space to hold the filename */ + + if (nFile-- <= 0 ){ + break; + } + /* Read the next directory entry. Extract the size of the filename, + ** the size of the "extra" information, and the offset into the archive + ** file of the file data. + */ + Tcl_Read(chan, zBuf, 46); + if (memcmp(zBuf, "\120\113\01\02", 4)) { + Tcl_AppendResult(interp, "ill-formed central directory entry", NULL); + return TCL_ERROR; + } + lenName = INT16(zBuf,28); + lenExtra = INT16(zBuf,30) + INT16(zBuf,32); + iData = INT32(zBuf,42); + if (iDatazName, lenName); + p->zName[lenName] = 0; + if (lenName>0 && p->zName[lenName-1] == '/') { + p->isSpecial = 1; + } + p->dosDate = INT16(zBuf, 14); + p->dosTime = INT16(zBuf, 12); + p->nByteCompr = INT32(zBuf, 20); + p->nByte = INT32(zBuf, 24); + p->nExtra = INT32(zBuf, 28); + p->iCRC = INT32(zBuf, 32); + + if (nFile < 0) + break; + + /* Skip over the extra information so that the next read will be from + ** the beginning of the next directory entry. + */ + Tcl_Seek(chan, lenExtra, SEEK_CUR); + } + *iStart = zipStart; + return TCL_OK; +} + +int ZvfsReadTOC( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + Tcl_Channel chan, + ZFile **pList +) { + int iStart; + return ZvfsReadTOCStart( interp, chan, pList, &iStart); +} + +/* +** Read a ZIP archive and make entries in the virutal file hash table for all +** content files of that ZIP archive. Also initialize the ZVFS if this +** routine has not been previously called. +*/ +int Tcl_Zvfs_Mount( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + CONST char *zArchive, /* The ZIP archive file */ + CONST char *zMountPoint /* Mount contents at this directory */ +){ + Tcl_Channel chan; /* Used for reading the ZIP archive file */ + char *zArchiveName = 0; /* A copy of zArchive */ + char *zTrueName = 0; /* A copy of zMountPoint */ + int nFile; /* Number of files in the archive */ + int iPos; /* Current position in the archive file */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + int isNew; /* Flag to tell use when a hash entry is new */ + unsigned char zBuf[100]; /* Space into which to read from the ZIP archive */ + Tcl_HashSearch zSearch; /* Search all mount points */ + unsigned int startZip; + + if( !local.isInit ) return TCL_ERROR; + /* If null archive name, return all current mounts. */ + if (!zArchive) { + Tcl_DString dStr; + Tcl_DStringInit(&dStr); + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + Tcl_DStringAppendElement(&dStr, pArchive->zName); + Tcl_DStringAppendElement(&dStr, pArchive->zMountPoint); + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + Tcl_DStringResult(interp, &dStr); + return TCL_OK; + } + /* If null mount, return mount point. */ + // TODO: cleanup allocations of Absolute() path. + if (!zMountPoint) { + zTrueName=AbsolutePath(zArchive); + pEntry = Tcl_FindHashEntry(&local.archiveHash,zTrueName); + if (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + Tcl_AppendResult(interp, pArchive->zMountPoint, 0); + } + } + Tcl_Free(zTrueName); + return TCL_OK; + } + chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0); + if (!chan) { + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){ + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { + return TCL_ERROR; + } + + /* Read the "End Of Central Directory" record from the end of the + ** ZIP archive. + */ + iPos = Tcl_Seek(chan, -22, SEEK_END); + Tcl_Read(chan, zBuf, 22); + if (memcmp(zBuf, "\120\113\05\06", 4)) { + Tcl_AppendResult(interp, "not a ZIP archive", NULL); + return TCL_ERROR; + } + + /* Construct the archive record + */ + zArchiveName = AbsolutePath(zArchive); + pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew); + if( !isNew ){ + pArchive = Tcl_GetHashValue(pEntry); + Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint, 0); + Tcl_Free(zArchiveName); + Tcl_Close(interp, chan); + return TCL_ERROR; + } + if (!*zMountPoint) { + /* Empty string is the special case of mounting on itself. */ + zMountPoint = zTrueName = AbsolutePath(zArchive); + } + pArchive = (ZvfsArchive*)Tcl_Alloc(sizeof(*pArchive) + strlen(zMountPoint)+1); + pArchive->zName = zArchiveName; + pArchive->zMountPoint = (char*)&pArchive[1]; + strcpy(pArchive->zMountPoint, zMountPoint); + pArchive->pFiles = 0; + Tcl_SetHashValue(pEntry, pArchive); + + /* Compute the starting location of the directory for the ZIP archive + ** in iPos then seek to that location. + */ + nFile = INT16(zBuf,8); + iPos -= INT32(zBuf,12); + Tcl_Seek(chan, iPos, SEEK_SET); + startZip = iPos; + + while(1) { + int lenName; /* Length of the next filename */ + int lenExtra; /* Length of "extra" data for next file */ + int iData; /* Offset to start of file data */ + int dosTime; + int dosDate; + int isdir; + ZvfsFile *pZvfs; /* A new virtual file */ + char *zFullPath; /* Full pathname of the virtual file */ + char zName[1024]; /* Space to hold the filename */ + + if (nFile-- <= 0 ){ + isdir = 1; + zFullPath = CanonicalPath(zMountPoint, ""); + iData = startZip; + goto addentry; + } + /* Read the next directory entry. Extract the size of the filename, + ** the size of the "extra" information, and the offset into the archive + ** file of the file data. + */ + Tcl_Read(chan, zBuf, 46); + if (memcmp(zBuf, "\120\113\01\02", 4)) { + Tcl_AppendResult(interp, "ill-formed central directory entry", NULL); + if (zTrueName) + Tcl_Free(zTrueName); + return TCL_ERROR; + } + lenName = INT16(zBuf,28); + lenExtra = INT16(zBuf,30) + INT16(zBuf,32); + iData = INT32(zBuf,42); + + + /* If the virtual filename is too big to fit in zName[], then skip + ** this file + */ + if( lenName >= sizeof(zName) ){ + Tcl_Seek(chan, lenName + lenExtra, SEEK_CUR); + continue; + } + + /* Construct an entry in local.fileHash for this virtual file. + */ + Tcl_Read(chan, zName, lenName); + isdir=0; + if (lenName>0 && zName[lenName-1] == '/') { + lenName--; + isdir=2; + } + zName[lenName] = 0; + zFullPath = CanonicalPath(zMountPoint, zName); +addentry: + pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) ); + pZvfs->zName = zFullPath; + pZvfs->pArchive = pArchive; + pZvfs->isdir = isdir; + pZvfs->depth=strchrcnt(zFullPath,'/'); + pZvfs->iOffset = iData; + if (iDatatimestamp = DosTimeDate(dosDate, dosTime); + pZvfs->nByte = INT32(zBuf, 24); + pZvfs->nByteCompr = INT32(zBuf, 20); + pZvfs->pNext = pArchive->pFiles; + pZvfs->permissions = (0xffff&(INT32(zBuf, 38) >> 16)); + pArchive->pFiles = pZvfs; + pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullPath, &isNew); + if( isNew ){ + pZvfs->pNextName = 0; + }else{ + ZvfsFile *pOld = (ZvfsFile*)Tcl_GetHashValue(pEntry); + pOld->pPrevName = pZvfs; + pZvfs->pNextName = pOld; + } + pZvfs->pPrevName = 0; + Tcl_SetHashValue(pEntry, (ClientData) pZvfs); + + if (nFile < 0) + break; + + /* Skip over the extra information so that the next read will be from + ** the beginning of the next directory entry. + */ + Tcl_Seek(chan, lenExtra, SEEK_CUR); + } + Tcl_Close(interp, chan); +done: + if (zTrueName) + Tcl_Free(zTrueName); + return TCL_OK; +} + +/* +** Locate the ZvfsFile structure that corresponds to the file named. +** Return NULL if there is no such ZvfsFile. +*/ +static ZvfsFile *ZvfsLookup(char *zFilename){ + char *zTrueName; + Tcl_HashEntry *pEntry; + ZvfsFile *pFile; + + if( local.isInit==0 ) return 0; + zTrueName = AbsolutePath(zFilename); + pEntry = Tcl_FindHashEntry(&local.fileHash, zTrueName); + pFile = pEntry ? Tcl_GetHashValue(pEntry) : 0; + Tcl_Free(zTrueName); + return pFile; +} + +static int ZvfsLookupMount(char *zFilename){ + char *zTrueName; + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + int match=0; + if( local.isInit==0 ) return 0; + zTrueName = AbsolutePath(zFilename); + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + if (!strcmp(pArchive->zMountPoint,zTrueName)) { + match=1; + break; + } + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + Tcl_Free(zTrueName); + return match; +} + + +/* +** Unmount all the files in the given ZIP archive. +*/ +int Tcl_Zvfs_Umount(CONST char *zArchive){ + char *zArchiveName; + ZvfsArchive *pArchive; + ZvfsFile *pFile, *pNextFile; + Tcl_HashEntry *pEntry; + + zArchiveName = AbsolutePath(zArchive); + pEntry = Tcl_FindHashEntry(&local.archiveHash, zArchiveName); + Tcl_Free(zArchiveName); + if( pEntry==0 ) return 0; + pArchive = Tcl_GetHashValue(pEntry); + Tcl_DeleteHashEntry(pEntry); + Tcl_Free(pArchive->zName); + for(pFile=pArchive->pFiles; pFile; pFile=pNextFile){ + pNextFile = pFile->pNext; + if( pFile->pNextName ){ + pFile->pNextName->pPrevName = pFile->pPrevName; + } + if( pFile->pPrevName ){ + pFile->pPrevName->pNextName = pFile->pNextName; + }else{ + pEntry = Tcl_FindHashEntry(&local.fileHash, pFile->zName); + if( pEntry==0 ){ + /* This should never happen */ + }else if( pFile->pNextName ){ + Tcl_SetHashValue(pEntry, pFile->pNextName); + }else{ + Tcl_DeleteHashEntry(pEntry); + } + } + Tcl_Free(pFile->zName); + Tcl_Free((char*)pFile); + } + return 1; +} + +static void Zvfs_Unmount(CONST char *zArchive){ + Tcl_Zvfs_Umount(zArchive); +} + +/* +** zvfs::mount Zip-archive-name mount-point +** +** Create a new mount point on the given ZIP archive. After this +** command executes, files contained in the ZIP archive will appear +** to Tcl to be regular files at the mount point. +** +** With no mount-point, return mount point for archive. +** With no archive, return all archive/mount pairs. +** If mount-point is specified as an empty string, mount on file path. +** +*/ +static int ZvfsMountCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int argc, /* Number of arguments */ + CONST char *argv[] /* Values of all arguments */ +){ + if( argc>3 ){ + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0); + return TCL_ERROR; + } + return Tcl_Zvfs_Mount(interp, argc>1?argv[1]:0, argc>2?argv[2]:0); +} + +/* +** zvfs::unmount Zip-archive-name +** +** Undo the effects of zvfs::mount. +*/ +static int ZvfsUnmountCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int argc, /* Number of arguments */ + CONST char *argv[] /* Values of all arguments */ +){ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + + if( argc!=2 ){ + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ZIP-FILE\"", 0); + return TCL_ERROR; + } + if (Tcl_Zvfs_Umount(argv[1])) { + return TCL_OK; + } + + if( !local.isInit ) return TCL_ERROR; + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (((pArchive = Tcl_GetHashValue(pEntry))) + && pArchive->zMountPoint[0] + && (strcmp(pArchive->zMountPoint, argv[1]) == 0)) { + if (Tcl_Zvfs_Umount(pArchive->zName)) { + return TCL_OK; + } + break; + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + + Tcl_AppendResult( interp, "unknown zvfs mount point or file: ", argv[1], 0); + return TCL_ERROR; +} + +/* +** zvfs::exists filename +** +** Return TRUE if the given filename exists in the ZVFS and FALSE if +** it does not. +*/ +static int ZvfsExistsObjCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *CONST* objv /* Values of all arguments */ +){ + char *zFilename; + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); + return TCL_ERROR; + } + zFilename = Tcl_GetString(objv[1]); + Tcl_SetBooleanObj( Tcl_GetObjResult(interp), ZvfsLookup(zFilename)!=0); + return TCL_OK; +} + +/* +** zvfs::info filename +** +** Return information about the given file in the ZVFS. The information +** consists of (1) the name of the ZIP archive that contains the file, +** (2) the size of the file after decompressions, (3) the compressed +** size of the file, and (4) the offset of the compressed data in the archive. +** +** Note: querying the mount point gives the start of zip data offset in +** (4), which can be used to truncate the zip info off an executable. +*/ +static int ZvfsInfoObjCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv /* Values of all arguments */ +){ + char *zFilename; + ZvfsFile *pFile; + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); + return TCL_ERROR; + } + zFilename = Tcl_GetString(objv[1]); + pFile = ZvfsLookup(zFilename); + if( pFile ){ + Tcl_Obj *pResult = Tcl_GetObjResult(interp); + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewStringObj(pFile->pArchive->zName, -1)); + Tcl_ListObjAppendElement(interp, pResult, Tcl_NewIntObj(pFile->nByte)); + Tcl_ListObjAppendElement(interp, pResult, Tcl_NewIntObj(pFile->nByteCompr)); + Tcl_ListObjAppendElement(interp, pResult, Tcl_NewIntObj(pFile->iOffset)); + } + return TCL_OK; +} + +/* +** zvfs::list +** +** Return a list of all files in the ZVFS. The order of the names +** in the list is arbitrary. +*/ +static int ZvfsListObjCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv /* Values of all arguments */ +){ + char *zPattern = 0; + Tcl_RegExp pRegexp = 0; + Tcl_HashEntry *pEntry; + Tcl_HashSearch sSearch; + Tcl_Obj *pResult = Tcl_GetObjResult(interp); + + if( objc>3 ){ + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?PATTERN?"); + return TCL_ERROR; + } + if( local.isInit==0 ) return TCL_OK; + if( objc==3 ){ + int n; + char *zSwitch = Tcl_GetStringFromObj(objv[1], &n); + if( n>=2 && strncmp(zSwitch,"-glob",n)==0 ){ + zPattern = Tcl_GetString(objv[2]); + }else if( n>=2 && strncmp(zSwitch,"-regexp",n)==0 ){ + pRegexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + if( pRegexp==0 ) return TCL_ERROR; + }else{ + Tcl_AppendResult(interp, "unknown option: ", zSwitch, 0); + return TCL_ERROR; + } + }else if( objc==2 ){ + zPattern = Tcl_GetString(objv[1]); + } + if( zPattern ){ + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; + pEntry = Tcl_NextHashEntry(&sSearch) + ){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + if( Tcl_StringCaseMatch(z, zPattern,1) ){ + Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); + } + } + }else if( pRegexp ){ + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; + pEntry = Tcl_NextHashEntry(&sSearch) + ){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + if( Tcl_RegExpExec(interp, pRegexp, z, z) ){ + Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); + } + } + }else{ + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; + pEntry = Tcl_NextHashEntry(&sSearch) + ){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); + } + } + return TCL_OK; +} + +/* +** Whenever a ZVFS file is opened, an instance of this structure is +** attached to the open channel where it will be available to the +** ZVFS I/O routines below. All state information about an open +** ZVFS file is held in this structure. +*/ +typedef struct ZvfsChannelInfo { + unsigned int nByte; /* number of bytes of read uncompressed data */ + unsigned int nByteCompr; /* number of bytes of unread compressed data */ + unsigned int nData; /* total number of bytes of compressed data */ + int readSoFar; /* Number of bytes read so far */ + long startOfData; /* File position of start of data in ZIP archive */ + int isCompressed; /* True data is compressed */ + Tcl_Channel chan; /* Open to the archive file */ + unsigned char *zBuf; /* buffer used by the decompressor */ + z_stream stream; /* state of the decompressor */ +} ZvfsChannelInfo; + + +/* +** This routine is called as an exit handler. If we do not set +** ZvfsChannelInfo.chan to NULL, then Tcl_Close() will be called on +** that channel twice when Tcl_Exit runs. This will lead to a +** core dump. +*/ +static void vfsExit(void *pArg){ + ZvfsChannelInfo *pInfo = (ZvfsChannelInfo*)pArg; + pInfo->chan = 0; +} + +/* +** This routine is called when the ZVFS channel is closed +*/ +static int vfsClose( + ClientData instanceData, /* A ZvfsChannelInfo structure */ + Tcl_Interp *interp /* The TCL interpreter */ +){ + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*)instanceData; + + if( pInfo->zBuf ){ + Tcl_Free(pInfo->zBuf); + inflateEnd(&pInfo->stream); + } + if( pInfo->chan ){ + Tcl_Close(interp, pInfo->chan); + Tcl_DeleteExitHandler(vfsExit, pInfo); + } + Tcl_Free((char*)pInfo); + return TCL_OK; +} + +/* +** The TCL I/O system calls this function to actually read information +** from a ZVFS file. +*/ +static int vfsInput ( + ClientData instanceData, /* The channel to read from */ + char *buf, /* Buffer to fill */ + int toRead, /* Requested number of bytes */ + int *pErrorCode /* Location of error flag */ +){ + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; + + if( toRead > pInfo->nByte ){ + toRead = pInfo->nByte; + } + if( toRead == 0 ){ + return 0; + } + if( pInfo->isCompressed ){ + int err = Z_OK; + z_stream *stream = &pInfo->stream; + stream->next_out = buf; + stream->avail_out = toRead; + while (stream->avail_out) { + if (!stream->avail_in) { + int len = pInfo->nByteCompr; + if (len > COMPR_BUF_SIZE) { + len = COMPR_BUF_SIZE; + } + len = Tcl_Read(pInfo->chan, pInfo->zBuf, len); + pInfo->nByteCompr -= len; + stream->next_in = pInfo->zBuf; + stream->avail_in = len; + } + err = inflate(stream, Z_NO_FLUSH); + if (err) break; + } + if (err == Z_STREAM_END) { + if ((stream->avail_out != 0)) { + *pErrorCode = err; /* premature end */ + return -1; + } + }else if( err ){ + *pErrorCode = err; /* some other zlib error */ + return -1; + } + }else{ + toRead = Tcl_Read(pInfo->chan, buf, toRead); + } + pInfo->nByte -= toRead; + pInfo->readSoFar += toRead; + *pErrorCode = 0; + return toRead; +} + +/* +** Write to a ZVFS file. ZVFS files are always read-only, so this routine +** always returns an error. +*/ +static int vfsOutput( + ClientData instanceData, /* The channel to write to */ + CONST char *buf, /* Data to be stored. */ + int toWrite, /* Number of bytes to write. */ + int *pErrorCode /* Location of error flag. */ +){ + *pErrorCode = EINVAL; + return -1; +} + +/* +** Move the file pointer so that the next byte read will be "offset". +*/ +static int vfsSeek( + ClientData instanceData, /* The file structure */ + long offset, /* Offset to seek to */ + int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */ + int *pErrorCode /* Write the error code here */ +){ + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; + + switch( mode ){ + case SEEK_CUR: { + offset += pInfo->readSoFar; + break; + } + case SEEK_END: { + offset += pInfo->readSoFar + pInfo->nByte; + break; + } + default: { + /* Do nothing */ + break; + } + } + if (offset < 0) offset = 0; + if( !pInfo->isCompressed ){ + Tcl_Seek(pInfo->chan, offset + pInfo->startOfData, SEEK_SET); + pInfo->nByte = pInfo->nData; + pInfo->readSoFar = offset; + }else{ + if( offsetreadSoFar ){ + z_stream *stream = &pInfo->stream; + inflateEnd(stream); + stream->zalloc = (alloc_func)0; + stream->zfree = (free_func)0; + stream->opaque = (voidpf)0; + stream->avail_in = 2; + stream->next_in = pInfo->zBuf; + pInfo->zBuf[0] = 0x78; + pInfo->zBuf[1] = 0x01; + inflateInit(&pInfo->stream); + Tcl_Seek(pInfo->chan, pInfo->startOfData, SEEK_SET); + pInfo->nByte += pInfo->readSoFar; + pInfo->nByteCompr = pInfo->nData; + pInfo->readSoFar = 0; + } + while( pInfo->readSoFar < offset ){ + int toRead, errCode; + char zDiscard[100]; + toRead = offset - pInfo->readSoFar; + if( toRead>sizeof(zDiscard) ) toRead = sizeof(zDiscard); + vfsInput(instanceData, zDiscard, toRead, &errCode); + } + } + return pInfo->readSoFar; +} + +/* +** Handle events on the channel. ZVFS files do not generate events, +** so this is a no-op. +*/ +static void vfsWatchChannel( + ClientData instanceData, /* Channel to watch */ + int mask /* Events of interest */ +){ + return; +} + +/* +** Called to retrieve the underlying file handle for this ZVFS file. +** As the ZVFS file has no underlying file handle, this is a no-op. +*/ +static int vfsGetFile( + ClientData instanceData, /* Channel to query */ + int direction, /* Direction of interest */ + ClientData* handlePtr /* Space to the handle into */ +){ + return TCL_ERROR; +} + +/* +** This structure describes the channel type structure for +** access to the ZVFS. +*/ +static Tcl_ChannelType vfsChannelType = { + "vfs", /* Type name. */ + NULL, /* Set blocking/nonblocking behaviour. NULL'able */ + vfsClose, /* Close channel, clean instance data */ + vfsInput, /* Handle read request */ + vfsOutput, /* Handle write request */ + vfsSeek, /* Move location of access point. NULL'able */ + NULL, /* Set options. NULL'able */ + NULL, /* Get options. NULL'able */ + vfsWatchChannel, /* Initialize notifier */ + vfsGetFile /* Get OS handle from the channel. */ +}; + +/* +** This routine attempts to do an open of a file. Check to see +** if the file is located in the ZVFS. If so, then open a channel +** for reading the file. If not, return NULL. +*/ +static Tcl_Channel ZvfsFileOpen( + Tcl_Interp *interp, /* The TCL interpreter doing the open */ + char *zFilename, /* Name of the file to open */ + char *modeString, /* Mode string for the open (ignored) */ + int permissions /* Permissions for a newly created file (ignored) */ +){ + ZvfsFile *pFile; + ZvfsChannelInfo *pInfo; + Tcl_Channel chan; + static int count = 1; + char zName[50]; + unsigned char zBuf[50]; + + pFile = ZvfsLookup(zFilename); + if( pFile==0 ) return NULL; + openarch=1; + chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); + openarch=0; + if( chan==0 ){ + return 0; + } + if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") + || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") + ){ + /* this should never happen */ + Tcl_Close(0, chan); + return 0; + } + Tcl_Seek(chan, pFile->iOffset, SEEK_SET); + Tcl_Read(chan, zBuf, 30); + if( memcmp(zBuf, "\120\113\03\04", 4) ){ + if( interp ){ + Tcl_AppendResult(interp, "local header mismatch: ", NULL); + } + Tcl_Close(interp, chan); + return 0; + } + pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) ); + pInfo->chan = chan; + Tcl_CreateExitHandler(vfsExit, pInfo); + pInfo->isCompressed = INT16(zBuf, 8); + if( pInfo->isCompressed ){ + z_stream *stream = &pInfo->stream; + pInfo->zBuf = Tcl_Alloc(COMPR_BUF_SIZE); + stream->zalloc = (alloc_func)0; + stream->zfree = (free_func)0; + stream->opaque = (voidpf)0; + stream->avail_in = 2; + stream->next_in = pInfo->zBuf; + pInfo->zBuf[0] = 0x78; + pInfo->zBuf[1] = 0x01; + inflateInit(&pInfo->stream); + }else{ + pInfo->zBuf = 0; + } + pInfo->nByte = INT32(zBuf,22); + pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18); + pInfo->readSoFar = 0; + Tcl_Seek(chan, INT16(zBuf,26)+INT16(zBuf,28), SEEK_CUR); + pInfo->startOfData = Tcl_Tell(chan); + sprintf(zName,"vfs_%x_%x",((int)pFile)>>12,count++); + chan = Tcl_CreateChannel(&vfsChannelType, zName, + (ClientData)pInfo, TCL_READABLE); + return chan; +} + +/* +** This routine does a stat() system call for a ZVFS file. +*/ +static int ZvfsFileStat(char *path, struct stat *buf){ + ZvfsFile *pFile; + + pFile = ZvfsLookup(path); + if( pFile==0 ){ + return -1; + } + memset(buf, 0, sizeof(*buf)); + if (pFile->isdir) + buf->st_mode = 040555; + else + buf->st_mode = (0100000|pFile->permissions); + buf->st_ino = 0; + buf->st_size = pFile->nByte; + buf->st_mtime = pFile->timestamp; + buf->st_ctime = pFile->timestamp; + buf->st_atime = pFile->timestamp; + return 0; +} + +/* +** This routine does an access() system call for a ZVFS file. +*/ +static int ZvfsFileAccess(char *path, int mode){ + ZvfsFile *pFile; + + if( mode & 3 ){ + return -1; + } + pFile = ZvfsLookup(path); + if( pFile==0 ){ + return -1; + } + return 0; +} + +#ifndef USE_TCL_VFS + +/* +** This TCL procedure can be used to copy a file. The built-in +** "file copy" command of TCL bypasses the I/O system and does not +** work with zvfs. You have to use a procedure like the following +** instead. +*/ +static char zFileCopy[] = +"proc zvfs::filecopy {from to {outtype binary}} {\n" +" set f [open $from r]\n" +" if {[catch {\n" +" fconfigure $f -translation binary\n" +" set t [open $to w]\n" +" } msg]} {\n" +" close $f\n" +" error $msg\n" +" }\n" +" if {[catch {\n" +" fconfigure $t -translation $outtype\n" +" set size [file size $from]\n" +" for {set i 0} {$i<$size} {incr i 40960} {\n" +" puts -nonewline $t [read $f 40960]\n" +" }\n" +" } msg]} {\n" +" close $f\n" +" close $t\n" +" error $msg\n" +" }\n" +" close $f\n" +" close $t\n" +"}\n" +; + +#else + +Tcl_Channel Tobe_FSOpenFileChannelProc + _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode, int permissions)) { + static int inopen=0; + Tcl_Channel chan; + if (inopen) { + puts("recursive zvfs open"); + return NULL; + } + inopen = 1; + /* if (mode != O_RDONLY) return NULL; */ + chan = ZvfsFileOpen(interp, Tcl_GetString(pathPtr), 0, + permissions); + inopen = 0; + return chan; +} + +/* +** This routine does a stat() system call for a ZVFS file. +*/ +int Tobe_FSStatProc _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)) { + + return ZvfsFileStat(Tcl_GetString(pathPtr), buf); +} + +/* +** This routine does an access() system call for a ZVFS file. +*/ +int Tobe_FSAccessProc _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)) { + return ZvfsFileAccess(Tcl_GetString(pathPtr), mode); +} + + +/* Tcl_Obj* Tobe_FSFilesystemSeparatorProc + _ANSI_ARGS_((Tcl_Obj *pathPtr)) { + return Tcl_NewStringObj("/",-1);; +} */ +/* Function to process a +* 'Tobe_FSMatchInDirectory()'. If not +* implemented, then glob and recursive +* copy functionality will be lacking in +* the filesystem. */ +int Tobe_FSMatchInDirectoryProc _ANSI_ARGS_((Tcl_Interp* interp, + Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, + Tcl_GlobTypeData * types)) { + Tcl_HashEntry *pEntry; + Tcl_HashSearch sSearch; + int scnt, len, l, dirglob, dirmnt; + char *zPattern = NULL, *zp=Tcl_GetStringFromObj(pathPtr,&len);; + if (!zp) return TCL_ERROR; + if (pattern != NULL) { + l=strlen(pattern); + if (!zp) + zPattern=strdup(pattern); + else { + zPattern=(char*)malloc(len+l+3); + sprintf(zPattern,"%s%s%s", zp, zp[len-1]=='/'?"":"/",pattern); + } + scnt=strchrcnt(zPattern,'/'); + } + dirglob = (types && types->type && (types->type&TCL_GLOB_TYPE_DIR)); + dirmnt = (types && types->type && (types->type&TCL_GLOB_TYPE_MOUNT)); + if (strcmp(zp, "/") == 0 && strcmp(zPattern, ".*") == 0) { + } + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; + pEntry = Tcl_NextHashEntry(&sSearch) + ){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + if (zPattern != NULL) { + if( Tcl_StringCaseMatch(z, zPattern, 0) == 0 || + (scnt!=pFile->depth /* && !dirglob */ )) { // TODO: ??? + continue; + } + } else { + if (strcmp(zp, z)) + continue; + } + if (dirmnt) { + if (pFile->isdir != 1) + continue; + } else if (dirglob) { + if (!pFile->isdir) + continue; + } else if (types && !(types->type&TCL_GLOB_TYPE_DIR)) { + if (pFile->isdir) + continue; + } + Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z, -1)); + } + if (zPattern) + free(zPattern); + return TCL_OK; +} + +/* Function to check whether a path is in +* this filesystem. This is the most +* important filesystem procedure. */ +int Tobe_FSPathInFilesystemProc _ANSI_ARGS_((Tcl_Obj *pathPtr, + ClientData *clientDataPtr)) { + ZvfsFile *zFile; + char *path=Tcl_GetString(pathPtr); +// if (ZvfsLookupMount(path)!=0) +// return TCL_OK; + // TODO: also check this is the archive. + if (openarch) + return -1; + zFile = ZvfsLookup(path); + if (zFile!=NULL && strcmp(path,zFile->pArchive->zName)) + return TCL_OK; + return -1; +} + +Tcl_Obj *Tobe_FSListVolumesProc _ANSI_ARGS_((void)) { + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_Obj *pVols=NULL, *pVol; + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + if (!pVols) { + pVols=Tcl_NewListObj(0,0); + Tcl_IncrRefCount(pVols); + } + pVol=Tcl_NewStringObj(pArchive->zMountPoint,-1); + Tcl_IncrRefCount(pVol); + Tcl_ListObjAppendElement(NULL, pVols,pVol); + Tcl_DecrRefCount(pVol); + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + return pVols; +} + +int Tobe_FSChdirProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { + /* Someday, we should actually check if this is a valid path. */ + return TCL_OK; +} + +CONST char** Tobe_FSFileAttrStringsProc _ANSI_ARGS_((Tcl_Obj *pathPtr, + Tcl_Obj** objPtrRef)) { + Tcl_Obj *listPtr; + Tcl_Interp *interp = NULL; + char *path=Tcl_GetString(pathPtr); +#ifdef __WIN32__ + static CONST char *attrs[] = { "-archive", "-hidden", "-readonly", "-system", "-shortname", 0 }; +#else + static CONST char *attrs[] = { "-group", "-owner", "-permissions", 0 }; +#endif + if (ZvfsLookup(path)==0) + return NULL; + return attrs; +} + +int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((Tcl_Interp *interp, + int index, Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef)) { + + char *path=Tcl_GetString(pathPtr); + char buf[50]; + ZvfsFile *zFile; + if ((zFile = ZvfsLookup(path))==0) + return TCL_ERROR; + + switch (index) { +#ifdef __WIN32__ + + case 0: /* -archive */ + *objPtrRef = Tcl_NewStringObj("0", -1); break; + case 1: /* -hidden */ + *objPtrRef = Tcl_NewStringObj("0", -1); break; + case 2: /* -readonly */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 3: /* -system */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 4: /* -shortname */ + *objPtrRef = Tcl_NewStringObj("", -1); +#else + case 0: /* -group */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 1: /* -owner */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 2: /* -permissions */ + sprintf(buf, "%03o", zFile->permissions); + *objPtrRef = Tcl_NewStringObj(buf, -1); break; +#endif + } + + return TCL_OK; +} + +/****************************************************/ + +// At some point, some of the following might get implemented? + +#if 1 +#define Tobe_FSFilesystemSeparatorProc 0 +#define Tobe_FSLoadFileProc 0 +#define Tobe_FSUnloadFileProc 0 +#define Tobe_FSGetCwdProc 0 +#define Tobe_FSGetCwdProc 0 +#define Tobe_FSCreateDirectoryProc 0 +#define Tobe_FSDeleteFileProc 0 +#define Tobe_FSCopyDirectoryProc 0 +#define Tobe_FSCopyFileProc 0 +#define Tobe_FSRemoveDirectoryProc 0 +#define Tobe_FSFileAttrsSetProc 0 +#define Tobe_FSNormalizePathProc 0 +#define Tobe_FSUtimeProc 0 +#define Tobe_FSRenameFileProc 0 +#define Tobe_FSCreateInternalRepProc 0 +#define Tobe_FSInternalToNormalizedProc 0 +#define Tobe_FSDupInternalRepProc 0 +#define Tobe_FSFreeInternalRepProc 0 +#define Tobe_FSFilesystemPathTypeProc 0 +#define Tobe_FSLinkProc 0 +#else + +/* Function to process a +* 'Tobe_FSLoadFile()' call. If not +* implemented, Tcl will fall back on +* a copy to native-temp followed by a +* Tobe_FSLoadFile on that temporary copy. */ +int Tobe_FSLoadFileProc _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Obj *pathPtr, char * sym1, char * sym2, + Tcl_PackageInitProc ** proc1Ptr, + Tcl_PackageInitProc ** proc2Ptr, + ClientData * clientDataPtr)) { return 0; } + + +/* Function to unload a previously +* successfully loaded file. If load was +* implemented, then this should also be +* implemented, if there is any cleanup +* action required. */ +void Tobe_FSUnloadFileProc _ANSI_ARGS_((ClientData clientData)) { + return; +} + +Tcl_Obj* Tobe_FSGetCwdProc _ANSI_ARGS_((Tcl_Interp *interp)) { return 0; } +int Tobe_FSCreateDirectoryProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } +int Tobe_FSDeleteFileProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } +int Tobe_FSCopyDirectoryProc _ANSI_ARGS_((Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)) { return 0; } +int Tobe_FSCopyFileProc _ANSI_ARGS_((Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr)) { return 0; } +int Tobe_FSRemoveDirectoryProc _ANSI_ARGS_((Tcl_Obj *pathPtr, + int recursive, Tcl_Obj **errorPtr)) { return 0; } +int Tobe_FSRenameFileProc _ANSI_ARGS_((Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr)) { return 0; } +/* We have to declare the utime structure here. */ +int Tobe_FSUtimeProc _ANSI_ARGS_((Tcl_Obj *pathPtr, + struct utimbuf *tval)) { return 0; } +int Tobe_FSNormalizePathProc _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *pathPtr, int nextCheckpoint)) { return 0; } +int Tobe_FSFileAttrsSetProc _ANSI_ARGS_((Tcl_Interp *interp, + int index, Tcl_Obj *pathPtr, + Tcl_Obj *objPtr)) { return 0; } +Tcl_Obj* Tobe_FSLinkProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } +Tcl_Obj* Tobe_FSFilesystemPathTypeProc + _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } +void Tobe_FSFreeInternalRepProc _ANSI_ARGS_((ClientData clientData)) { return; } +ClientData Tobe_FSDupInternalRepProc + _ANSI_ARGS_((ClientData clientData)) { return 0; } +Tcl_Obj* Tobe_FSInternalToNormalizedProc + _ANSI_ARGS_((ClientData clientData)) { return 0; } +ClientData Tobe_FSCreateInternalRepProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { + return 0; +} + +#endif + + +static Tcl_Filesystem Tobe_Filesystem = { + "tobe", /* The name of the filesystem. */ + sizeof(Tcl_Filesystem), /* Length of this structure, so future + * binary compatibility can be assured. */ + TCL_FILESYSTEM_VERSION_1, + /* Version of the filesystem type. */ + Tobe_FSPathInFilesystemProc, + /* Function to check whether a path is in + * this filesystem. This is the most + * important filesystem procedure. */ + Tobe_FSDupInternalRepProc, + /* Function to duplicate internal fs rep. May + * be NULL (but then fs is less efficient). */ + Tobe_FSFreeInternalRepProc, + /* Function to free internal fs rep. Must + * be implemented, if internal representations + * need freeing, otherwise it can be NULL. */ + Tobe_FSInternalToNormalizedProc, + /* Function to convert internal representation + * to a normalized path. Only required if + * the fs creates pure path objects with no + * string/path representation. */ + Tobe_FSCreateInternalRepProc, + /* Function to create a filesystem-specific + * internal representation. May be NULL + * if paths have no internal representation, + * or if the Tobe_FSPathInFilesystemProc + * for this filesystem always immediately + * creates an internal representation for + * paths it accepts. */ + Tobe_FSNormalizePathProc, + /* Function to normalize a path. Should + * be implemented for all filesystems + * which can have multiple string + * representations for the same path + * object. */ + Tobe_FSFilesystemPathTypeProc, + /* Function to determine the type of a + * path in this filesystem. May be NULL. */ + Tobe_FSFilesystemSeparatorProc, + /* Function to return the separator + * character(s) for this filesystem. Must + * be implemented. */ + Tobe_FSStatProc, + /* + * Function to process a 'Tobe_FSStat()' + * call. Must be implemented for any + * reasonable filesystem. + */ + Tobe_FSAccessProc, + /* + * Function to process a 'Tobe_FSAccess()' + * call. Must be implemented for any + * reasonable filesystem. + */ + Tobe_FSOpenFileChannelProc, + /* + * Function to process a + * 'Tobe_FSOpenFileChannel()' call. Must be + * implemented for any reasonable + * filesystem. + */ + Tobe_FSMatchInDirectoryProc, + /* Function to process a + * 'Tobe_FSMatchInDirectory()'. If not + * implemented, then glob and recursive + * copy functionality will be lacking in + * the filesystem. */ + Tobe_FSUtimeProc, + /* Function to process a + * 'Tobe_FSUtime()' call. Required to + * allow setting (not reading) of times + * with 'file mtime', 'file atime' and + * the open-r/open-w/fcopy implementation + * of 'file copy'. */ + Tobe_FSLinkProc, + /* Function to process a + * 'Tobe_FSLink()' call. Should be + * implemented only if the filesystem supports + * links. */ + Tobe_FSListVolumesProc, + /* Function to list any filesystem volumes + * added by this filesystem. Should be + * implemented only if the filesystem adds + * volumes at the head of the filesystem. */ + Tobe_FSFileAttrStringsProc, + /* Function to list all attributes strings + * which are valid for this filesystem. + * If not implemented the filesystem will + * not support the 'file attributes' command. + * This allows arbitrary additional information + * to be attached to files in the filesystem. */ + Tobe_FSFileAttrsGetProc, + /* Function to process a + * 'Tobe_FSFileAttrsGet()' call, used by + * 'file attributes'. */ + Tobe_FSFileAttrsSetProc, + /* Function to process a + * 'Tobe_FSFileAttrsSet()' call, used by + * 'file attributes'. */ + Tobe_FSCreateDirectoryProc, + /* Function to process a + * 'Tobe_FSCreateDirectory()' call. Should + * be implemented unless the FS is + * read-only. */ + Tobe_FSRemoveDirectoryProc, + /* Function to process a + * 'Tobe_FSRemoveDirectory()' call. Should + * be implemented unless the FS is + * read-only. */ + Tobe_FSDeleteFileProc, + /* Function to process a + * 'Tobe_FSDeleteFile()' call. Should + * be implemented unless the FS is + * read-only. */ + Tobe_FSCopyFileProc, + /* Function to process a + * 'Tobe_FSCopyFile()' call. If not + * implemented Tcl will fall back + * on open-r, open-w and fcopy as + * a copying mechanism. */ + Tobe_FSRenameFileProc, + /* Function to process a + * 'Tobe_FSRenameFile()' call. If not + * implemented, Tcl will fall back on + * a copy and delete mechanism. */ + Tobe_FSCopyDirectoryProc, + /* Function to process a + * 'Tobe_FSCopyDirectory()' call. If + * not implemented, Tcl will fall back + * on a recursive create-dir, file copy + * mechanism. */ + Tobe_FSLoadFileProc, + /* Function to process a + * 'Tobe_FSLoadFile()' call. If not + * implemented, Tcl will fall back on + * a copy to native-temp followed by a + * Tobe_FSLoadFile on that temporary copy. */ + Tobe_FSUnloadFileProc, + /* Function to unload a previously + * successfully loaded file. If load was + * implemented, then this should also be + * implemented, if there is any cleanup + * action required. */ + Tobe_FSGetCwdProc, + /* + * Function to process a 'Tobe_FSGetCwd()' + * call. Most filesystems need not + * implement this. It will usually only be + * called once, if 'getcwd' is called + * before 'chdir'. May be NULL. + */ + Tobe_FSChdirProc, + /* + * Function to process a 'Tobe_FSChdir()' + * call. If filesystems do not implement + * this, it will be emulated by a series of + * directory access checks. Otherwise, + * virtual filesystems which do implement + * it need only respond with a positive + * return result if the dirName is a valid + * directory in their filesystem. They + * need not remember the result, since that + * will be automatically remembered for use + * by GetCwd. Real filesystems should + * carry out the correct action (i.e. call + * the correct system 'chdir' api). If not + * implemented, then 'cd' and 'pwd' will + * fail inside the filesystem. + */ +}; + +#endif + +////////////////////////////////////////////////////////////// + +void (*Zvfs_PostInit)(Tcl_Interp *)=0; +static int ZvfsAppendObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int ZvfsAddObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int ZvfsDumpObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int ZvfsStartObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); + +/* +** Initialize the ZVFS system. +*/ +int Zvfs_doInit(Tcl_Interp *interp, int safe){ + int n; +#ifdef USE_TCL_STUBS + if( Tcl_InitStubs(interp,"8.0",0)==0 ){ + return TCL_ERROR; + } +#endif + Tcl_StaticPackage(interp, "zvfs", Tcl_Zvfs_Init, Tcl_Zvfs_SafeInit); + if (!safe) { + Tcl_CreateCommand(interp, "zvfs::mount", ZvfsMountCmd, 0, 0); + Tcl_CreateCommand(interp, "zvfs::unmount", ZvfsUnmountCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::append", ZvfsAppendObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::add", ZvfsAddObjCmd, 0, 0); + } + Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::dump", ZvfsDumpObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::start", ZvfsStartObjCmd, 0, 0); + Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); +/* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ +#ifndef USE_TCL_VFS + Tcl_GlobalEval(interp, zFileCopy); +#endif + if( !local.isInit ){ + /* One-time initialization of the ZVFS */ +#ifdef USE_TCL_VFS + n = Tcl_FSRegister(0, &Tobe_Filesystem); +#else + extern void TclAccessInsertProc(); + extern void TclStatInsertProc(); + extern void TclOpenFileChannelInsertProc(); + TclAccessInsertProc(ZvfsFileAccess); + TclStatInsertProc(ZvfsFileStat); + TclOpenFileChannelInsertProc(ZvfsFileOpen); +#endif + Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); + local.isInit = 1; + } + if (Zvfs_PostInit) Zvfs_PostInit(interp); + return TCL_OK; +} + +int Tcl_Zvfs_Init(Tcl_Interp *interp){ + return Zvfs_doInit(interp,0); +} + +int Tcl_Zvfs_SafeInit(Tcl_Interp *interp){ + return Zvfs_doInit(interp,1); +} + + +/************************************************************************/ +/************************************************************************/ +/************************************************************************/ + +/* +** Implement the zvfs::dump command +** +** zvfs::dump ARCHIVE +** +** Each entry in the list returned is of the following form: +** +** {FILENAME DATE-TIME SPECIAL-FLAG OFFSET SIZE COMPRESSED-SIZE} +** +*/ +static int ZvfsDumpObjCmd( + void *NotUsed, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv /* Values of all arguments */ +){ + char *zFilename; + Tcl_Channel chan; + ZFile *pList; + int rc; + Tcl_Obj *pResult; + + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); + return TCL_ERROR; + } + zFilename = Tcl_GetString(objv[1]); + chan = Tcl_OpenFileChannel(interp, zFilename, "r", 0); + if( chan==0 ) return TCL_ERROR; + rc = ZvfsReadTOC(interp, chan, &pList); + if( rc==TCL_ERROR ){ + deleteZFileList(pList); + return rc; + } + Tcl_Close(interp, chan); + pResult = Tcl_GetObjResult(interp); + while( pList ){ + Tcl_Obj *pEntry = Tcl_NewObj(); + ZFile *pNext; + char zDateTime[100]; + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewStringObj(pList->zName,-1)); + translateDosTimeDate(zDateTime, pList->dosDate, pList->dosTime); + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewStringObj(zDateTime, -1)); + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->isSpecial)); + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->iOffset)); + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByte)); + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByteCompr)); + Tcl_ListObjAppendElement(interp, pResult, pEntry); + pNext = pList->pNext; + Tcl_Free((char*)pList); + pList = pList->pNext; + } + return TCL_OK; +} + +/* +** Write a file record into a ZIP archive at the current position of +** the write cursor for channel "chan". Add a ZFile record for the file +** to *ppList. If an error occurs, leave an error message on interp +** and return TCL_ERROR. Otherwise return TCL_OK. +*/ +static int writeFile( + Tcl_Interp *interp, /* Leave an error message here */ + Tcl_Channel out, /* Write the file here */ + Tcl_Channel in, /* Read data from this file */ + char *zSrc, /* Name the new ZIP file entry this */ + char *zDest, /* Name the new ZIP file entry this */ + ZFile **ppList /* Put a ZFile struct for the new file here */ +){ + z_stream stream; + ZFile *p; + int iEndOfData; + int nameLen; + int skip; + int toOut; + char zHdr[30]; + char zInBuf[100000]; + char zOutBuf[100000]; + struct tm *tm; + time_t now; + struct stat stat; + + /* Create a new ZFile structure for this file. + * TODO: fill in date/time etc. + */ + nameLen = strlen(zDest); + p = newZFile(nameLen, ppList); + strcpy(p->zName, zDest); + p->isSpecial = 0; + Tcl_Stat(zSrc, &stat); + now=stat.st_mtime; + tm = localtime(&now); + UnixTimeDate(tm, &p->dosDate, &p->dosTime); + p->iOffset = Tcl_Tell(out); + p->nByte = 0; + p->nByteCompr = 0; + p->nExtra = 0; + p->iCRC = 0; + p->permissions = stat.st_mode; + + /* Fill in as much of the header as we know. + */ + put32(&zHdr[0], 0x04034b50); + put16(&zHdr[4], 0x0014); + put16(&zHdr[6], 0); + put16(&zHdr[8], 8); + put16(&zHdr[10], p->dosTime); + put16(&zHdr[12], p->dosDate); + put16(&zHdr[26], nameLen); + put16(&zHdr[28], 0); + + /* Write the header and filename. + */ + Tcl_Write(out, zHdr, 30); + Tcl_Write(out, zDest, nameLen); + + /* The first two bytes that come out of the deflate compressor are + ** some kind of header that ZIP does not use. So skip the first two + ** output bytes. + */ + skip = 2; + + /* Write the compressed file. Compute the CRC as we progress. + */ + stream.zalloc = (alloc_func)0; + stream.zfree = (free_func)0; + stream.opaque = 0; + stream.avail_in = 0; + stream.next_in = zInBuf; + stream.avail_out = sizeof(zOutBuf); + stream.next_out = zOutBuf; +#if 1 + deflateInit(&stream, 9); +#else + { + int i, err, WSIZE = 0x8000, windowBits, level=6; + for (i = ((unsigned)WSIZE), windowBits = 0; i != 1; i >>= 1, ++windowBits); + err = deflateInit2(&stream, level, Z_DEFLATED, -windowBits, 8, 0); + + } +#endif + p->iCRC = crc32(0, 0, 0); + while( !Tcl_Eof(in) ){ + if( stream.avail_in==0 ){ + int amt = Tcl_Read(in, zInBuf, sizeof(zInBuf)); + if( amt<=0 ) break; + p->iCRC = crc32(p->iCRC, zInBuf, amt); + stream.avail_in = amt; + stream.next_in = zInBuf; + } + deflate(&stream, 0); + toOut = sizeof(zOutBuf) - stream.avail_out; + if( toOut>skip ){ + Tcl_Write(out, &zOutBuf[skip], toOut - skip); + skip = 0; + }else{ + skip -= toOut; + } + stream.avail_out = sizeof(zOutBuf); + stream.next_out = zOutBuf; + } + do{ + stream.avail_out = sizeof(zOutBuf); + stream.next_out = zOutBuf; + deflate(&stream, Z_FINISH); + toOut = sizeof(zOutBuf) - stream.avail_out; + if( toOut>skip ){ + Tcl_Write(out, &zOutBuf[skip], toOut - skip); + skip = 0; + }else{ + skip -= toOut; + } + }while( stream.avail_out==0 ); + p->nByte = stream.total_in; + p->nByteCompr = stream.total_out - 2; + deflateEnd(&stream); + Tcl_Flush(out); + + /* Remember were we are in the file. Then go back and write the + ** header, now that we know the compressed file size. + */ + iEndOfData = Tcl_Tell(out); + Tcl_Seek(out, p->iOffset, SEEK_SET); + put32(&zHdr[14], p->iCRC); + put32(&zHdr[18], p->nByteCompr); + put32(&zHdr[22], p->nByte); + Tcl_Write(out, zHdr, 30); + Tcl_Seek(out, iEndOfData, SEEK_SET); + + /* Close the input file. + */ + Tcl_Close(interp, in); + + /* Finished! + */ + return TCL_OK; +} + +/* +** The arguments are two lists of ZFile structures sorted by iOffset. +** Either or both list may be empty. This routine merges the two +** lists together into a single sorted list and returns a pointer +** to the head of the unified list. +** +** This is part of the merge-sort algorithm. +*/ +static ZFile *mergeZFiles(ZFile *pLeft, ZFile *pRight){ + ZFile fakeHead; + ZFile *pTail; + + pTail = &fakeHead; + while( pLeft && pRight ){ + ZFile *p; + if( pLeft->iOffset <= pRight->iOffset ){ + p = pLeft; + pLeft = p->pNext; + }else{ + p = pRight; + pRight = p->pNext; + } + pTail->pNext = p; + pTail = p; + } + if( pLeft ){ + pTail->pNext = pLeft; + }else if( pRight ){ + pTail->pNext = pRight; + }else{ + pTail->pNext = 0; + } + return fakeHead.pNext; +} + +/* +** Sort a ZFile list so in accending order by iOffset. +*/ +static ZFile *sortZFiles(ZFile *pList){ +# define NBIN 30 + int i; + ZFile *p; + ZFile *aBin[NBIN+1]; + + for(i=0; i<=NBIN; i++) aBin[i] = 0; + while( pList ){ + p = pList; + pList = p->pNext; + p->pNext = 0; + for(i=0; ipNext){ + if( pList->isSpecial ) continue; + put32(&zBuf[0], 0x02014b50); + put16(&zBuf[4], 0x0317); + put16(&zBuf[6], 0x0014); + put16(&zBuf[8], 0); + put16(&zBuf[10], pList->nByte>pList->nByteCompr ? 0x0008 : 0x0000); + put16(&zBuf[12], pList->dosTime); + put16(&zBuf[14], pList->dosDate); + put32(&zBuf[16], pList->iCRC); + put32(&zBuf[20], pList->nByteCompr); + put32(&zBuf[24], pList->nByte); + put16(&zBuf[28], strlen(pList->zName)); + put16(&zBuf[30], 0); + put16(&zBuf[32], pList->nExtra); + put16(&zBuf[34], 1); + put16(&zBuf[36], 0); + put32(&zBuf[38], pList->permissions<<16); + put32(&zBuf[42], pList->iOffset); + Tcl_Write(chan, zBuf, 46); + Tcl_Write(chan, pList->zName, strlen(pList->zName)); + for(i=pList->nExtra; i>0; i-=40){ + int toWrite = i<40 ? i : 40; + Tcl_Write(chan," ",toWrite); + } + nEntry++; + } + iTocEnd = Tcl_Tell(chan); + put32(&zBuf[0], 0x06054b50); + put16(&zBuf[4], 0); + put16(&zBuf[6], 0); + put16(&zBuf[8], nEntry); + put16(&zBuf[10], nEntry); + put32(&zBuf[12], iTocEnd - iTocStart); + put32(&zBuf[16], iTocStart); + put16(&zBuf[20], 0); + Tcl_Write(chan, zBuf, 22); + Tcl_Flush(chan); +} + + +/* +** Implementation of the zvfs::append command. +** +** zvfs::append ARCHIVE (SOURCE DESTINATION)* +** +** This command reads SOURCE files and appends them (using the name +** DESTINATION) to the zip archive named ARCHIVE. A new zip archive +** is created if it does not already exist. If ARCHIVE refers to a +** file which exists but is not a zip archive, then this command +** turns ARCHIVE into a zip archive by appending the necessary +** records and the table of contents. Treat all files as binary. +** +** Note: No dup checking is done, so multiple occurances of the +** same file is allowed. +*/ +static int ZvfsAppendObjCmd( + void *NotUsed, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv /* Values of all arguments */ +){ + char *zArchive; + Tcl_Channel chan; + ZFile *pList = NULL, *pToc; + int rc = TCL_OK, i; + + /* Open the archive and read the table of contents + */ + if( objc<2 || (objc&1)!=0 ){ + Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE (SRC DEST)+"); + return TCL_ERROR; + } + + zArchive = Tcl_GetString(objv[1]); + chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); + if( chan==0 ) { + chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); + } + if( chan==0 ) return TCL_ERROR; + if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") + || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") + ){ + /* this should never happen */ + Tcl_Close(0, chan); + return TCL_ERROR; + } + + if (Tcl_Seek(chan, 0, SEEK_END) == 0) { + /* Null file is ok, we're creating new one. */ + } else { + Tcl_Seek(chan, 0, SEEK_SET); + rc = ZvfsReadTOC(interp, chan, &pList); + if( rc==TCL_ERROR ){ + deleteZFileList(pList); + Tcl_Close(interp, chan); + return rc; + } else rc=TCL_OK; + } + + /* Move the file pointer to the start of + ** the table of contents. + */ + for(pToc=pList; pToc; pToc=pToc->pNext){ + if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) break; + } + if( pToc ){ + Tcl_Seek(chan, pToc->iOffset, SEEK_SET); + }else{ + Tcl_Seek(chan, 0, SEEK_END); + } + + /* Add new files to the end of the archive. + */ + for(i=2; rc==TCL_OK && i p)) { + p = NULL; + } + return p; +} + +/* +** Implementation of the zvfs::add command. +** +** zvfs::add ?-fconfigure optpairs? ARCHIVE FILE1 FILE2 ... +** +** This command is similar to append in that it adds files to the zip +** archive named ARCHIVE, however file names are relative the current directory. +** In addition, fconfigure is used to apply option pairs to set upon opening +** of each file. Otherwise, default translation is allowed +** for those file extensions listed in the ::zvfs::auto_ext var. +** Binary translation will be used for unknown extensions. +** +** NOTE Use '-fconfigure {}' to use auto translation for all. +*/ +static int ZvfsAddObjCmd( + void *NotUsed, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *CONST* objv /* Values of all arguments */ +){ + char *zArchive; + Tcl_Channel chan; + ZFile *pList = NULL, *pToc; + int rc = TCL_OK, i, j, oLen; + char *zOpts = NULL; + Tcl_Obj *confOpts = NULL; + int tobjc; + Tcl_Obj **tobjv; + Tcl_Obj *varObj = NULL; + + /* Open the archive and read the table of contents + */ + if (objc>3) { + zOpts = Tcl_GetStringFromObj(objv[1], &oLen); + if (!strncmp("-fconfigure", zOpts, oLen)) { + confOpts = objv[2]; + if (TCL_OK != Tcl_ListObjGetElements(interp, confOpts, &tobjc, &tobjv) || (tobjc%2)) { + return TCL_ERROR; + } + objc -= 2; + objv += 2; + } + } + if( objc==2) { + return TCL_OK; + } + + if( objc<3) { + Tcl_WrongNumArgs(interp, 1, objv, "?-fconfigure OPTPAIRS? ARCHIVE FILE1 FILE2 .."); + return TCL_ERROR; + } + zArchive = Tcl_GetString(objv[1]); + chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); + if( chan==0 ) { + chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); + } + if( chan==0 ) return TCL_ERROR; + if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") + || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") + ){ + /* this should never happen */ + Tcl_Close(0, chan); + return TCL_ERROR; + } + + if (Tcl_Seek(chan, 0, SEEK_END) == 0) { + /* Null file is ok, we're creating new one. */ + } else { + Tcl_Seek(chan, 0, SEEK_SET); + rc = ZvfsReadTOC(interp, chan, &pList); + if( rc==TCL_ERROR ){ + deleteZFileList(pList); + Tcl_Close(interp, chan); + return rc; + } else rc=TCL_OK; + } + + /* Move the file pointer to the start of + ** the table of contents. + */ + for(pToc=pList; pToc; pToc=pToc->pNext){ + if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) break; + } + if( pToc ){ + Tcl_Seek(chan, pToc->iOffset, SEEK_SET); + }else{ + Tcl_Seek(chan, 0, SEEK_END); + } + + /* Add new files to the end of the archive. + */ + for(i=2; rc==TCL_OK && i=tobjc) { + ext = NULL; + } + + } + } + if (ext == NULL) { + if (( Tcl_SetChannelOption(interp, in, "-translation", "binary") + || Tcl_SetChannelOption(interp, in, "-encoding", "binary")) + ) { + /* this should never happen */ + Tcl_Close(0, in); + rc = TCL_ERROR; + break; + } + } + } else { + for (j=0; j> ${TCLKIT_EXE} + # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above ${NATIVE_TCLSH}: @@ -1319,6 +1329,9 @@ tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c tclVar.o: $(GENERIC_DIR)/tclVar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c +tclZipVfs.o: $(GENERIC_DIR)/tclZipVfs.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclZipVfs.c + tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 9bbc88b..cdfff59 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -15,7 +15,7 @@ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" - +#include "tclInt.h" #ifdef TCL_TEST extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; @@ -108,6 +108,29 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { + CONST char *cp=Tcl_GetNameOfExecutable(); + /* We have to initialize the virtual filesystem before calling + ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find + ** its startup script files. + */ + Tcl_Zvfs_Init(interp); + if(!Tcl_Zvfs_Mount(interp, cp, "/zvfs")) { + Tcl_Obj *vfsinitscript=Tcl_NewStringObj("/zvfs/main.tcl",-1); + Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1); + + Tcl_IncrRefCount(vfsinitscript); + Tcl_IncrRefCount(vfstcllib); + + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + Tcl_SetStartupScript(vfsinitscript,NULL); + } + if(Tcl_FSAccess(vfstcllib,F_OK)==0) { + Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY); + } + Tcl_DecrRefCount(vfsinitscript); + Tcl_DecrRefCount(vfstcllib); + } + if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } @@ -124,7 +147,7 @@ Tcl_AppInit( } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ - + /* * Call the init procedures for included packages. Each call should look * like this: diff --git a/win/Makefile.in b/win/Makefile.in index 150f5b8..b883e8a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -145,6 +145,7 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} +TCLKIT = tclkit$(VER)${EXESUFFIX} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -294,7 +295,8 @@ GENERIC_OBJS = \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ - tclZlib.$(OBJEXT) + tclZlib.$(OBJEXT) \ + tclZipVfs.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -422,6 +424,15 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ +$(TCLKIT): $(TCLSH_OBJS) @LIBRARIES@ ${TCL_OBJS} tclsh.$(RES) + $(CC) $(CFLAGS) ${TCL_OBJS} $(TCLSH_OBJS) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + PWD=`pwd` + rm -f tclkit.zip + cp $(TCLSH) $(TCLKIT) + cd $(SCRIPT_INSTALL_DIR) ; zip -rAq ${PWD}/tclkit.zip tcl8 tcl8.6 + $(CAT32) tclkit.zip >> $(TCLKIT) + cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) diff --git a/win/makefile.bc b/win/makefile.bc index a962bc6..e005979 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -275,6 +275,7 @@ TCLOBJS = \ $(TMPDIR)\tclWinSock.obj \ $(TMPDIR)\tclWinThrd.obj \ $(TMPDIR)\tclWinTime.obj \ + $(TMP_DIR)\tclZipVfs.obj \ $(TMPDIR)\tclZlib.obj TCLSTUBOBJS = \ diff --git a/win/makefile.vc b/win/makefile.vc index e5f6c9b..43644cc 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -343,6 +343,7 @@ COREOBJS = \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ + $(TMP_DIR)\tclZipVfs.obj \ $(TMP_DIR)\tclZlib.obj ZLIBOBJS = \ @@ -931,6 +932,9 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? +$(TMP_DIR)\tclZipVfs.obj: $(GENERICDIR)\tclZipVfs.c + $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? + $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? diff --git a/win/tclAppInit.c b/win/tclAppInit.c index a6c1a67..3cfd662 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -15,6 +15,7 @@ */ #include "tcl.h" +#include "tclInt.h" #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN @@ -151,6 +152,27 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { + CONST char *cp=Tcl_GetNameOfExecutable(); + /* We have to initialize the virtual filesystem before calling + ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find + ** its startup script files. + */ + Tcl_Zvfs_Init(interp); + if(!Tcl_Zvfs_Mount(interp, cp, "/zvfs")) { + Tcl_Obj *vfsinitscript=Tcl_NewStringObj("/zvfs/main.tcl",-1); + Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1); + + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + Tcl_SetStartupScript(vfsinitscript,NULL); + } + //Tcl_DecrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfstcllib,F_OK)==0) { + Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY); + } + Tcl_DecrRefCount(vfstcllib); + } + if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } diff --git a/win/tclkit.exe.manifest.in b/win/tclkit.exe.manifest.in new file mode 100644 index 0000000..13c1d24 --- /dev/null +++ b/win/tclkit.exe.manifest.in @@ -0,0 +1,51 @@ + + + + Tcl self-contained executable (tclkit) + + + + + + + + + + + + + + + + + + + + + + true + + + + + + + + diff --git a/win/tclkit.rc b/win/tclkit.rc new file mode 100644 index 0000000..ebe37e1 --- /dev/null +++ b/win/tclkit.rc @@ -0,0 +1,82 @@ +// +// Version Resource Script +// + +#include +#include + +// +// build-up the name suffix that defines the type of build this is. +// +#if TCL_THREADS +#define SUFFIX_THREADS "t" +#else +#define SUFFIX_THREADS "" +#endif + +#if STATIC_BUILD +#define SUFFIX_STATIC "s" +#else +#define SUFFIX_STATIC "" +#endif + +#if DEBUG && !UNCHECKED +#define SUFFIX_DEBUG "g" +#else +#define SUFFIX_DEBUG "" +#endif + +#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG + + +LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ + +VS_VERSION_INFO VERSIONINFO + FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL + PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL + FILEFLAGSMASK 0x3fL +#ifdef DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_APP + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" + BEGIN + VALUE "FileDescription", "Tclkit Application\0" + VALUE "OriginalFilename", "tclkit" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" + VALUE "CompanyName", "ActiveState Corporation\0" + VALUE "FileVersion", TCL_PATCH_LEVEL + VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0" + VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" + VALUE "ProductVersion", TCL_PATCH_LEVEL + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END + +// +// Icon +// + +tclsh ICON DISCARDABLE "tclsh.ico" + +// +// This is needed for Windows 8.1 onwards. +// + +#ifndef RT_MANIFEST +#define RT_MANIFEST 24 +#endif +#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID +#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 +#endif +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclkit.exe.manifest" -- cgit v0.12 From eb664a3d72c2a03a6237b20db543d344517f3e83 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 1 Sep 2014 09:36:58 +0000 Subject: Tweak the Windows implementation of Tcl_AppInit() to match Unix --- win/tclAppInit.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 3cfd662..7edd455 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -163,13 +163,15 @@ Tcl_AppInit( Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1); Tcl_IncrRefCount(vfsinitscript); + Tcl_IncrRefCount(vfstcllib); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { Tcl_SetStartupScript(vfsinitscript,NULL); } - //Tcl_DecrRefCount(vfsinitscript); if(Tcl_FSAccess(vfstcllib,F_OK)==0) { Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY); } + Tcl_DecrRefCount(vfsinitscript); Tcl_DecrRefCount(vfstcllib); } -- cgit v0.12 From d1536b7378b5014b664c0b5c91919f9be5a4253f Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 1 Sep 2014 09:41:09 +0000 Subject: Tweaks to the Windows makefile. --- win/Makefile.in | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index b883e8a..07c8db1 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -424,14 +424,16 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -$(TCLKIT): $(TCLSH_OBJS) @LIBRARIES@ ${TCL_OBJS} tclsh.$(RES) +tclkit: $(TCLKIT) + +$(TCLKIT): $(TCLSH_OBJS) @LIBRARIES@ ${TCL_OBJS} $(CAT32) tclsh.$(RES) $(CC) $(CFLAGS) ${TCL_OBJS} $(TCLSH_OBJS) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) PWD=`pwd` rm -f tclkit.zip cp $(TCLSH) $(TCLKIT) - cd $(SCRIPT_INSTALL_DIR) ; zip -rAq ${PWD}/tclkit.zip tcl8 tcl8.6 - $(CAT32) tclkit.zip >> $(TCLKIT) + cd ${prefix}/lib ; zip -rq ${PWD}/tclkit.zip tcl8 tcl8.6 + cat tclkit.zip >> $(TCLKIT) cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -878,6 +880,6 @@ html-tk: $(TCLSH) .PHONY: install-doc install-private-headers test test-tcl runtest shell .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html -.PHONY: html-tcl html-tk +.PHONY: html-tcl html-tk tclkit # DO NOT DELETE THIS LINE -- make depend depends on it. -- cgit v0.12 From 78b3c04320aac05d5acdc2a424df7f898de7bc6a Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 1 Sep 2014 10:45:41 +0000 Subject: Bring the source more into line with Tcl style. --- generic/tclZipVfs.c | 4365 +++++++++++++++++++++++++++------------------------ 1 file changed, 2326 insertions(+), 2039 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index 0456b4a..a774648 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1,27 +1,25 @@ /* -** Copyright (c) 2000 D. Richard Hipp -** Copyright (c) 2007 PDQ Interfaces Inc. -** Copyright (c) 2013 Sean Woods -** -** This file is now released under the BSD style license -** outlined in the included file license.terms. -** -************************************************************************* -** A ZIP archive virtual filesystem for Tcl. -** -** This package of routines enables Tcl to use a Zip file as -** a virtual file system. Each of the content files of the Zip -** archive appears as a real file to Tcl. -** -** Well, almost... Actually, the virtual file system is limited -** in a number of ways. The only things you can do are "stat" -** and "read" file content files. You cannot use "cd". -** But it turns out that "stat" -** and "read" are sufficient for most purposes. -** -** This version has been modified to run under Tcl 8.6 -** -*/ + * Copyright (c) 2000 D. Richard Hipp + * Copyright (c) 2007 PDQ Interfaces Inc. + * Copyright (c) 2013 Sean Woods + * + * This file is now released under the BSD style license outlined in the + * included file license.terms. + * + ************************************************************************ + * A ZIP archive virtual filesystem for Tcl. + * + * This package of routines enables Tcl to use a Zip file as a virtual file + * system. Each of the content files of the Zip archive appears as a real + * file to Tcl. + * + * Well, almost... Actually, the virtual file system is limited in a number + * of ways. The only things you can do are "stat" and "read" file content + * files. You cannot use "cd". But it turns out that "stat" and "read" are + * sufficient for most purposes. + * + * This version has been modified to run under Tcl 8.6 + */ #include "tcl.h" #include #include @@ -35,1192 +33,1385 @@ #endif /* -** Size of the decompression input buffer -*/ -#define COMPR_BUF_SIZE 8192 + * Size of the decompression input buffer + */ +#define COMPR_BUF_SIZE 8192 static int maptolower=0; -static int openarch=0; /* Set to 1 when opening archive. */ +static int openarch=0; /* Set to 1 when opening archive. */ /* -** All static variables are collected into a structure named "local". -** That way, it is clear in the code when we are using a static -** variable because its name begins with "local.". -*/ + * All static variables are collected into a structure named "local". That + * way, it is clear in the code when we are using a static variable because + * its name begins with "local.". + */ static struct { - Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The - ** The key is the virtual filename. The data - ** an an instance of the ZvfsFile structure. */ - Tcl_HashTable archiveHash; /* One entry for each archive. Key is the name. - ** data is the ZvfsArchive structure */ - int isInit; /* True after initialization */ + Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The + * key is the virtual filename. The data is an + * instance of the ZvfsFile structure. */ + Tcl_HashTable archiveHash; /* One entry for each archive. Key is the + * name. The data is the ZvfsArchive + * structure. */ + int isInit; /* True after initialization */ } local; /* -** Each ZIP archive file that is mounted is recorded as an instance -** of this structure -*/ + * Each ZIP archive file that is mounted is recorded as an instance of this + * structure + */ typedef struct ZvfsArchive { - char *zName; /* Name of the archive */ - char *zMountPoint; /* Where this archive is mounted */ - struct ZvfsFile *pFiles; /* List of files in that archive */ + char *zName; /* Name of the archive */ + char *zMountPoint; /* Where this archive is mounted */ + struct ZvfsFile *pFiles; /* List of files in that archive */ } ZvfsArchive; /* -** Particulars about each virtual file are recorded in an instance -** of the following structure. -*/ + * Particulars about each virtual file are recorded in an instance of the + * following structure. + */ typedef struct ZvfsFile { - char *zName; /* The full pathname of the virtual file */ - ZvfsArchive *pArchive; /* The ZIP archive holding this file data */ - int iOffset; /* Offset into the ZIP archive of the data */ - int nByte; /* Uncompressed size of the virtual file */ - int nByteCompr; /* Compressed size of the virtual file */ - time_t timestamp; /* Modification time */ - int isdir; /* Set to 2 if directory, or 1 if mount */ - int depth; /* Number of slashes in path. */ - int permissions; /* File permissions. */ - struct ZvfsFile *pNext; /* Next file in the same archive */ - struct ZvfsFile *pNextName; /* A doubly-linked list of files with the same */ - struct ZvfsFile *pPrevName; /* name. Only the first is in local.fileHash */ + char *zName; /* The full pathname of the virtual file */ + ZvfsArchive *pArchive; /* The ZIP archive holding this file data */ + int iOffset; /* Offset into the ZIP archive of the data */ + int nByte; /* Uncompressed size of the virtual file */ + int nByteCompr; /* Compressed size of the virtual file */ + time_t timestamp; /* Modification time */ + int isdir; /* Set to 2 if directory, or 1 if mount */ + int depth; /* Number of slashes in path. */ + int permissions; /* File permissions. */ + struct ZvfsFile *pNext; /* Next file in the same archive */ + struct ZvfsFile *pNextName; /* A doubly-linked list of files with the + * _same_ name. Only the first is in + * local.fileHash */ + struct ZvfsFile *pPrevName; } ZvfsFile; /* -** Information about each file within a ZIP archive is stored in -** an instance of the following structure. A list of these structures -** forms a table of contents for the archive. -*/ + * Information about each file within a ZIP archive is stored in an instance + * of the following structure. A list of these structures forms a table of + * contents for the archive. + */ typedef struct ZFile ZFile; struct ZFile { - char *zName; /* Name of the file */ - int isSpecial; /* Not really a file in the ZIP archive */ - int dosTime; /* Modification time (DOS format) */ - int dosDate; /* Modification date (DOS format) */ - int iOffset; /* Offset into the ZIP archive of the data */ - int nByte; /* Uncompressed size of the virtual file */ - int nByteCompr; /* Compressed size of the virtual file */ - int nExtra; /* Extra space in the TOC header */ - int iCRC; /* Cyclic Redundancy Check of the data */ - int permissions; /* File permissions. */ - int flags; /* Deletion = bit 0. */ - ZFile *pNext; /* Next file in the same archive */ + char *zName; /* Name of the file */ + int isSpecial; /* Not really a file in the ZIP archive */ + int dosTime; /* Modification time (DOS format) */ + int dosDate; /* Modification date (DOS format) */ + int iOffset; /* Offset into the ZIP archive of the data */ + int nByte; /* Uncompressed size of the virtual file */ + int nByteCompr; /* Compressed size of the virtual file */ + int nExtra; /* Extra space in the TOC header */ + int iCRC; /* Cyclic Redundancy Check of the data */ + int permissions; /* File permissions. */ + int flags; /* Deletion = bit 0. */ + ZFile *pNext; /* Next file in the same archive */ }; -EXTERN int Tcl_Zvfs_Mount(Tcl_Interp *interp,CONST char *zArchive,CONST char *zMountPoint); -EXTERN int Tcl_Zvfs_Umount(CONST char *zArchive); +EXTERN int Tcl_Zvfs_Mount(Tcl_Interp *interp,const char *zArchive,const char *zMountPoint); +EXTERN int Tcl_Zvfs_Umount(const char *zArchive); EXTERN int Tcl_Zvfs_Init(Tcl_Interp *interp); EXTERN int Tcl_Zvfs_SafeInit(Tcl_Interp *interp); + /* -** Macros to read 16-bit and 32-bit big-endian integers into the -** native format of this local processor. B is an array of -** characters and the integer begins at the N-th character of -** the array. -*/ + * Macros to read 16-bit and 32-bit big-endian integers into the native format + * of this local processor. B is an array of characters and the integer + * begins at the N-th character of the array. + */ #define INT16(B, N) (B[N] + (B[N+1]<<8)) #define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24)) /* -** Write a 16- or 32-bit integer as little-endian into the given buffer. -*/ -static void put16(char *z, int v){ - z[0] = v & 0xff; - z[1] = (v>>8) & 0xff; + * Write a 16- or 32-bit integer as little-endian into the given buffer. + */ +static void +put16( + char *z, + int v) +{ + z[0] = v & 0xff; + z[1] = (v>>8) & 0xff; } -static void put32(char *z, int v){ - z[0] = v & 0xff; - z[1] = (v>>8) & 0xff; - z[2] = (v>>16) & 0xff; - z[3] = (v>>24) & 0xff; +static void +put32( + char *z, + int v) +{ + z[0] = v & 0xff; + z[1] = (v>>8) & 0xff; + z[2] = (v>>16) & 0xff; + z[3] = (v>>24) & 0xff; } - + /* -** Make a new ZFile structure with space to hold a name of the number of -** characters given. Return a pointer to the new structure. -*/ -static ZFile *newZFile(int nName, ZFile **ppList){ - ZFile *pNew; - - pNew = (ZFile*)Tcl_Alloc( sizeof(*pNew) + nName + 1 ); - memset(pNew, 0, sizeof(*pNew)); - pNew->zName = (char*)&pNew[1]; - pNew->pNext = *ppList; - *ppList = pNew; - return pNew; + * Make a new ZFile structure with space to hold a name of the number of + * characters given. Return a pointer to the new structure. + */ +static ZFile * +newZFile( + int nName, + ZFile **ppList) +{ + ZFile *pNew = Tcl_Alloc( sizeof(*pNew) + nName + 1 ); + + memset(pNew, 0, sizeof(*pNew)); + pNew->zName = (char*)&pNew[1]; + pNew->pNext = *ppList; + *ppList = pNew; + return pNew; } /* -** Delete an entire list of ZFile structures -*/ -static void deleteZFileList(ZFile *pList){ - ZFile *pNext; - while( pList ){ - pNext = pList->pNext; - Tcl_Free((char*)pList); - pList = pNext; - } + * Delete an entire list of ZFile structures + */ +static void +deleteZFileList( + ZFile *pList) +{ + ZFile *pNext; + + while( pList ){ + pNext = pList->pNext; + Tcl_Free((char*)pList); + pList = pNext; + } } /* Convert DOS time to unix time. */ -static void UnixTimeDate(struct tm *tm, int *dosDate, int *dosTime){ - *dosDate = ((((tm->tm_year-80)<<9)&0xfe00) | (((tm->tm_mon+1)<<5)&0x1e0) | (tm->tm_mday&0x1f)); - *dosTime = (((tm->tm_hour<<11)&0xf800) | ((tm->tm_min<<5)&0x7e0) | (tm->tm_sec&0x1f)); +static void +UnixTimeDate( + struct tm *tm, + int *dosDate, + int *dosTime) +{ + *dosDate = ((((tm->tm_year-80)<<9)&0xfe00) | (((tm->tm_mon+1)<<5)&0x1e0) + | (tm->tm_mday&0x1f)); + *dosTime = (((tm->tm_hour<<11)&0xf800) | ((tm->tm_min<<5)&0x7e0) + | (tm->tm_sec&0x1f)); } /* Convert DOS time to unix time. */ -static time_t DosTimeDate(int dosDate, int dosTime){ - time_t now; - struct tm *tm; - now=time(NULL); - tm = localtime(&now); - tm->tm_year=(((dosDate&0xfe00)>>9) + 80); - tm->tm_mon=((dosDate&0x1e0)>>5); - tm->tm_mday=(dosDate & 0x1f); - tm->tm_hour=(dosTime&0xf800)>>11; - tm->tm_min=(dosTime&0x7e0)>>5; - tm->tm_sec=(dosTime&0x1f); - return mktime(tm); +static time_t +DosTimeDate( + int dosDate, + int dosTime) +{ + time_t now; + struct tm *tm; + + now = time(NULL); + tm = localtime(&now); + tm->tm_year = (((dosDate&0xfe00)>>9) + 80); + tm->tm_mon = ((dosDate&0x1e0)>>5); + tm->tm_mday = (dosDate & 0x1f); + tm->tm_hour = (dosTime&0xf800)>>11; + tm->tm_min = (dosTime&0x7e0)>>5; + tm->tm_sec = (dosTime&0x1f); + return mktime(tm); } /* -** Translate a DOS time and date stamp into a human-readable string. -*/ -static void translateDosTimeDate(char *zStr, int dosDate, int dosTime){ - static char *zMonth[] = { "nil", - "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", - }; + * Translate a DOS time and date stamp into a human-readable string. + */ +static void +translateDosTimeDate( + char *zStr, + int dosDate, + int dosTime){ + static char *zMonth[] = { "nil", + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + }; - sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", - dosDate & 0x1f, - zMonth[ ((dosDate&0x1e0)>>5) ], - ((dosDate&0xfe00)>>9) + 1980, - (dosTime&0xf800)>>11, - (dosTime&0x7e)>>5, - dosTime&0x1f - ); + sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", + dosDate & 0x1f, + zMonth[ ((dosDate&0x1e0)>>5) ], + ((dosDate&0xfe00)>>9) + 1980, + (dosTime&0xf800)>>11, + (dosTime&0x7e)>>5, + dosTime&0x1f); } /* Return count of char ch in str */ -int strchrcnt(char *str, char ch) { - int cnt=0; - char *cp=str; - while ((cp=strchr(cp,ch))) { cp++; cnt++; } - return cnt; -} - +int +strchrcnt( + char *str, + char ch) +{ + int cnt = 0; + char *cp = str; + while ((cp = strchr(cp,ch)) != NULL) { + cp++; + cnt++; + } + return cnt; +} + /* -** Concatenate zTail onto zRoot to form a pathname. zRoot will begin -** with "/". After concatenation, simplify the pathname be removing -** unnecessary ".." and "." directories. Under windows, make all -** characters lower case. -** -** Resulting pathname is returned. Space to hold the returned path is -** obtained form Tcl_Alloc() and should be freed by the calling function. -*/ -static char *CanonicalPath(const char *zRoot, const char *zTail){ - char *zPath; - int i, j, c; + * Concatenate zTail onto zRoot to form a pathname. zRoot will begin with + * "/". After concatenation, simplify the pathname be removing unnecessary + * ".." and "." directories. Under windows, make all characters lower case. + * + * Resulting pathname is returned. Space to hold the returned path is + * obtained form Tcl_Alloc() and should be freed by the calling function. + */ +static char * +CanonicalPath( + const char *zRoot, + const char *zTail) +{ + char *zPath; + int i, j, c; #ifdef __WIN32__ - if( isalpha(zTail[0]) && zTail[1]==':' ){ zTail += 2; } - if( zTail[0]=='\\' ){ zRoot = ""; zTail++; } + if( isalpha(zTail[0]) && zTail[1]==':' ){ + zTail += 2; + } + if( zTail[0]=='\\' ){ + zRoot = ""; + zTail++; + } #endif - if( zTail[0]=='/' ){ zRoot = ""; zTail++; } - zPath = Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 ); - if( zPath==0 ) return 0; - if (zTail[0]) { - sprintf(zPath, "%s/%s", zRoot, zTail); - } else { - strcpy(zPath, zRoot); - } - for(i=j=0; (c = zPath[i])!=0; i++){ + if( zTail[0]=='/' ){ + zRoot = ""; + zTail++; + } + zPath = Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 ); + if( zPath==0 ) { + return 0; + } + if (zTail[0]) { + sprintf(zPath, "%s/%s", zRoot, zTail); + } else { + strcpy(zPath, zRoot); + } + for(i=j=0; (c = zPath[i])!=0; i++){ #ifdef __WIN32__ - if( isupper(c) ) { if (maptolower) c = tolower(c); } - else if( c=='\\' ) c = '/'; + if( isupper(c) ) { + if (maptolower) { + c = tolower(c); + } + } else if( c=='\\' ) { + c = '/'; + } #endif - if( c=='/' ){ - int c2 = zPath[i+1]; - if( c2=='/' ) continue; - if( c2=='.' ){ - int c3 = zPath[i+2]; - if( c3=='/' || c3==0 ){ - i++; - continue; - } - if( c3=='.' && (zPath[i+3]=='.' || zPath[i+3]==0) ){ - i += 2; - while( j>0 && zPath[j-1]!='/' ){ j--; } - continue; - } - } - } - zPath[j++] = c; - } - if( j==0 ){ zPath[j++] = '/'; } -// if (j>1 && zPath[j-1] == '/') j--; - zPath[j] = 0; - return zPath; + if( c=='/' ){ + int c2 = zPath[i+1]; + if( c2=='/' ) { + continue; + } + if( c2=='.' ){ + int c3 = zPath[i+2]; + if( c3=='/' || c3==0 ){ + i++; + continue; + } + if( c3=='.' && (zPath[i+3]=='.' || zPath[i+3]==0) ){ + i += 2; + while( j>0 && zPath[j-1]!='/' ){ + j--; + } + continue; + } + } + } + zPath[j++] = c; + } + if( j==0 ){ + zPath[j++] = '/'; + } + /* if (j>1 && zPath[j-1] == '/') j--; */ + zPath[j] = 0; + return zPath; } /* -** Construct an absolute pathname where memory is obtained from Tcl_Alloc -** that means the same file as the pathname given. -*/ -static char *AbsolutePath(const char *zRelative){ - Tcl_DString pwd; - char *zResult; - int len; - Tcl_DStringInit(&pwd); - if (zRelative[0] == '~' && zRelative[1] == '/') { - /* TODO: do this for all paths??? */ - if (Tcl_TranslateFileName(0, zRelative, &pwd) != NULL) { - zResult = CanonicalPath( "", Tcl_DStringValue(&pwd)); - goto done; - } - } else if( zRelative[0] != '/'){ + * Construct an absolute pathname where memory is obtained from Tcl_Alloc that + * means the same file as the pathname given. + */ +static char * +AbsolutePath( + const char *zRelative) +{ + Tcl_DString pwd; + char *zResult; + int len; + + Tcl_DStringInit(&pwd); + if (zRelative[0] == '~' && zRelative[1] == '/') { + /* TODO: do this for all paths??? */ + if (Tcl_TranslateFileName(0, zRelative, &pwd) != NULL) { + zResult = CanonicalPath( "", Tcl_DStringValue(&pwd)); + goto done; + } + } else if( zRelative[0] != '/'){ #ifdef __WIN32__ - if(!(zRelative[0]=='\\' || (zRelative[0] && zRelative[1] == ':'))) { - /*Tcl_GetCwd(0, &pwd); */ - } + if(!(zRelative[0]=='\\' || (zRelative[0] && zRelative[1] == ':'))) { + /*Tcl_GetCwd(0, &pwd); */ + } #else - Tcl_GetCwd(0, &pwd); + Tcl_GetCwd(0, &pwd); #endif - } - zResult = CanonicalPath( Tcl_DStringValue(&pwd), zRelative); -done: - Tcl_DStringFree(&pwd); - len=strlen(zResult); - if (len > 0 && zResult[len-1] == '/') - zResult[len-1] = 0; - return zResult; + } + zResult = CanonicalPath( Tcl_DStringValue(&pwd), zRelative); + done: + Tcl_DStringFree(&pwd); + len = strlen(zResult); + if (len > 0 && zResult[len-1] == '/') { + zResult[len-1] = 0; + } + return zResult; } -int ZvfsReadTOCStart( - Tcl_Interp *interp, /* Leave error messages in this interpreter */ - Tcl_Channel chan, - ZFile **pList, - int *iStart -) { - char *zArchiveName = 0; /* A copy of zArchive */ - int nFile; /* Number of files in the archive */ - int iPos; /* Current position in the archive file */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_HashEntry *pEntry; /* Hash table entry */ - int isNew; /* Flag to tell use when a hash entry is new */ - unsigned char zBuf[100]; /* Space into which to read from the ZIP archive */ - Tcl_HashSearch zSearch; /* Search all mount points */ - ZFile *p; - int zipStart; - - if (!chan) { - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){ - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { - return TCL_ERROR; - } - - /* Read the "End Of Central Directory" record from the end of the - ** ZIP archive. - */ - iPos = Tcl_Seek(chan, -22, SEEK_END); - Tcl_Read(chan, zBuf, 22); - if (memcmp(zBuf, "\120\113\05\06", 4)) { - /* Tcl_AppendResult(interp, "not a ZIP archive", NULL); */ - return TCL_BREAK; - } - - /* Compute the starting location of the directory for the ZIP archive - ** in iPos then seek to that location. - */ - zipStart = iPos; - nFile = INT16(zBuf,8); - iPos -= INT32(zBuf,12); - Tcl_Seek(chan, iPos, SEEK_SET); - - while(1) { - int lenName; /* Length of the next filename */ - int lenExtra; /* Length of "extra" data for next file */ - int iData; /* Offset to start of file data */ - int dosTime; - int dosDate; - int isdir; - ZvfsFile *pZvfs; /* A new virtual file */ - char *zFullPath; /* Full pathname of the virtual file */ - char zName[1024]; /* Space to hold the filename */ - - if (nFile-- <= 0 ){ - break; +int +ZvfsReadTOCStart( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + Tcl_Channel chan, + ZFile **pList, + int *iStart) +{ + char *zArchiveName = 0; /* A copy of zArchive */ + int nFile; /* Number of files in the archive */ + int iPos; /* Current position in the archive file */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + int isNew; /* Flag to tell use when a hash entry is + * new */ + unsigned char zBuf[100]; /* Space into which to read from the ZIP + * archive */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZFile *p; + int zipStart; + + if (!chan) { + return TCL_ERROR; } - /* Read the next directory entry. Extract the size of the filename, - ** the size of the "extra" information, and the offset into the archive - ** file of the file data. - */ - Tcl_Read(chan, zBuf, 46); - if (memcmp(zBuf, "\120\113\01\02", 4)) { - Tcl_AppendResult(interp, "ill-formed central directory entry", NULL); - return TCL_ERROR; - } - lenName = INT16(zBuf,28); - lenExtra = INT16(zBuf,30) + INT16(zBuf,32); - iData = INT32(zBuf,42); - if (iDatazName, lenName); - p->zName[lenName] = 0; - if (lenName>0 && p->zName[lenName-1] == '/') { - p->isSpecial = 1; - } - p->dosDate = INT16(zBuf, 14); - p->dosTime = INT16(zBuf, 12); - p->nByteCompr = INT32(zBuf, 20); - p->nByte = INT32(zBuf, 24); - p->nExtra = INT32(zBuf, 28); - p->iCRC = INT32(zBuf, 32); - - if (nFile < 0) - break; + if (Tcl_SetChannelOption(interp, chan, "-translation", + "binary") != TCL_OK){ + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { + return TCL_ERROR; + } + + /* + * Read the "End Of Central Directory" record from the end of the ZIP + * archive. + */ + + iPos = Tcl_Seek(chan, -22, SEEK_END); + Tcl_Read(chan, zBuf, 22); + if (memcmp(zBuf, "\120\113\05\06", 4)) { + /* Tcl_AppendResult(interp, "not a ZIP archive", NULL); */ + return TCL_BREAK; + } + + /* + * Compute the starting location of the directory for the ZIP archive in + * iPos then seek to that location. + */ + + zipStart = iPos; + nFile = INT16(zBuf,8); + iPos -= INT32(zBuf,12); + Tcl_Seek(chan, iPos, SEEK_SET); + + while(1) { + int lenName; /* Length of the next filename */ + int lenExtra; /* Length of "extra" data for next file */ + int iData; /* Offset to start of file data */ + int dosTime; + int dosDate; + int isdir; + ZvfsFile *pZvfs; /* A new virtual file */ + char *zFullPath; /* Full pathname of the virtual file */ + char zName[1024]; /* Space to hold the filename */ + + if (nFile-- <= 0 ){ + break; + } + + /* + * Read the next directory entry. Extract the size of the filename, + * the size of the "extra" information, and the offset into the + * archive file of the file data. + */ + + Tcl_Read(chan, zBuf, 46); + if (memcmp(zBuf, "\120\113\01\02", 4)) { + Tcl_AppendResult(interp, "ill-formed central directory entry", + NULL); + return TCL_ERROR; + } + lenName = INT16(zBuf,28); + lenExtra = INT16(zBuf,30) + INT16(zBuf,32); + iData = INT32(zBuf,42); + if (iDatazName, lenName); + p->zName[lenName] = 0; + if (lenName>0 && p->zName[lenName-1] == '/') { + p->isSpecial = 1; + } + p->dosDate = INT16(zBuf, 14); + p->dosTime = INT16(zBuf, 12); + p->nByteCompr = INT32(zBuf, 20); + p->nByte = INT32(zBuf, 24); + p->nExtra = INT32(zBuf, 28); + p->iCRC = INT32(zBuf, 32); + + if (nFile < 0) { + break; + } + + /* + * Skip over the extra information so that the next read will be from + * the beginning of the next directory entry. + */ + + Tcl_Seek(chan, lenExtra, SEEK_CUR); + } + *iStart = zipStart; + return TCL_OK; } -int ZvfsReadTOC( - Tcl_Interp *interp, /* Leave error messages in this interpreter */ - Tcl_Channel chan, - ZFile **pList -) { +int +ZvfsReadTOC( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + Tcl_Channel chan, + ZFile **pList) +{ int iStart; + return ZvfsReadTOCStart( interp, chan, pList, &iStart); } /* -** Read a ZIP archive and make entries in the virutal file hash table for all -** content files of that ZIP archive. Also initialize the ZVFS if this -** routine has not been previously called. -*/ -int Tcl_Zvfs_Mount( - Tcl_Interp *interp, /* Leave error messages in this interpreter */ - CONST char *zArchive, /* The ZIP archive file */ - CONST char *zMountPoint /* Mount contents at this directory */ -){ - Tcl_Channel chan; /* Used for reading the ZIP archive file */ - char *zArchiveName = 0; /* A copy of zArchive */ - char *zTrueName = 0; /* A copy of zMountPoint */ - int nFile; /* Number of files in the archive */ - int iPos; /* Current position in the archive file */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_HashEntry *pEntry; /* Hash table entry */ - int isNew; /* Flag to tell use when a hash entry is new */ - unsigned char zBuf[100]; /* Space into which to read from the ZIP archive */ - Tcl_HashSearch zSearch; /* Search all mount points */ - unsigned int startZip; - - if( !local.isInit ) return TCL_ERROR; - /* If null archive name, return all current mounts. */ - if (!zArchive) { - Tcl_DString dStr; - Tcl_DStringInit(&dStr); - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); - while (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { - Tcl_DStringAppendElement(&dStr, pArchive->zName); - Tcl_DStringAppendElement(&dStr, pArchive->zMountPoint); - } - pEntry=Tcl_NextHashEntry(&zSearch); + * Read a ZIP archive and make entries in the virutal file hash table for all + * content files of that ZIP archive. Also initialize the ZVFS if this + * routine has not been previously called. + */ +int +Tcl_Zvfs_Mount( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + const char *zArchive, /* The ZIP archive file */ + const char *zMountPoint) /* Mount contents at this directory */ +{ + Tcl_Channel chan; /* Used for reading the ZIP archive file */ + char *zArchiveName = 0; /* A copy of zArchive */ + char *zTrueName = 0; /* A copy of zMountPoint */ + int nFile; /* Number of files in the archive */ + int iPos; /* Current position in the archive file */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + int isNew; /* Flag to tell use when a hash entry is + * new */ + unsigned char zBuf[100]; /* Space into which to read from the ZIP + * archive */ + Tcl_HashSearch zSearch; /* Search all mount points */ + unsigned int startZip; + + if( !local.isInit ) { + return TCL_ERROR; } - Tcl_DStringResult(interp, &dStr); - return TCL_OK; - } - /* If null mount, return mount point. */ - // TODO: cleanup allocations of Absolute() path. - if (!zMountPoint) { - zTrueName=AbsolutePath(zArchive); - pEntry = Tcl_FindHashEntry(&local.archiveHash,zTrueName); - if (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { - Tcl_AppendResult(interp, pArchive->zMountPoint, 0); - } + + /* + * If null archive name, return all current mounts. + */ + + if (!zArchive) { + Tcl_DString dStr; + + Tcl_DStringInit(&dStr); + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + Tcl_DStringAppendElement(&dStr, pArchive->zName); + Tcl_DStringAppendElement(&dStr, pArchive->zMountPoint); + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + Tcl_DStringResult(interp, &dStr); + return TCL_OK; } - Tcl_Free(zTrueName); - return TCL_OK; - } - chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0); - if (!chan) { - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){ - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { - return TCL_ERROR; - } - - /* Read the "End Of Central Directory" record from the end of the - ** ZIP archive. - */ - iPos = Tcl_Seek(chan, -22, SEEK_END); - Tcl_Read(chan, zBuf, 22); - if (memcmp(zBuf, "\120\113\05\06", 4)) { - Tcl_AppendResult(interp, "not a ZIP archive", NULL); - return TCL_ERROR; - } - /* Construct the archive record - */ - zArchiveName = AbsolutePath(zArchive); - pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew); - if( !isNew ){ - pArchive = Tcl_GetHashValue(pEntry); - Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint, 0); - Tcl_Free(zArchiveName); - Tcl_Close(interp, chan); - return TCL_ERROR; - } - if (!*zMountPoint) { - /* Empty string is the special case of mounting on itself. */ - zMountPoint = zTrueName = AbsolutePath(zArchive); - } - pArchive = (ZvfsArchive*)Tcl_Alloc(sizeof(*pArchive) + strlen(zMountPoint)+1); - pArchive->zName = zArchiveName; - pArchive->zMountPoint = (char*)&pArchive[1]; - strcpy(pArchive->zMountPoint, zMountPoint); - pArchive->pFiles = 0; - Tcl_SetHashValue(pEntry, pArchive); - - /* Compute the starting location of the directory for the ZIP archive - ** in iPos then seek to that location. - */ - nFile = INT16(zBuf,8); - iPos -= INT32(zBuf,12); - Tcl_Seek(chan, iPos, SEEK_SET); - startZip = iPos; - - while(1) { - int lenName; /* Length of the next filename */ - int lenExtra; /* Length of "extra" data for next file */ - int iData; /* Offset to start of file data */ - int dosTime; - int dosDate; - int isdir; - ZvfsFile *pZvfs; /* A new virtual file */ - char *zFullPath; /* Full pathname of the virtual file */ - char zName[1024]; /* Space to hold the filename */ - - if (nFile-- <= 0 ){ - isdir = 1; - zFullPath = CanonicalPath(zMountPoint, ""); - iData = startZip; - goto addentry; - } - /* Read the next directory entry. Extract the size of the filename, - ** the size of the "extra" information, and the offset into the archive - ** file of the file data. - */ - Tcl_Read(chan, zBuf, 46); - if (memcmp(zBuf, "\120\113\01\02", 4)) { - Tcl_AppendResult(interp, "ill-formed central directory entry", NULL); - if (zTrueName) - Tcl_Free(zTrueName); - return TCL_ERROR; - } - lenName = INT16(zBuf,28); - lenExtra = INT16(zBuf,30) + INT16(zBuf,32); - iData = INT32(zBuf,42); - - - /* If the virtual filename is too big to fit in zName[], then skip - ** this file - */ - if( lenName >= sizeof(zName) ){ - Tcl_Seek(chan, lenName + lenExtra, SEEK_CUR); - continue; - } - - /* Construct an entry in local.fileHash for this virtual file. - */ - Tcl_Read(chan, zName, lenName); - isdir=0; - if (lenName>0 && zName[lenName-1] == '/') { - lenName--; - isdir=2; - } - zName[lenName] = 0; - zFullPath = CanonicalPath(zMountPoint, zName); -addentry: - pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) ); - pZvfs->zName = zFullPath; - pZvfs->pArchive = pArchive; - pZvfs->isdir = isdir; - pZvfs->depth=strchrcnt(zFullPath,'/'); - pZvfs->iOffset = iData; - if (iDatatimestamp = DosTimeDate(dosDate, dosTime); - pZvfs->nByte = INT32(zBuf, 24); - pZvfs->nByteCompr = INT32(zBuf, 20); - pZvfs->pNext = pArchive->pFiles; - pZvfs->permissions = (0xffff&(INT32(zBuf, 38) >> 16)); - pArchive->pFiles = pZvfs; - pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullPath, &isNew); - if( isNew ){ - pZvfs->pNextName = 0; - }else{ - ZvfsFile *pOld = (ZvfsFile*)Tcl_GetHashValue(pEntry); - pOld->pPrevName = pZvfs; - pZvfs->pNextName = pOld; + /* + * If null mount, return mount point. + */ + + /*TODO: cleanup allocations of Absolute() path.*/ + if (!zMountPoint) { + zTrueName=AbsolutePath(zArchive); + pEntry = Tcl_FindHashEntry(&local.archiveHash,zTrueName); + if (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + Tcl_AppendResult(interp, pArchive->zMountPoint, 0); + } + } + Tcl_Free(zTrueName); + return TCL_OK; + } + chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0); + if (!chan) { + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){ + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { + return TCL_ERROR; } - pZvfs->pPrevName = 0; - Tcl_SetHashValue(pEntry, (ClientData) pZvfs); - if (nFile < 0) - break; + /* + * Read the "End Of Central Directory" record from the end of the ZIP + * archive. + */ - /* Skip over the extra information so that the next read will be from - ** the beginning of the next directory entry. - */ - Tcl_Seek(chan, lenExtra, SEEK_CUR); - } - Tcl_Close(interp, chan); -done: - if (zTrueName) - Tcl_Free(zTrueName); - return TCL_OK; + iPos = Tcl_Seek(chan, -22, SEEK_END); + Tcl_Read(chan, zBuf, 22); + if (memcmp(zBuf, "\120\113\05\06", 4)) { + Tcl_AppendResult(interp, "not a ZIP archive", NULL); + return TCL_ERROR; + } + + /* + * Construct the archive record. + */ + + zArchiveName = AbsolutePath(zArchive); + pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew); + if( !isNew ){ + pArchive = Tcl_GetHashValue(pEntry); + Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint, + 0); + Tcl_Free(zArchiveName); + Tcl_Close(interp, chan); + return TCL_ERROR; + } + + /* + * Empty string is the special case of mounting on itself. + */ + + if (!*zMountPoint) { + zMountPoint = zTrueName = AbsolutePath(zArchive); + } + + pArchive = Tcl_Alloc(sizeof(*pArchive) + strlen(zMountPoint)+1); + pArchive->zName = zArchiveName; + pArchive->zMountPoint = (char*)&pArchive[1]; + strcpy(pArchive->zMountPoint, zMountPoint); + pArchive->pFiles = 0; + Tcl_SetHashValue(pEntry, pArchive); + + /* + * Compute the starting location of the directory for the ZIP archive in + * iPos then seek to that location. + */ + + nFile = INT16(zBuf,8); + iPos -= INT32(zBuf,12); + Tcl_Seek(chan, iPos, SEEK_SET); + startZip = iPos; + + while(1) { + int lenName; /* Length of the next filename */ + int lenExtra; /* Length of "extra" data for next file */ + int iData; /* Offset to start of file data */ + int dosTime; + int dosDate; + int isdir; + ZvfsFile *pZvfs; /* A new virtual file */ + char *zFullPath; /* Full pathname of the virtual file */ + char zName[1024]; /* Space to hold the filename */ + + if (nFile-- <= 0 ){ + isdir = 1; + zFullPath = CanonicalPath(zMountPoint, ""); + iData = startZip; + goto addentry; + } + + /* + * Read the next directory entry. Extract the size of the filename, + * the size of the "extra" information, and the offset into the + * archive file of the file data. + */ + + Tcl_Read(chan, zBuf, 46); + if (memcmp(zBuf, "\120\113\01\02", 4)) { + Tcl_AppendResult(interp, "ill-formed central directory entry", + NULL); + if (zTrueName) { + Tcl_Free(zTrueName); + } + return TCL_ERROR; + } + lenName = INT16(zBuf,28); + lenExtra = INT16(zBuf,30) + INT16(zBuf,32); + iData = INT32(zBuf,42); + + /* + * If the virtual filename is too big to fit in zName[], then skip + * this file + */ + + if( lenName >= sizeof(zName) ){ + Tcl_Seek(chan, lenName + lenExtra, SEEK_CUR); + continue; + } + + /* + * Construct an entry in local.fileHash for this virtual file. + */ + + Tcl_Read(chan, zName, lenName); + isdir=0; + if (lenName>0 && zName[lenName-1] == '/') { + lenName--; + isdir=2; + } + zName[lenName] = 0; + zFullPath = CanonicalPath(zMountPoint, zName); + addentry: + pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) ); + pZvfs->zName = zFullPath; + pZvfs->pArchive = pArchive; + pZvfs->isdir = isdir; + pZvfs->depth=strchrcnt(zFullPath,'/'); + pZvfs->iOffset = iData; + if (iDatatimestamp = DosTimeDate(dosDate, dosTime); + pZvfs->nByte = INT32(zBuf, 24); + pZvfs->nByteCompr = INT32(zBuf, 20); + pZvfs->pNext = pArchive->pFiles; + pZvfs->permissions = (0xffff&(INT32(zBuf, 38) >> 16)); + pArchive->pFiles = pZvfs; + pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullPath, &isNew); + if( isNew ){ + pZvfs->pNextName = 0; + } else { + ZvfsFile *pOld = Tcl_GetHashValue(pEntry); + + pOld->pPrevName = pZvfs; + pZvfs->pNextName = pOld; + } + pZvfs->pPrevName = 0; + Tcl_SetHashValue(pEntry, pZvfs); + + if (nFile < 0) { + break; + } + + /* + * Skip over the extra information so that the next read will be from + * the beginning of the next directory entry. + */ + + Tcl_Seek(chan, lenExtra, SEEK_CUR); + } + Tcl_Close(interp, chan); + done: + if (zTrueName) { + Tcl_Free(zTrueName); + } + return TCL_OK; } /* -** Locate the ZvfsFile structure that corresponds to the file named. -** Return NULL if there is no such ZvfsFile. -*/ -static ZvfsFile *ZvfsLookup(char *zFilename){ - char *zTrueName; - Tcl_HashEntry *pEntry; - ZvfsFile *pFile; - - if( local.isInit==0 ) return 0; - zTrueName = AbsolutePath(zFilename); - pEntry = Tcl_FindHashEntry(&local.fileHash, zTrueName); - pFile = pEntry ? Tcl_GetHashValue(pEntry) : 0; - Tcl_Free(zTrueName); - return pFile; -} + * Locate the ZvfsFile structure that corresponds to the file named. Return + * NULL if there is no such ZvfsFile. + */ +static ZvfsFile * +ZvfsLookup( + char *zFilename) +{ + char *zTrueName; + Tcl_HashEntry *pEntry; + ZvfsFile *pFile; -static int ZvfsLookupMount(char *zFilename){ - char *zTrueName; - Tcl_HashEntry *pEntry; /* Hash table entry */ - Tcl_HashSearch zSearch; /* Search all mount points */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - int match=0; - if( local.isInit==0 ) return 0; - zTrueName = AbsolutePath(zFilename); - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); - while (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { - if (!strcmp(pArchive->zMountPoint,zTrueName)) { - match=1; - break; - } + if( local.isInit==0 ) { + return 0; } - pEntry=Tcl_NextHashEntry(&zSearch); - } - Tcl_Free(zTrueName); - return match; + zTrueName = AbsolutePath(zFilename); + pEntry = Tcl_FindHashEntry(&local.fileHash, zTrueName); + pFile = pEntry ? Tcl_GetHashValue(pEntry) : 0; + Tcl_Free(zTrueName); + return pFile; } +static int +ZvfsLookupMount( + char *zFilename) +{ + char *zTrueName; + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + int match=0; + + if( local.isInit==0 ) { + return 0; + } + zTrueName = AbsolutePath(zFilename); + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + if (!strcmp(pArchive->zMountPoint,zTrueName)) { + match=1; + break; + } + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + Tcl_Free(zTrueName); + return match; +} /* -** Unmount all the files in the given ZIP archive. -*/ -int Tcl_Zvfs_Umount(CONST char *zArchive){ - char *zArchiveName; - ZvfsArchive *pArchive; - ZvfsFile *pFile, *pNextFile; - Tcl_HashEntry *pEntry; - - zArchiveName = AbsolutePath(zArchive); - pEntry = Tcl_FindHashEntry(&local.archiveHash, zArchiveName); - Tcl_Free(zArchiveName); - if( pEntry==0 ) return 0; - pArchive = Tcl_GetHashValue(pEntry); - Tcl_DeleteHashEntry(pEntry); - Tcl_Free(pArchive->zName); - for(pFile=pArchive->pFiles; pFile; pFile=pNextFile){ - pNextFile = pFile->pNext; - if( pFile->pNextName ){ - pFile->pNextName->pPrevName = pFile->pPrevName; - } - if( pFile->pPrevName ){ - pFile->pPrevName->pNextName = pFile->pNextName; - }else{ - pEntry = Tcl_FindHashEntry(&local.fileHash, pFile->zName); - if( pEntry==0 ){ - /* This should never happen */ - }else if( pFile->pNextName ){ - Tcl_SetHashValue(pEntry, pFile->pNextName); - }else{ - Tcl_DeleteHashEntry(pEntry); - } - } - Tcl_Free(pFile->zName); - Tcl_Free((char*)pFile); - } - return 1; + * Unmount all the files in the given ZIP archive. + */ +int +Tcl_Zvfs_Umount( + const char *zArchive) +{ + char *zArchiveName; + ZvfsArchive *pArchive; + ZvfsFile *pFile, *pNextFile; + Tcl_HashEntry *pEntry; + + zArchiveName = AbsolutePath(zArchive); + pEntry = Tcl_FindHashEntry(&local.archiveHash, zArchiveName); + Tcl_Free(zArchiveName); + if( pEntry==0 ) { + return 0; + } + pArchive = Tcl_GetHashValue(pEntry); + Tcl_DeleteHashEntry(pEntry); + Tcl_Free(pArchive->zName); + for(pFile=pArchive->pFiles; pFile; pFile=pNextFile){ + pNextFile = pFile->pNext; + if( pFile->pNextName ){ + pFile->pNextName->pPrevName = pFile->pPrevName; + } + if( pFile->pPrevName ){ + pFile->pPrevName->pNextName = pFile->pNextName; + }else{ + pEntry = Tcl_FindHashEntry(&local.fileHash, pFile->zName); + if( pEntry==0 ){ + Tcl_Panic("This should never happen"); + }else if( pFile->pNextName ){ + Tcl_SetHashValue(pEntry, pFile->pNextName); + }else{ + Tcl_DeleteHashEntry(pEntry); + } + } + Tcl_Free(pFile->zName); + Tcl_Free((char*)pFile); + } + return 1; } -static void Zvfs_Unmount(CONST char *zArchive){ +static void +Zvfs_Unmount( + const char *zArchive) +{ Tcl_Zvfs_Umount(zArchive); } /* -** zvfs::mount Zip-archive-name mount-point -** -** Create a new mount point on the given ZIP archive. After this -** command executes, files contained in the ZIP archive will appear -** to Tcl to be regular files at the mount point. -** -** With no mount-point, return mount point for archive. -** With no archive, return all archive/mount pairs. -** If mount-point is specified as an empty string, mount on file path. -** -*/ -static int ZvfsMountCmd( - ClientData clientData, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int argc, /* Number of arguments */ - CONST char *argv[] /* Values of all arguments */ -){ - if( argc>3 ){ - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0); - return TCL_ERROR; - } - return Tcl_Zvfs_Mount(interp, argc>1?argv[1]:0, argc>2?argv[2]:0); + * zvfs::mount Zip-archive-name mount-point + * + * Create a new mount point on the given ZIP archive. After this command + * executes, files contained in the ZIP archive will appear to Tcl to be + * regular files at the mount point. + * + * With no mount-point, return mount point for archive. With no archive, + * return all archive/mount pairs. If mount-point is specified as an empty + * string, mount on file path. + */ +static int +ZvfsMountCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int argc, /* Number of arguments */ + const char *argv[]) /* Values of all arguments */ +{ + /*TODO: Convert to Tcl_Obj API!*/ + if( argc>3 ){ + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0); + return TCL_ERROR; + } + return Tcl_Zvfs_Mount(interp, argc>1?argv[1]:0, argc>2?argv[2]:0); } /* -** zvfs::unmount Zip-archive-name -** -** Undo the effects of zvfs::mount. -*/ -static int ZvfsUnmountCmd( - ClientData clientData, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int argc, /* Number of arguments */ - CONST char *argv[] /* Values of all arguments */ -){ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_HashEntry *pEntry; /* Hash table entry */ - Tcl_HashSearch zSearch; /* Search all mount points */ + * zvfs::unmount Zip-archive-name + * + * Undo the effects of zvfs::mount. + */ +static int +ZvfsUnmountCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int argc, /* Number of arguments */ + const char *argv[]) /* Values of all arguments */ +{ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ if( argc!=2 ){ - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ZIP-FILE\"", 0); - return TCL_ERROR; + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ZIP-FILE\"", 0); + return TCL_ERROR; } if (Tcl_Zvfs_Umount(argv[1])) { - return TCL_OK; + return TCL_OK; } - if( !local.isInit ) return TCL_ERROR; + if( !local.isInit ) { + return TCL_ERROR; + } pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); while (pEntry) { - if (((pArchive = Tcl_GetHashValue(pEntry))) - && pArchive->zMountPoint[0] - && (strcmp(pArchive->zMountPoint, argv[1]) == 0)) { - if (Tcl_Zvfs_Umount(pArchive->zName)) { - return TCL_OK; - } - break; - } - pEntry=Tcl_NextHashEntry(&zSearch); - } - - Tcl_AppendResult( interp, "unknown zvfs mount point or file: ", argv[1], 0); + if (((pArchive = Tcl_GetHashValue(pEntry))) + && pArchive->zMountPoint[0] + && (strcmp(pArchive->zMountPoint, argv[1]) == 0)) { + if (Tcl_Zvfs_Umount(pArchive->zName)) { + return TCL_OK; + } + break; + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + + Tcl_AppendResult(interp, "unknown zvfs mount point or file: ", argv[1], 0); return TCL_ERROR; } /* -** zvfs::exists filename -** -** Return TRUE if the given filename exists in the ZVFS and FALSE if -** it does not. -*/ -static int ZvfsExistsObjCmd( - ClientData clientData, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *CONST* objv /* Values of all arguments */ -){ - char *zFilename; - if( objc!=2 ){ - Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); - return TCL_ERROR; - } - zFilename = Tcl_GetString(objv[1]); - Tcl_SetBooleanObj( Tcl_GetObjResult(interp), ZvfsLookup(zFilename)!=0); - return TCL_OK; + * zvfs::exists filename + * + * Return TRUE if the given filename exists in the ZVFS and FALSE if it does + * not. + */ +static int +ZvfsExistsObjCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv) /* Values of all arguments */ +{ + char *zFilename; + + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); + return TCL_ERROR; + } + zFilename = Tcl_GetString(objv[1]); + Tcl_SetBooleanObj( Tcl_GetObjResult(interp), ZvfsLookup(zFilename)!=0); + return TCL_OK; } /* -** zvfs::info filename -** -** Return information about the given file in the ZVFS. The information -** consists of (1) the name of the ZIP archive that contains the file, -** (2) the size of the file after decompressions, (3) the compressed -** size of the file, and (4) the offset of the compressed data in the archive. -** -** Note: querying the mount point gives the start of zip data offset in -** (4), which can be used to truncate the zip info off an executable. -*/ -static int ZvfsInfoObjCmd( - ClientData clientData, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv /* Values of all arguments */ -){ - char *zFilename; - ZvfsFile *pFile; - if( objc!=2 ){ - Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); - return TCL_ERROR; - } - zFilename = Tcl_GetString(objv[1]); - pFile = ZvfsLookup(zFilename); - if( pFile ){ - Tcl_Obj *pResult = Tcl_GetObjResult(interp); - Tcl_ListObjAppendElement(interp, pResult, - Tcl_NewStringObj(pFile->pArchive->zName, -1)); - Tcl_ListObjAppendElement(interp, pResult, Tcl_NewIntObj(pFile->nByte)); - Tcl_ListObjAppendElement(interp, pResult, Tcl_NewIntObj(pFile->nByteCompr)); - Tcl_ListObjAppendElement(interp, pResult, Tcl_NewIntObj(pFile->iOffset)); - } - return TCL_OK; + * zvfs::info filename + * + * Return information about the given file in the ZVFS. The information + * consists of (1) the name of the ZIP archive that contains the file, (2) the + * size of the file after decompressions, (3) the compressed size of the file, + * and (4) the offset of the compressed data in the archive. + * + * Note: querying the mount point gives the start of zip data offset in (4), + * which can be used to truncate the zip info off an executable. + */ +static int +ZvfsInfoObjCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv) /* Values of all arguments */ +{ + char *zFilename; + ZvfsFile *pFile; + + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); + return TCL_ERROR; + } + zFilename = Tcl_GetString(objv[1]); + pFile = ZvfsLookup(zFilename); + if( pFile ){ + Tcl_Obj *pResult = Tcl_GetObjResult(interp); + + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewStringObj(pFile->pArchive->zName, -1)); + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewIntObj(pFile->nByte)); + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewIntObj(pFile->nByteCompr)); + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewIntObj(pFile->iOffset)); + } + return TCL_OK; } /* -** zvfs::list -** -** Return a list of all files in the ZVFS. The order of the names -** in the list is arbitrary. -*/ -static int ZvfsListObjCmd( - ClientData clientData, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv /* Values of all arguments */ -){ - char *zPattern = 0; - Tcl_RegExp pRegexp = 0; - Tcl_HashEntry *pEntry; - Tcl_HashSearch sSearch; - Tcl_Obj *pResult = Tcl_GetObjResult(interp); - - if( objc>3 ){ - Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?PATTERN?"); - return TCL_ERROR; - } - if( local.isInit==0 ) return TCL_OK; - if( objc==3 ){ - int n; - char *zSwitch = Tcl_GetStringFromObj(objv[1], &n); - if( n>=2 && strncmp(zSwitch,"-glob",n)==0 ){ - zPattern = Tcl_GetString(objv[2]); - }else if( n>=2 && strncmp(zSwitch,"-regexp",n)==0 ){ - pRegexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); - if( pRegexp==0 ) return TCL_ERROR; + * zvfs::list + * + * Return a list of all files in the ZVFS. The order of the names in the list + * is arbitrary. + */ +static int +ZvfsListObjCmd( + ClientData clientData, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv) /* Values of all arguments */ +{ + char *zPattern = 0; + Tcl_RegExp pRegexp = 0; + Tcl_HashEntry *pEntry; + Tcl_HashSearch sSearch; + Tcl_Obj *pResult = Tcl_GetObjResult(interp); + + if( objc>3 ){ + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?PATTERN?"); + return TCL_ERROR; + } + if( local.isInit==0 ) { + return TCL_OK; + } + if( objc==3 ){ + int n; + char *zSwitch = Tcl_GetStringFromObj(objv[1], &n); + + if( n>=2 && strncmp(zSwitch,"-glob",n)==0 ){ + zPattern = Tcl_GetString(objv[2]); + }else if( n>=2 && strncmp(zSwitch,"-regexp",n)==0 ){ + pRegexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + if( pRegexp==0 ) { + return TCL_ERROR; + } + }else{ + Tcl_AppendResult(interp, "unknown option: ", zSwitch, 0); + return TCL_ERROR; + } + } else if( objc==2 ){ + zPattern = Tcl_GetString(objv[1]); + } + if( zPattern ){ + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + + if( Tcl_StringCaseMatch(z, zPattern,1) ){ + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewStringObj(z, -1)); + } + } + }else if( pRegexp ){ + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + + if( Tcl_RegExpExec(interp, pRegexp, z, z) ){ + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewStringObj(z, -1)); + } + } }else{ - Tcl_AppendResult(interp, "unknown option: ", zSwitch, 0); - return TCL_ERROR; + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + + Tcl_ListObjAppendElement(interp, pResult, + Tcl_NewStringObj(z, -1)); + } } - }else if( objc==2 ){ - zPattern = Tcl_GetString(objv[1]); - } - if( zPattern ){ - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); - pEntry; - pEntry = Tcl_NextHashEntry(&sSearch) - ){ - ZvfsFile *pFile = Tcl_GetHashValue(pEntry); - char *z = pFile->zName; - if( Tcl_StringCaseMatch(z, zPattern,1) ){ - Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); - } - } - }else if( pRegexp ){ - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); - pEntry; - pEntry = Tcl_NextHashEntry(&sSearch) - ){ - ZvfsFile *pFile = Tcl_GetHashValue(pEntry); - char *z = pFile->zName; - if( Tcl_RegExpExec(interp, pRegexp, z, z) ){ - Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); - } - } - }else{ - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); - pEntry; - pEntry = Tcl_NextHashEntry(&sSearch) - ){ - ZvfsFile *pFile = Tcl_GetHashValue(pEntry); - char *z = pFile->zName; - Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); - } - } - return TCL_OK; + return TCL_OK; } /* -** Whenever a ZVFS file is opened, an instance of this structure is -** attached to the open channel where it will be available to the -** ZVFS I/O routines below. All state information about an open -** ZVFS file is held in this structure. -*/ + * Whenever a ZVFS file is opened, an instance of this structure is attached + * to the open channel where it will be available to the ZVFS I/O routines + * below. All state information about an open ZVFS file is held in this + * structure. + */ typedef struct ZvfsChannelInfo { - unsigned int nByte; /* number of bytes of read uncompressed data */ - unsigned int nByteCompr; /* number of bytes of unread compressed data */ - unsigned int nData; /* total number of bytes of compressed data */ - int readSoFar; /* Number of bytes read so far */ - long startOfData; /* File position of start of data in ZIP archive */ - int isCompressed; /* True data is compressed */ - Tcl_Channel chan; /* Open to the archive file */ - unsigned char *zBuf; /* buffer used by the decompressor */ - z_stream stream; /* state of the decompressor */ + unsigned int nByte; /* number of bytes of read uncompressed + * data */ + unsigned int nByteCompr; /* number of bytes of unread compressed + * data */ + unsigned int nData; /* total number of bytes of compressed data */ + int readSoFar; /* Number of bytes read so far */ + long startOfData; /* File position of start of data in ZIP + * archive */ + int isCompressed; /* True data is compressed */ + Tcl_Channel chan; /* Open to the archive file */ + unsigned char *zBuf; /* buffer used by the decompressor */ + z_stream stream; /* state of the decompressor */ } ZvfsChannelInfo; - /* -** This routine is called as an exit handler. If we do not set -** ZvfsChannelInfo.chan to NULL, then Tcl_Close() will be called on -** that channel twice when Tcl_Exit runs. This will lead to a -** core dump. -*/ -static void vfsExit(void *pArg){ - ZvfsChannelInfo *pInfo = (ZvfsChannelInfo*)pArg; - pInfo->chan = 0; + * This routine is called as an exit handler. If we do not set + * ZvfsChannelInfo.chan to NULL, then Tcl_Close() will be called on that + * channel twice when Tcl_Exit runs. This will lead to a core dump. + */ +static void +vfsExit( + void *pArg) +{ + ZvfsChannelInfo *pInfo = pArg; + + pInfo->chan = 0; } /* -** This routine is called when the ZVFS channel is closed -*/ -static int vfsClose( - ClientData instanceData, /* A ZvfsChannelInfo structure */ - Tcl_Interp *interp /* The TCL interpreter */ -){ - ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*)instanceData; - - if( pInfo->zBuf ){ - Tcl_Free(pInfo->zBuf); - inflateEnd(&pInfo->stream); - } - if( pInfo->chan ){ - Tcl_Close(interp, pInfo->chan); - Tcl_DeleteExitHandler(vfsExit, pInfo); - } - Tcl_Free((char*)pInfo); - return TCL_OK; + * This routine is called when the ZVFS channel is closed + */ +static int +vfsClose( + ClientData instanceData, /* A ZvfsChannelInfo structure */ + Tcl_Interp *interp) /* The TCL interpreter */ +{ + ZvfsChannelInfo* pInfo = instanceData; + + if( pInfo->zBuf ){ + Tcl_Free(pInfo->zBuf); + inflateEnd(&pInfo->stream); + } + if( pInfo->chan ){ + Tcl_Close(interp, pInfo->chan); + Tcl_DeleteExitHandler(vfsExit, pInfo); + } + Tcl_Free((char*)pInfo); + return TCL_OK; } /* -** The TCL I/O system calls this function to actually read information -** from a ZVFS file. -*/ -static int vfsInput ( - ClientData instanceData, /* The channel to read from */ - char *buf, /* Buffer to fill */ - int toRead, /* Requested number of bytes */ - int *pErrorCode /* Location of error flag */ -){ - ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; - - if( toRead > pInfo->nByte ){ - toRead = pInfo->nByte; - } - if( toRead == 0 ){ - return 0; - } - if( pInfo->isCompressed ){ - int err = Z_OK; - z_stream *stream = &pInfo->stream; - stream->next_out = buf; - stream->avail_out = toRead; - while (stream->avail_out) { - if (!stream->avail_in) { - int len = pInfo->nByteCompr; - if (len > COMPR_BUF_SIZE) { - len = COMPR_BUF_SIZE; - } - len = Tcl_Read(pInfo->chan, pInfo->zBuf, len); - pInfo->nByteCompr -= len; - stream->next_in = pInfo->zBuf; - stream->avail_in = len; - } - err = inflate(stream, Z_NO_FLUSH); - if (err) break; - } - if (err == Z_STREAM_END) { - if ((stream->avail_out != 0)) { - *pErrorCode = err; /* premature end */ - return -1; - } - }else if( err ){ - *pErrorCode = err; /* some other zlib error */ - return -1; - } - }else{ - toRead = Tcl_Read(pInfo->chan, buf, toRead); - } - pInfo->nByte -= toRead; - pInfo->readSoFar += toRead; - *pErrorCode = 0; - return toRead; + * The TCL I/O system calls this function to actually read information from a + * ZVFS file. + */ +static int +vfsInput( + ClientData instanceData, /* The channel to read from */ + char *buf, /* Buffer to fill */ + int toRead, /* Requested number of bytes */ + int *pErrorCode) /* Location of error flag */ +{ + ZvfsChannelInfo* pInfo = instanceData; + + if( toRead > pInfo->nByte ){ + toRead = pInfo->nByte; + } + if( toRead == 0 ){ + return 0; + } + if( pInfo->isCompressed ){ + int err = Z_OK; + z_stream *stream = &pInfo->stream; + + stream->next_out = buf; + stream->avail_out = toRead; + while (stream->avail_out) { + if (!stream->avail_in) { + int len = pInfo->nByteCompr; + + if (len > COMPR_BUF_SIZE) { + len = COMPR_BUF_SIZE; + } + len = Tcl_Read(pInfo->chan, pInfo->zBuf, len); + pInfo->nByteCompr -= len; + stream->next_in = pInfo->zBuf; + stream->avail_in = len; + } + err = inflate(stream, Z_NO_FLUSH); + if (err) { + break; + } + } + if (err == Z_STREAM_END) { + if ((stream->avail_out != 0)) { + *pErrorCode = err; /* premature end */ + return -1; + } + }else if( err ){ + *pErrorCode = err; /* some other zlib error */ + return -1; + } + }else{ + toRead = Tcl_Read(pInfo->chan, buf, toRead); + } + pInfo->nByte -= toRead; + pInfo->readSoFar += toRead; + *pErrorCode = 0; + return toRead; } /* -** Write to a ZVFS file. ZVFS files are always read-only, so this routine -** always returns an error. -*/ -static int vfsOutput( - ClientData instanceData, /* The channel to write to */ - CONST char *buf, /* Data to be stored. */ - int toWrite, /* Number of bytes to write. */ - int *pErrorCode /* Location of error flag. */ -){ - *pErrorCode = EINVAL; - return -1; + * Write to a ZVFS file. ZVFS files are always read-only, so this routine + * always returns an error. + */ +static int +vfsOutput( + ClientData instanceData, /* The channel to write to */ + const char *buf, /* Data to be stored. */ + int toWrite, /* Number of bytes to write. */ + int *pErrorCode) /* Location of error flag. */ +{ + *pErrorCode = EINVAL; + return -1; } /* -** Move the file pointer so that the next byte read will be "offset". -*/ -static int vfsSeek( - ClientData instanceData, /* The file structure */ - long offset, /* Offset to seek to */ - int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */ - int *pErrorCode /* Write the error code here */ -){ - ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; - - switch( mode ){ - case SEEK_CUR: { - offset += pInfo->readSoFar; - break; - } - case SEEK_END: { - offset += pInfo->readSoFar + pInfo->nByte; - break; - } - default: { - /* Do nothing */ - break; - } - } - if (offset < 0) offset = 0; - if( !pInfo->isCompressed ){ - Tcl_Seek(pInfo->chan, offset + pInfo->startOfData, SEEK_SET); - pInfo->nByte = pInfo->nData; - pInfo->readSoFar = offset; - }else{ - if( offsetreadSoFar ){ - z_stream *stream = &pInfo->stream; - inflateEnd(stream); - stream->zalloc = (alloc_func)0; - stream->zfree = (free_func)0; - stream->opaque = (voidpf)0; - stream->avail_in = 2; - stream->next_in = pInfo->zBuf; - pInfo->zBuf[0] = 0x78; - pInfo->zBuf[1] = 0x01; - inflateInit(&pInfo->stream); - Tcl_Seek(pInfo->chan, pInfo->startOfData, SEEK_SET); - pInfo->nByte += pInfo->readSoFar; - pInfo->nByteCompr = pInfo->nData; - pInfo->readSoFar = 0; - } - while( pInfo->readSoFar < offset ){ - int toRead, errCode; - char zDiscard[100]; - toRead = offset - pInfo->readSoFar; - if( toRead>sizeof(zDiscard) ) toRead = sizeof(zDiscard); - vfsInput(instanceData, zDiscard, toRead, &errCode); - } - } - return pInfo->readSoFar; + * Move the file pointer so that the next byte read will be "offset". + */ +static int +vfsSeek( + ClientData instanceData, /* The file structure */ + long offset, /* Offset to seek to */ + int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */ + int *pErrorCode) /* Write the error code here */ +{ + ZvfsChannelInfo* pInfo = instanceData; + + switch( mode ){ + case SEEK_CUR: + offset += pInfo->readSoFar; + break; + case SEEK_END: + offset += pInfo->readSoFar + pInfo->nByte; + break; + default: + /* Do nothing */ + break; + } + if (offset < 0) { + offset = 0; + } + if( !pInfo->isCompressed ){ + Tcl_Seek(pInfo->chan, offset + pInfo->startOfData, SEEK_SET); + pInfo->nByte = pInfo->nData; + pInfo->readSoFar = offset; + }else{ + if( offsetreadSoFar ){ + z_stream *stream = &pInfo->stream; + + inflateEnd(stream); + stream->zalloc = (alloc_func)0; + stream->zfree = (free_func)0; + stream->opaque = (voidpf)0; + stream->avail_in = 2; + stream->next_in = pInfo->zBuf; + pInfo->zBuf[0] = 0x78; + pInfo->zBuf[1] = 0x01; + inflateInit(&pInfo->stream); + Tcl_Seek(pInfo->chan, pInfo->startOfData, SEEK_SET); + pInfo->nByte += pInfo->readSoFar; + pInfo->nByteCompr = pInfo->nData; + pInfo->readSoFar = 0; + } + while( pInfo->readSoFar < offset ){ + int toRead, errCode; + char zDiscard[100]; + + toRead = offset - pInfo->readSoFar; + if( toRead>sizeof(zDiscard) ) { + toRead = sizeof(zDiscard); + } + vfsInput(instanceData, zDiscard, toRead, &errCode); + } + } + return pInfo->readSoFar; } /* -** Handle events on the channel. ZVFS files do not generate events, -** so this is a no-op. -*/ -static void vfsWatchChannel( - ClientData instanceData, /* Channel to watch */ - int mask /* Events of interest */ -){ - return; + * Handle events on the channel. ZVFS files do not generate events, so this + * is a no-op. + */ +static void +vfsWatchChannel( + ClientData instanceData, /* Channel to watch */ + int mask) /* Events of interest */ +{ + return; } /* -** Called to retrieve the underlying file handle for this ZVFS file. -** As the ZVFS file has no underlying file handle, this is a no-op. -*/ -static int vfsGetFile( - ClientData instanceData, /* Channel to query */ - int direction, /* Direction of interest */ - ClientData* handlePtr /* Space to the handle into */ -){ - return TCL_ERROR; + * Called to retrieve the underlying file handle for this ZVFS file. As the + * ZVFS file has no underlying file handle, this is a no-op. + */ +static int +vfsGetFile( + ClientData instanceData, /* Channel to query */ + int direction, /* Direction of interest */ + ClientData* handlePtr) /* Space to the handle into */ +{ + return TCL_ERROR; } /* -** This structure describes the channel type structure for -** access to the ZVFS. -*/ + * This structure describes the channel type structure for access to the ZVFS. + */ static Tcl_ChannelType vfsChannelType = { - "vfs", /* Type name. */ - NULL, /* Set blocking/nonblocking behaviour. NULL'able */ - vfsClose, /* Close channel, clean instance data */ - vfsInput, /* Handle read request */ - vfsOutput, /* Handle write request */ - vfsSeek, /* Move location of access point. NULL'able */ - NULL, /* Set options. NULL'able */ - NULL, /* Get options. NULL'able */ - vfsWatchChannel, /* Initialize notifier */ - vfsGetFile /* Get OS handle from the channel. */ + "vfs", /* Type name. */ + NULL, /* Set blocking/nonblocking behaviour. + * NULL'able */ + vfsClose, /* Close channel, clean instance data */ + vfsInput, /* Handle read request */ + vfsOutput, /* Handle write request */ + vfsSeek, /* Move location of access point. NULL'able */ + NULL, /* Set options. NULL'able */ + NULL, /* Get options. NULL'able */ + vfsWatchChannel, /* Initialize notifier */ + vfsGetFile /* Get OS handle from the channel. */ }; /* -** This routine attempts to do an open of a file. Check to see -** if the file is located in the ZVFS. If so, then open a channel -** for reading the file. If not, return NULL. -*/ -static Tcl_Channel ZvfsFileOpen( - Tcl_Interp *interp, /* The TCL interpreter doing the open */ - char *zFilename, /* Name of the file to open */ - char *modeString, /* Mode string for the open (ignored) */ - int permissions /* Permissions for a newly created file (ignored) */ -){ - ZvfsFile *pFile; - ZvfsChannelInfo *pInfo; - Tcl_Channel chan; - static int count = 1; - char zName[50]; - unsigned char zBuf[50]; - - pFile = ZvfsLookup(zFilename); - if( pFile==0 ) return NULL; - openarch=1; - chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); - openarch=0; - if( chan==0 ){ - return 0; - } - if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") - || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") - ){ - /* this should never happen */ - Tcl_Close(0, chan); - return 0; - } - Tcl_Seek(chan, pFile->iOffset, SEEK_SET); - Tcl_Read(chan, zBuf, 30); - if( memcmp(zBuf, "\120\113\03\04", 4) ){ - if( interp ){ - Tcl_AppendResult(interp, "local header mismatch: ", NULL); + * This routine attempts to do an open of a file. Check to see if the file is + * located in the ZVFS. If so, then open a channel for reading the file. If + * not, return NULL. + */ +static Tcl_Channel +ZvfsFileOpen( + Tcl_Interp *interp, /* The TCL interpreter doing the open */ + char *zFilename, /* Name of the file to open */ + char *modeString, /* Mode string for the open (ignored) */ + int permissions) /* Permissions for a newly created file + * (ignored). */ +{ + ZvfsFile *pFile; + ZvfsChannelInfo *pInfo; + Tcl_Channel chan; + static int count = 1; + char zName[50]; + unsigned char zBuf[50]; + + pFile = ZvfsLookup(zFilename); + if( pFile==0 ) { + return NULL; } - Tcl_Close(interp, chan); - return 0; - } - pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) ); - pInfo->chan = chan; - Tcl_CreateExitHandler(vfsExit, pInfo); - pInfo->isCompressed = INT16(zBuf, 8); - if( pInfo->isCompressed ){ - z_stream *stream = &pInfo->stream; - pInfo->zBuf = Tcl_Alloc(COMPR_BUF_SIZE); - stream->zalloc = (alloc_func)0; - stream->zfree = (free_func)0; - stream->opaque = (voidpf)0; - stream->avail_in = 2; - stream->next_in = pInfo->zBuf; - pInfo->zBuf[0] = 0x78; - pInfo->zBuf[1] = 0x01; - inflateInit(&pInfo->stream); - }else{ - pInfo->zBuf = 0; - } - pInfo->nByte = INT32(zBuf,22); - pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18); - pInfo->readSoFar = 0; - Tcl_Seek(chan, INT16(zBuf,26)+INT16(zBuf,28), SEEK_CUR); - pInfo->startOfData = Tcl_Tell(chan); - sprintf(zName,"vfs_%x_%x",((int)pFile)>>12,count++); - chan = Tcl_CreateChannel(&vfsChannelType, zName, - (ClientData)pInfo, TCL_READABLE); - return chan; + openarch=1; + chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); + openarch=0; + if( chan==0 ){ + return 0; + } + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") + || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ + /* this should never happen */ + Tcl_Close(0, chan); + return 0; + } + Tcl_Seek(chan, pFile->iOffset, SEEK_SET); + Tcl_Read(chan, zBuf, 30); + if( memcmp(zBuf, "\120\113\03\04", 4) ){ + if( interp ){ + Tcl_AppendResult(interp, "local header mismatch: ", NULL); + } + Tcl_Close(interp, chan); + return 0; + } + pInfo = Tcl_Alloc( sizeof(*pInfo) ); + pInfo->chan = chan; + Tcl_CreateExitHandler(vfsExit, pInfo); + pInfo->isCompressed = INT16(zBuf, 8); + if( pInfo->isCompressed ){ + z_stream *stream = &pInfo->stream; + + pInfo->zBuf = Tcl_Alloc(COMPR_BUF_SIZE); + stream->zalloc = (alloc_func)0; + stream->zfree = (free_func)0; + stream->opaque = (voidpf)0; + stream->avail_in = 2; + stream->next_in = pInfo->zBuf; + pInfo->zBuf[0] = 0x78; + pInfo->zBuf[1] = 0x01; + inflateInit(&pInfo->stream); + }else{ + pInfo->zBuf = 0; + } + pInfo->nByte = INT32(zBuf,22); + pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18); + pInfo->readSoFar = 0; + Tcl_Seek(chan, INT16(zBuf,26)+INT16(zBuf,28), SEEK_CUR); + pInfo->startOfData = Tcl_Tell(chan); + sprintf(zName,"vfs_%x_%x",((int)pFile)>>12,count++); + chan = Tcl_CreateChannel(&vfsChannelType, zName, + (ClientData)pInfo, TCL_READABLE); + return chan; } /* -** This routine does a stat() system call for a ZVFS file. -*/ -static int ZvfsFileStat(char *path, struct stat *buf){ - ZvfsFile *pFile; + * This routine does a stat() system call for a ZVFS file. + */ +static int +ZvfsFileStat( + char *path, + struct stat *buf) +{ + ZvfsFile *pFile; - pFile = ZvfsLookup(path); - if( pFile==0 ){ - return -1; - } - memset(buf, 0, sizeof(*buf)); - if (pFile->isdir) - buf->st_mode = 040555; - else - buf->st_mode = (0100000|pFile->permissions); - buf->st_ino = 0; - buf->st_size = pFile->nByte; - buf->st_mtime = pFile->timestamp; - buf->st_ctime = pFile->timestamp; - buf->st_atime = pFile->timestamp; - return 0; + pFile = ZvfsLookup(path); + if( pFile==0 ){ + return -1; + } + memset(buf, 0, sizeof(*buf)); + if (pFile->isdir) { + buf->st_mode = 040555; + } else { + buf->st_mode = (0100000|pFile->permissions); + } + buf->st_ino = 0; + buf->st_size = pFile->nByte; + buf->st_mtime = pFile->timestamp; + buf->st_ctime = pFile->timestamp; + buf->st_atime = pFile->timestamp; + return 0; } /* -** This routine does an access() system call for a ZVFS file. -*/ -static int ZvfsFileAccess(char *path, int mode){ - ZvfsFile *pFile; + * This routine does an access() system call for a ZVFS file. + */ +static int +ZvfsFileAccess( + char *path, + int mode) +{ + ZvfsFile *pFile; - if( mode & 3 ){ - return -1; - } - pFile = ZvfsLookup(path); - if( pFile==0 ){ - return -1; - } - return 0; + if( mode & 3 ){ + return -1; + } + pFile = ZvfsLookup(path); + if( pFile==0 ){ + return -1; + } + return 0; } #ifndef USE_TCL_VFS /* -** This TCL procedure can be used to copy a file. The built-in -** "file copy" command of TCL bypasses the I/O system and does not -** work with zvfs. You have to use a procedure like the following -** instead. -*/ + * This TCL procedure can be used to copy a file. The built-in "file copy" + * command of TCL bypasses the I/O system and does not work with zvfs. You + * have to use a procedure like the following instead. + */ static char zFileCopy[] = "proc zvfs::filecopy {from to {outtype binary}} {\n" " set f [open $from r]\n" @@ -1249,149 +1440,187 @@ static char zFileCopy[] = #else -Tcl_Channel Tobe_FSOpenFileChannelProc - _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, - int mode, int permissions)) { - static int inopen=0; - Tcl_Channel chan; - if (inopen) { - puts("recursive zvfs open"); - return NULL; - } - inopen = 1; - /* if (mode != O_RDONLY) return NULL; */ - chan = ZvfsFileOpen(interp, Tcl_GetString(pathPtr), 0, - permissions); - inopen = 0; - return chan; +Tcl_Channel +Tobe_FSOpenFileChannelProc( + Tcl_Interp *interp, + Tcl_Obj *pathPtr, + int mode, + int permissions) +{ + static int inopen=0; + Tcl_Channel chan; + if (inopen) { + puts("recursive zvfs open"); + return NULL; + } + inopen = 1; + /* if (mode != O_RDONLY) return NULL; */ + chan = ZvfsFileOpen(interp, Tcl_GetString(pathPtr), 0, permissions); + inopen = 0; + return chan; +} + +/* + * This routine does a stat() system call for a ZVFS file. + */ +int +Tobe_FSStatProc( + Tcl_Obj *pathPtr, + struct stat *buf) +{ + return ZvfsFileStat(Tcl_GetString(pathPtr), buf); +} + +/* + * This routine does an access() system call for a ZVFS file. + */ +int +Tobe_FSAccessProc( + Tcl_Obj *pathPtr, + int mode) +{ + return ZvfsFileAccess(Tcl_GetString(pathPtr), mode); } +/* Tcl_Obj* Tobe_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) { + return Tcl_NewStringObj("/",-1);; +} */ + /* -** This routine does a stat() system call for a ZVFS file. -*/ -int Tobe_FSStatProc _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)) { - - return ZvfsFileStat(Tcl_GetString(pathPtr), buf); + * Function to process a 'Tobe_FSMatchInDirectory()'. If not implemented, + * then glob and recursive copy functionality will be lacking in the + * filesystem. + */ +int +Tobe_FSMatchInDirectoryProc( + Tcl_Interp* interp, + Tcl_Obj *result, + Tcl_Obj *pathPtr, + const char *pattern, + Tcl_GlobTypeData * types) +{ + Tcl_HashEntry *pEntry; + Tcl_HashSearch sSearch; + int scnt, len, l, dirglob, dirmnt; + char *zPattern = NULL, *zp=Tcl_GetStringFromObj(pathPtr,&len); + + if (!zp) { + return TCL_ERROR; + } + if (pattern != NULL) { + l=strlen(pattern); + if (!zp) { + zPattern=strdup(pattern); + } else { + zPattern=(char*)malloc(len+l+3); + sprintf(zPattern,"%s%s%s", zp, zp[len-1]=='/'?"":"/",pattern); + } + scnt=strchrcnt(zPattern,'/'); + } + dirglob = (types && types->type && (types->type&TCL_GLOB_TYPE_DIR)); + dirmnt = (types && types->type && (types->type&TCL_GLOB_TYPE_MOUNT)); + if (strcmp(zp, "/") == 0 && strcmp(zPattern, ".*") == 0) { + /*TODO: What goes here?*/ + } + for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + char *z = pFile->zName; + + if (zPattern != NULL) { + if( Tcl_StringCaseMatch(z, zPattern, 0) == 0 || + (scnt!=pFile->depth /* && !dirglob */ )) { // TODO: ??? + continue; + } + } else { + if (strcmp(zp, z)) { + continue; + } + } + if (dirmnt) { + if (pFile->isdir != 1) { + continue; + } + } else if (dirglob) { + if (!pFile->isdir) { + continue; + } + } else if (types && !(types->type&TCL_GLOB_TYPE_DIR)) { + if (pFile->isdir) { + continue; + } + } + Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z, -1)); + } + if (zPattern) { + free(zPattern); + } + return TCL_OK; } /* -** This routine does an access() system call for a ZVFS file. -*/ -int Tobe_FSAccessProc _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)) { - return ZvfsFileAccess(Tcl_GetString(pathPtr), mode); -} - - -/* Tcl_Obj* Tobe_FSFilesystemSeparatorProc - _ANSI_ARGS_((Tcl_Obj *pathPtr)) { - return Tcl_NewStringObj("/",-1);; -} */ -/* Function to process a -* 'Tobe_FSMatchInDirectory()'. If not -* implemented, then glob and recursive -* copy functionality will be lacking in -* the filesystem. */ -int Tobe_FSMatchInDirectoryProc _ANSI_ARGS_((Tcl_Interp* interp, - Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, - Tcl_GlobTypeData * types)) { - Tcl_HashEntry *pEntry; - Tcl_HashSearch sSearch; - int scnt, len, l, dirglob, dirmnt; - char *zPattern = NULL, *zp=Tcl_GetStringFromObj(pathPtr,&len);; - if (!zp) return TCL_ERROR; - if (pattern != NULL) { - l=strlen(pattern); - if (!zp) - zPattern=strdup(pattern); - else { - zPattern=(char*)malloc(len+l+3); - sprintf(zPattern,"%s%s%s", zp, zp[len-1]=='/'?"":"/",pattern); - } - scnt=strchrcnt(zPattern,'/'); - } - dirglob = (types && types->type && (types->type&TCL_GLOB_TYPE_DIR)); - dirmnt = (types && types->type && (types->type&TCL_GLOB_TYPE_MOUNT)); - if (strcmp(zp, "/") == 0 && strcmp(zPattern, ".*") == 0) { - } - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); - pEntry; - pEntry = Tcl_NextHashEntry(&sSearch) - ){ - ZvfsFile *pFile = Tcl_GetHashValue(pEntry); - char *z = pFile->zName; - if (zPattern != NULL) { - if( Tcl_StringCaseMatch(z, zPattern, 0) == 0 || - (scnt!=pFile->depth /* && !dirglob */ )) { // TODO: ??? - continue; - } - } else { - if (strcmp(zp, z)) - continue; - } - if (dirmnt) { - if (pFile->isdir != 1) - continue; - } else if (dirglob) { - if (!pFile->isdir) - continue; - } else if (types && !(types->type&TCL_GLOB_TYPE_DIR)) { - if (pFile->isdir) - continue; - } - Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z, -1)); - } - if (zPattern) - free(zPattern); - return TCL_OK; -} + * Function to check whether a path is in this filesystem. This is the most + * important filesystem procedure. + */ +int +Tobe_FSPathInFilesystemProc( + Tcl_Obj *pathPtr, + ClientData *clientDataPtr) +{ + ZvfsFile *zFile; + char *path=Tcl_GetString(pathPtr); -/* Function to check whether a path is in -* this filesystem. This is the most -* important filesystem procedure. */ -int Tobe_FSPathInFilesystemProc _ANSI_ARGS_((Tcl_Obj *pathPtr, - ClientData *clientDataPtr)) { - ZvfsFile *zFile; - char *path=Tcl_GetString(pathPtr); // if (ZvfsLookupMount(path)!=0) // return TCL_OK; - // TODO: also check this is the archive. - if (openarch) - return -1; - zFile = ZvfsLookup(path); - if (zFile!=NULL && strcmp(path,zFile->pArchive->zName)) - return TCL_OK; - return -1; +// // TODO: also check this is the archive. + if (openarch) { + return -1; + } + zFile = ZvfsLookup(path); + if (zFile!=NULL && strcmp(path,zFile->pArchive->zName)) { + return TCL_OK; + } + return -1; } -Tcl_Obj *Tobe_FSListVolumesProc _ANSI_ARGS_((void)) { - Tcl_HashEntry *pEntry; /* Hash table entry */ - Tcl_HashSearch zSearch; /* Search all mount points */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_Obj *pVols=NULL, *pVol; - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); - while (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { - if (!pVols) { - pVols=Tcl_NewListObj(0,0); - Tcl_IncrRefCount(pVols); - } - pVol=Tcl_NewStringObj(pArchive->zMountPoint,-1); - Tcl_IncrRefCount(pVol); - Tcl_ListObjAppendElement(NULL, pVols,pVol); - Tcl_DecrRefCount(pVol); - } - pEntry=Tcl_NextHashEntry(&zSearch); - } - return pVols; +Tcl_Obj * +Tobe_FSListVolumesProc(void) +{ + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_Obj *pVols=NULL, *pVol; + + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + while (pEntry) { + if (pArchive = Tcl_GetHashValue(pEntry)) { + if (!pVols) { + pVols=Tcl_NewListObj(0,0); + Tcl_IncrRefCount(pVols); + } + pVol=Tcl_NewStringObj(pArchive->zMountPoint,-1); + Tcl_IncrRefCount(pVol); + Tcl_ListObjAppendElement(NULL, pVols,pVol); + Tcl_DecrRefCount(pVol); + } + pEntry=Tcl_NextHashEntry(&zSearch); + } + return pVols; } -int Tobe_FSChdirProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { - /* Someday, we should actually check if this is a valid path. */ - return TCL_OK; +int +Tobe_FSChdirProc( + Tcl_Obj *pathPtr) +{ + /* Someday, we should actually check if this is a valid path. */ + return TCL_OK; } -CONST char** Tobe_FSFileAttrStringsProc _ANSI_ARGS_((Tcl_Obj *pathPtr, - Tcl_Obj** objPtrRef)) { +const char ** +Tobe_FSFileAttrStringsProc( + Tcl_Obj *pathPtr, + Tcl_Obj** objPtrRef) +{ Tcl_Obj *listPtr; Tcl_Interp *interp = NULL; char *path=Tcl_GetString(pathPtr); @@ -1400,45 +1629,49 @@ CONST char** Tobe_FSFileAttrStringsProc _ANSI_ARGS_((Tcl_Obj *pathPtr, #else static CONST char *attrs[] = { "-group", "-owner", "-permissions", 0 }; #endif - if (ZvfsLookup(path)==0) - return NULL; + if (ZvfsLookup(path)==0) { + return NULL; + } return attrs; } -int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((Tcl_Interp *interp, - int index, Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef)) { - +int +Tobe_FSFileAttrsGetProc( + Tcl_Interp *interp, + int index, + Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef) +{ char *path=Tcl_GetString(pathPtr); char buf[50]; ZvfsFile *zFile; + if ((zFile = ZvfsLookup(path))==0) - return TCL_ERROR; + return TCL_ERROR; switch (index) { #ifdef __WIN32__ - - case 0: /* -archive */ - *objPtrRef = Tcl_NewStringObj("0", -1); break; - case 1: /* -hidden */ - *objPtrRef = Tcl_NewStringObj("0", -1); break; - case 2: /* -readonly */ - *objPtrRef = Tcl_NewStringObj("", -1); break; - case 3: /* -system */ - *objPtrRef = Tcl_NewStringObj("", -1); break; - case 4: /* -shortname */ - *objPtrRef = Tcl_NewStringObj("", -1); + case 0: /* -archive */ + *objPtrRef = Tcl_NewStringObj("0", -1); break; + case 1: /* -hidden */ + *objPtrRef = Tcl_NewStringObj("0", -1); break; + case 2: /* -readonly */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 3: /* -system */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 4: /* -shortname */ + *objPtrRef = Tcl_NewStringObj("", -1); #else - case 0: /* -group */ - *objPtrRef = Tcl_NewStringObj("", -1); break; - case 1: /* -owner */ - *objPtrRef = Tcl_NewStringObj("", -1); break; - case 2: /* -permissions */ - sprintf(buf, "%03o", zFile->permissions); - *objPtrRef = Tcl_NewStringObj(buf, -1); break; + case 0: /* -group */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 1: /* -owner */ + *objPtrRef = Tcl_NewStringObj("", -1); break; + case 2: /* -permissions */ + sprintf(buf, "%03o", zFile->permissions); + *objPtrRef = Tcl_NewStringObj(buf, -1); break; #endif } - + return TCL_OK; } @@ -1466,234 +1699,185 @@ int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((Tcl_Interp *interp, #define Tobe_FSDupInternalRepProc 0 #define Tobe_FSFreeInternalRepProc 0 #define Tobe_FSFilesystemPathTypeProc 0 -#define Tobe_FSLinkProc 0 +#define Tobe_FSLinkProc 0 #else -/* Function to process a -* 'Tobe_FSLoadFile()' call. If not -* implemented, Tcl will fall back on -* a copy to native-temp followed by a -* Tobe_FSLoadFile on that temporary copy. */ -int Tobe_FSLoadFileProc _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj *pathPtr, char * sym1, char * sym2, - Tcl_PackageInitProc ** proc1Ptr, - Tcl_PackageInitProc ** proc2Ptr, - ClientData * clientDataPtr)) { return 0; } - - -/* Function to unload a previously -* successfully loaded file. If load was -* implemented, then this should also be -* implemented, if there is any cleanup -* action required. */ -void Tobe_FSUnloadFileProc _ANSI_ARGS_((ClientData clientData)) { - return; +/* + * Function to process a 'Tobe_FSLoadFile()' call. If not implemented, Tcl + * will fall back on a copy to native-temp followed by a Tobe_FSLoadFile on + * that temporary copy. + */ +int +Tobe_FSLoadFileProc( + Tcl_Interp * interp, + Tcl_Obj *pathPtr, + char * sym1, + char * sym2, + Tcl_PackageInitProc ** proc1Ptr, + Tcl_PackageInitProc ** proc2Ptr, + ClientData * clientDataPtr) +{ + return 0; } -Tcl_Obj* Tobe_FSGetCwdProc _ANSI_ARGS_((Tcl_Interp *interp)) { return 0; } -int Tobe_FSCreateDirectoryProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } -int Tobe_FSDeleteFileProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } -int Tobe_FSCopyDirectoryProc _ANSI_ARGS_((Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)) { return 0; } -int Tobe_FSCopyFileProc _ANSI_ARGS_((Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr)) { return 0; } -int Tobe_FSRemoveDirectoryProc _ANSI_ARGS_((Tcl_Obj *pathPtr, - int recursive, Tcl_Obj **errorPtr)) { return 0; } -int Tobe_FSRenameFileProc _ANSI_ARGS_((Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr)) { return 0; } +/* + * Function to unload a previously successfully loaded file. If load was + * implemented, then this should also be implemented, if there is any cleanup + * action required. + */ +void Tobe_FSUnloadFileProc(ClientData clientData) { return; } +Tcl_Obj* Tobe_FSGetCwdProc(Tcl_Interp *interp) { return 0; } +int Tobe_FSCreateDirectoryProc(Tcl_Obj *pathPtr) { return 0; } +int Tobe_FSDeleteFileProc(Tcl_Obj *pathPtr) { return 0; } +int Tobe_FSCopyDirectoryProc(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, + Tcl_Obj **errorPtr) { return 0; } +int Tobe_FSCopyFileProc(Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { return 0; } +int Tobe_FSRemoveDirectoryProc(Tcl_Obj *pathPtr, int recursive, + Tcl_Obj **errorPtr) { return 0; } +int Tobe_FSRenameFileProc(Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { return 0; } /* We have to declare the utime structure here. */ -int Tobe_FSUtimeProc _ANSI_ARGS_((Tcl_Obj *pathPtr, - struct utimbuf *tval)) { return 0; } -int Tobe_FSNormalizePathProc _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr, int nextCheckpoint)) { return 0; } -int Tobe_FSFileAttrsSetProc _ANSI_ARGS_((Tcl_Interp *interp, - int index, Tcl_Obj *pathPtr, - Tcl_Obj *objPtr)) { return 0; } -Tcl_Obj* Tobe_FSLinkProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } -Tcl_Obj* Tobe_FSFilesystemPathTypeProc - _ANSI_ARGS_((Tcl_Obj *pathPtr)) { return 0; } -void Tobe_FSFreeInternalRepProc _ANSI_ARGS_((ClientData clientData)) { return; } -ClientData Tobe_FSDupInternalRepProc - _ANSI_ARGS_((ClientData clientData)) { return 0; } -Tcl_Obj* Tobe_FSInternalToNormalizedProc - _ANSI_ARGS_((ClientData clientData)) { return 0; } -ClientData Tobe_FSCreateInternalRepProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { - return 0; -} - +int Tobe_FSUtimeProc(Tcl_Obj *pathPtr, struct utimbuf *tval) { return 0; } +int Tobe_FSNormalizePathProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, + int nextCheckpoint) { return 0; } +int Tobe_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj *objPtr) { return 0; } +Tcl_Obj* Tobe_FSLinkProc(Tcl_Obj *pathPtr) { return 0; } +Tcl_Obj* Tobe_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) { return 0; } +void Tobe_FSFreeInternalRepProc(ClientData clientData) { return; } +ClientData Tobe_FSDupInternalRepProc(ClientData clientData) { return 0; } +Tcl_Obj* Tobe_FSInternalToNormalizedProc(ClientData clientData) { return 0; } +ClientData Tobe_FSCreateInternalRepProc(Tcl_Obj *pathPtr) { return 0; } #endif - static Tcl_Filesystem Tobe_Filesystem = { - "tobe", /* The name of the filesystem. */ - sizeof(Tcl_Filesystem), /* Length of this structure, so future - * binary compatibility can be assured. */ - TCL_FILESYSTEM_VERSION_1, - /* Version of the filesystem type. */ - Tobe_FSPathInFilesystemProc, - /* Function to check whether a path is in - * this filesystem. This is the most - * important filesystem procedure. */ - Tobe_FSDupInternalRepProc, - /* Function to duplicate internal fs rep. May - * be NULL (but then fs is less efficient). */ - Tobe_FSFreeInternalRepProc, - /* Function to free internal fs rep. Must - * be implemented, if internal representations - * need freeing, otherwise it can be NULL. */ + "tobe", /* The name of the filesystem. */ + sizeof(Tcl_Filesystem), /* Length of this structure, so future binary + * compatibility can be assured. */ + TCL_FILESYSTEM_VERSION_1, /* Version of the filesystem type. */ + Tobe_FSPathInFilesystemProc,/* Function to check whether a path is in this + * filesystem. This is the most important + * filesystem procedure. */ + Tobe_FSDupInternalRepProc, /* Function to duplicate internal fs rep. May + * be NULL (but then fs is less efficient). */ + Tobe_FSFreeInternalRepProc, /* Function to free internal fs rep. Must be + * implemented, if internal representations + * need freeing, otherwise it can be NULL. */ Tobe_FSInternalToNormalizedProc, - /* Function to convert internal representation - * to a normalized path. Only required if - * the fs creates pure path objects with no - * string/path representation. */ + /* Function to convert internal representation + * to a normalized path. Only required if the + * fs creates pure path objects with no + * string/path representation. */ Tobe_FSCreateInternalRepProc, - /* Function to create a filesystem-specific - * internal representation. May be NULL - * if paths have no internal representation, - * or if the Tobe_FSPathInFilesystemProc - * for this filesystem always immediately - * creates an internal representation for - * paths it accepts. */ - Tobe_FSNormalizePathProc, - /* Function to normalize a path. Should - * be implemented for all filesystems - * which can have multiple string - * representations for the same path - * object. */ + /* Function to create a filesystem-specific + * internal representation. May be NULL if + * paths have no internal representation, or + * if the Tobe_FSPathInFilesystemProc for this + * filesystem always immediately creates an + * internal representation for paths it + * accepts. */ + Tobe_FSNormalizePathProc, /* Function to normalize a path. Should be + * implemented for all filesystems which can + * have multiple string representations for + * the same path object. */ Tobe_FSFilesystemPathTypeProc, - /* Function to determine the type of a - * path in this filesystem. May be NULL. */ + /* Function to determine the type of a path in + * this filesystem. May be NULL. */ Tobe_FSFilesystemSeparatorProc, - /* Function to return the separator - * character(s) for this filesystem. Must - * be implemented. */ - Tobe_FSStatProc, - /* - * Function to process a 'Tobe_FSStat()' - * call. Must be implemented for any - * reasonable filesystem. - */ - Tobe_FSAccessProc, - /* - * Function to process a 'Tobe_FSAccess()' - * call. Must be implemented for any - * reasonable filesystem. - */ - Tobe_FSOpenFileChannelProc, - /* - * Function to process a - * 'Tobe_FSOpenFileChannel()' call. Must be - * implemented for any reasonable - * filesystem. - */ - Tobe_FSMatchInDirectoryProc, - /* Function to process a - * 'Tobe_FSMatchInDirectory()'. If not - * implemented, then glob and recursive - * copy functionality will be lacking in - * the filesystem. */ - Tobe_FSUtimeProc, - /* Function to process a - * 'Tobe_FSUtime()' call. Required to - * allow setting (not reading) of times - * with 'file mtime', 'file atime' and - * the open-r/open-w/fcopy implementation - * of 'file copy'. */ - Tobe_FSLinkProc, - /* Function to process a - * 'Tobe_FSLink()' call. Should be - * implemented only if the filesystem supports - * links. */ - Tobe_FSListVolumesProc, - /* Function to list any filesystem volumes - * added by this filesystem. Should be - * implemented only if the filesystem adds - * volumes at the head of the filesystem. */ - Tobe_FSFileAttrStringsProc, - /* Function to list all attributes strings - * which are valid for this filesystem. - * If not implemented the filesystem will - * not support the 'file attributes' command. - * This allows arbitrary additional information - * to be attached to files in the filesystem. */ - Tobe_FSFileAttrsGetProc, - /* Function to process a - * 'Tobe_FSFileAttrsGet()' call, used by - * 'file attributes'. */ - Tobe_FSFileAttrsSetProc, - /* Function to process a - * 'Tobe_FSFileAttrsSet()' call, used by - * 'file attributes'. */ - Tobe_FSCreateDirectoryProc, - /* Function to process a - * 'Tobe_FSCreateDirectory()' call. Should - * be implemented unless the FS is - * read-only. */ - Tobe_FSRemoveDirectoryProc, - /* Function to process a - * 'Tobe_FSRemoveDirectory()' call. Should - * be implemented unless the FS is - * read-only. */ - Tobe_FSDeleteFileProc, - /* Function to process a - * 'Tobe_FSDeleteFile()' call. Should - * be implemented unless the FS is - * read-only. */ - Tobe_FSCopyFileProc, - /* Function to process a - * 'Tobe_FSCopyFile()' call. If not - * implemented Tcl will fall back - * on open-r, open-w and fcopy as - * a copying mechanism. */ - Tobe_FSRenameFileProc, - /* Function to process a - * 'Tobe_FSRenameFile()' call. If not - * implemented, Tcl will fall back on - * a copy and delete mechanism. */ - Tobe_FSCopyDirectoryProc, - /* Function to process a - * 'Tobe_FSCopyDirectory()' call. If - * not implemented, Tcl will fall back - * on a recursive create-dir, file copy - * mechanism. */ - Tobe_FSLoadFileProc, - /* Function to process a - * 'Tobe_FSLoadFile()' call. If not - * implemented, Tcl will fall back on - * a copy to native-temp followed by a - * Tobe_FSLoadFile on that temporary copy. */ - Tobe_FSUnloadFileProc, - /* Function to unload a previously - * successfully loaded file. If load was - * implemented, then this should also be - * implemented, if there is any cleanup - * action required. */ - Tobe_FSGetCwdProc, - /* - * Function to process a 'Tobe_FSGetCwd()' - * call. Most filesystems need not - * implement this. It will usually only be - * called once, if 'getcwd' is called - * before 'chdir'. May be NULL. - */ - Tobe_FSChdirProc, - /* - * Function to process a 'Tobe_FSChdir()' - * call. If filesystems do not implement - * this, it will be emulated by a series of - * directory access checks. Otherwise, - * virtual filesystems which do implement - * it need only respond with a positive - * return result if the dirName is a valid - * directory in their filesystem. They - * need not remember the result, since that - * will be automatically remembered for use - * by GetCwd. Real filesystems should - * carry out the correct action (i.e. call - * the correct system 'chdir' api). If not - * implemented, then 'cd' and 'pwd' will - * fail inside the filesystem. - */ + /* Function to return the separator + * character(s) for this filesystem. Must be + * implemented. */ + Tobe_FSStatProc, /* Function to process a 'Tobe_FSStat()' call. + * Must be implemented for any reasonable + * filesystem. */ + Tobe_FSAccessProc, /* Function to process a 'Tobe_FSAccess()' + * call. Must be implemented for any + * reasonable filesystem. */ + Tobe_FSOpenFileChannelProc, /* Function to process a + * 'Tobe_FSOpenFileChannel()' call. Must be + * implemented for any reasonable + * filesystem. */ + Tobe_FSMatchInDirectoryProc,/* Function to process a + * 'Tobe_FSMatchInDirectory()'. If not + * implemented, then glob and recursive copy + * functionality will be lacking in the + * filesystem. */ + Tobe_FSUtimeProc, /* Function to process a 'Tobe_FSUtime()' + * call. Required to allow setting (not + * reading) of times with 'file mtime', 'file + * atime' and the open-r/open-w/fcopy + * implementation of 'file copy'. */ + Tobe_FSLinkProc, /* Function to process a 'Tobe_FSLink()' call. + * Should be implemented only if the + * filesystem supports links. */ + Tobe_FSListVolumesProc, /* Function to list any filesystem volumes + * added by this filesystem. Should be + * implemented only if the filesystem adds + * volumes at the head of the filesystem. */ + Tobe_FSFileAttrStringsProc, /* Function to list all attributes strings + * which are valid for this filesystem. If + * not implemented the filesystem will not + * support the 'file attributes' command. + * This allows arbitrary additional + * information to be attached to files in the + * filesystem. */ + Tobe_FSFileAttrsGetProc, /* Function to process a + * 'Tobe_FSFileAttrsGet()' call, used by 'file + * attributes'. */ + Tobe_FSFileAttrsSetProc, /* Function to process a + * 'Tobe_FSFileAttrsSet()' call, used by 'file + * attributes'. */ + Tobe_FSCreateDirectoryProc, /* Function to process a + * 'Tobe_FSCreateDirectory()' call. Should be + * implemented unless the FS is read-only. */ + Tobe_FSRemoveDirectoryProc, /* Function to process a + * 'Tobe_FSRemoveDirectory()' call. Should be + * implemented unless the FS is read-only. */ + Tobe_FSDeleteFileProc, /* Function to process a 'Tobe_FSDeleteFile()' + * call. Should be implemented unless the FS + * is read-only. */ + Tobe_FSCopyFileProc, /* Function to process a 'Tobe_FSCopyFile()' + * call. If not implemented Tcl will fall + * back on open-r, open-w and fcopy as a + * copying mechanism. */ + Tobe_FSRenameFileProc, /* Function to process a 'Tobe_FSRenameFile()' + * call. If not implemented, Tcl will fall + * back on a copy and delete mechanism. */ + Tobe_FSCopyDirectoryProc, /* Function to process a + * 'Tobe_FSCopyDirectory()' call. If not + * implemented, Tcl will fall back on a + * recursive create-dir, file copy + * mechanism. */ + Tobe_FSLoadFileProc, /* Function to process a 'Tobe_FSLoadFile()' + * call. If not implemented, Tcl will fall + * back on a copy to native-temp followed by a + * Tobe_FSLoadFile on that temporary copy. */ + Tobe_FSUnloadFileProc, /* Function to unload a previously + * successfully loaded file. If load was + * implemented, then this should also be + * implemented, if there is any cleanup action + * required. */ + Tobe_FSGetCwdProc, /* Function to process a 'Tobe_FSGetCwd()' + * call. Most filesystems need not implement + * this. It will usually only be called once, + * if 'getcwd' is called before 'chdir'. May + * be NULL. */ + Tobe_FSChdirProc, /* Function to process a 'Tobe_FSChdir()' + * call. If filesystems do not implement this, + * it will be emulated by a series of + * directory access checks. Otherwise, virtual + * filesystems which do implement it need only + * respond with a positive return result if + * the dirName is a valid directory in their + * filesystem. They need not remember the + * result, since that will be automatically + * remembered for use by GetCwd. Real + * filesystems should carry out the correct + * action (i.e. call the correct system + * 'chdir' api). If not implemented, then 'cd' + * and 'pwd' will fail inside the + * filesystem. */ }; #endif @@ -1707,490 +1891,562 @@ static int ZvfsDumpObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj static int ZvfsStartObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); /* -** Initialize the ZVFS system. -*/ -int Zvfs_doInit(Tcl_Interp *interp, int safe){ - int n; + * Initialize the ZVFS system. + */ +int +Zvfs_doInit( + Tcl_Interp *interp, + int safe) +{ + int n; #ifdef USE_TCL_STUBS - if( Tcl_InitStubs(interp,"8.0",0)==0 ){ - return TCL_ERROR; - } + if( Tcl_InitStubs(interp,"8.0",0)==0 ){ + return TCL_ERROR; + } #endif - Tcl_StaticPackage(interp, "zvfs", Tcl_Zvfs_Init, Tcl_Zvfs_SafeInit); - if (!safe) { - Tcl_CreateCommand(interp, "zvfs::mount", ZvfsMountCmd, 0, 0); - Tcl_CreateCommand(interp, "zvfs::unmount", ZvfsUnmountCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::append", ZvfsAppendObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::add", ZvfsAddObjCmd, 0, 0); - } - Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::dump", ZvfsDumpObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::start", ZvfsStartObjCmd, 0, 0); - Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); -/* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ + Tcl_StaticPackage(interp, "zvfs", Tcl_Zvfs_Init, Tcl_Zvfs_SafeInit); + if (!safe) { + Tcl_CreateCommand(interp, "zvfs::mount", ZvfsMountCmd, 0, 0); + Tcl_CreateCommand(interp, "zvfs::unmount", ZvfsUnmountCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::append", ZvfsAppendObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::add", ZvfsAddObjCmd, 0, 0); + } + Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::dump", ZvfsDumpObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::start", ZvfsStartObjCmd, 0, 0); + Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); + /* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ #ifndef USE_TCL_VFS - Tcl_GlobalEval(interp, zFileCopy); + Tcl_GlobalEval(interp, zFileCopy); #endif - if( !local.isInit ){ - /* One-time initialization of the ZVFS */ + if( !local.isInit ){ + /* One-time initialization of the ZVFS */ #ifdef USE_TCL_VFS - n = Tcl_FSRegister(0, &Tobe_Filesystem); + n = Tcl_FSRegister(0, &Tobe_Filesystem); #else - extern void TclAccessInsertProc(); - extern void TclStatInsertProc(); - extern void TclOpenFileChannelInsertProc(); - TclAccessInsertProc(ZvfsFileAccess); - TclStatInsertProc(ZvfsFileStat); - TclOpenFileChannelInsertProc(ZvfsFileOpen); + extern void TclAccessInsertProc(); + extern void TclStatInsertProc(); + extern void TclOpenFileChannelInsertProc(); + + TclAccessInsertProc(ZvfsFileAccess); + TclStatInsertProc(ZvfsFileStat); + TclOpenFileChannelInsertProc(ZvfsFileOpen); #endif - Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); - local.isInit = 1; - } - if (Zvfs_PostInit) Zvfs_PostInit(interp); - return TCL_OK; + Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); + local.isInit = 1; + } + if (Zvfs_PostInit) { + Zvfs_PostInit(interp); + } + return TCL_OK; } -int Tcl_Zvfs_Init(Tcl_Interp *interp){ - return Zvfs_doInit(interp,0); +int +Tcl_Zvfs_Init( + Tcl_Interp *interp) +{ + return Zvfs_doInit(interp,0); } -int Tcl_Zvfs_SafeInit(Tcl_Interp *interp){ - return Zvfs_doInit(interp,1); +int +Tcl_Zvfs_SafeInit( + Tcl_Interp *interp) +{ + return Zvfs_doInit(interp,1); } - /************************************************************************/ /************************************************************************/ /************************************************************************/ /* -** Implement the zvfs::dump command -** -** zvfs::dump ARCHIVE -** -** Each entry in the list returned is of the following form: -** -** {FILENAME DATE-TIME SPECIAL-FLAG OFFSET SIZE COMPRESSED-SIZE} -** -*/ -static int ZvfsDumpObjCmd( - void *NotUsed, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv /* Values of all arguments */ -){ - char *zFilename; - Tcl_Channel chan; - ZFile *pList; - int rc; - Tcl_Obj *pResult; - - if( objc!=2 ){ - Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); - return TCL_ERROR; - } - zFilename = Tcl_GetString(objv[1]); - chan = Tcl_OpenFileChannel(interp, zFilename, "r", 0); - if( chan==0 ) return TCL_ERROR; - rc = ZvfsReadTOC(interp, chan, &pList); - if( rc==TCL_ERROR ){ - deleteZFileList(pList); - return rc; - } - Tcl_Close(interp, chan); - pResult = Tcl_GetObjResult(interp); - while( pList ){ - Tcl_Obj *pEntry = Tcl_NewObj(); - ZFile *pNext; - char zDateTime[100]; - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewStringObj(pList->zName,-1)); - translateDosTimeDate(zDateTime, pList->dosDate, pList->dosTime); - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewStringObj(zDateTime, -1)); - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->isSpecial)); - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->iOffset)); - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByte)); - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByteCompr)); - Tcl_ListObjAppendElement(interp, pResult, pEntry); - pNext = pList->pNext; - Tcl_Free((char*)pList); - pList = pList->pNext; - } - return TCL_OK; + * Implement the zvfs::dump command + * + * zvfs::dump ARCHIVE + * + * Each entry in the list returned is of the following form: + * + * {FILENAME DATE-TIME SPECIAL-FLAG OFFSET SIZE COMPRESSED-SIZE} + */ +static int +ZvfsDumpObjCmd( + void *NotUsed, /* Client data for this command */ + Tcl_Interp *interp, /* The interpreter used to report errors */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv) /* Values of all arguments */ +{ + char *zFilename; + Tcl_Channel chan; + ZFile *pList; + int rc; + Tcl_Obj *pResult; + + if( objc!=2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); + return TCL_ERROR; + } + zFilename = Tcl_GetString(objv[1]); + chan = Tcl_OpenFileChannel(interp, zFilename, "r", 0); + if( chan==0 ) { + return TCL_ERROR; + } + rc = ZvfsReadTOC(interp, chan, &pList); + if( rc==TCL_ERROR ){ + deleteZFileList(pList); + return rc; + } + Tcl_Close(interp, chan); + pResult = Tcl_GetObjResult(interp); + while( pList ){ + Tcl_Obj *pEntry = Tcl_NewObj(); + ZFile *pNext; + char zDateTime[100]; + + Tcl_ListObjAppendElement(interp, pEntry, + Tcl_NewStringObj(pList->zName,-1)); + translateDosTimeDate(zDateTime, pList->dosDate, pList->dosTime); + Tcl_ListObjAppendElement(interp, pEntry, + Tcl_NewStringObj(zDateTime, -1)); + Tcl_ListObjAppendElement(interp, pEntry, + Tcl_NewIntObj(pList->isSpecial)); + Tcl_ListObjAppendElement(interp, pEntry, + Tcl_NewIntObj(pList->iOffset)); + Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByte)); + Tcl_ListObjAppendElement(interp, pEntry, + Tcl_NewIntObj(pList->nByteCompr)); + Tcl_ListObjAppendElement(interp, pResult, pEntry); + pNext = pList->pNext; + Tcl_Free((char*)pList); + pList = pList->pNext; + } + return TCL_OK; } /* -** Write a file record into a ZIP archive at the current position of -** the write cursor for channel "chan". Add a ZFile record for the file -** to *ppList. If an error occurs, leave an error message on interp -** and return TCL_ERROR. Otherwise return TCL_OK. -*/ -static int writeFile( - Tcl_Interp *interp, /* Leave an error message here */ - Tcl_Channel out, /* Write the file here */ - Tcl_Channel in, /* Read data from this file */ - char *zSrc, /* Name the new ZIP file entry this */ - char *zDest, /* Name the new ZIP file entry this */ - ZFile **ppList /* Put a ZFile struct for the new file here */ -){ - z_stream stream; - ZFile *p; - int iEndOfData; - int nameLen; - int skip; - int toOut; - char zHdr[30]; - char zInBuf[100000]; - char zOutBuf[100000]; - struct tm *tm; - time_t now; - struct stat stat; - - /* Create a new ZFile structure for this file. - * TODO: fill in date/time etc. - */ - nameLen = strlen(zDest); - p = newZFile(nameLen, ppList); - strcpy(p->zName, zDest); - p->isSpecial = 0; - Tcl_Stat(zSrc, &stat); - now=stat.st_mtime; - tm = localtime(&now); - UnixTimeDate(tm, &p->dosDate, &p->dosTime); - p->iOffset = Tcl_Tell(out); - p->nByte = 0; - p->nByteCompr = 0; - p->nExtra = 0; - p->iCRC = 0; - p->permissions = stat.st_mode; - - /* Fill in as much of the header as we know. - */ - put32(&zHdr[0], 0x04034b50); - put16(&zHdr[4], 0x0014); - put16(&zHdr[6], 0); - put16(&zHdr[8], 8); - put16(&zHdr[10], p->dosTime); - put16(&zHdr[12], p->dosDate); - put16(&zHdr[26], nameLen); - put16(&zHdr[28], 0); - - /* Write the header and filename. - */ - Tcl_Write(out, zHdr, 30); - Tcl_Write(out, zDest, nameLen); - - /* The first two bytes that come out of the deflate compressor are - ** some kind of header that ZIP does not use. So skip the first two - ** output bytes. - */ - skip = 2; - - /* Write the compressed file. Compute the CRC as we progress. - */ - stream.zalloc = (alloc_func)0; - stream.zfree = (free_func)0; - stream.opaque = 0; - stream.avail_in = 0; - stream.next_in = zInBuf; - stream.avail_out = sizeof(zOutBuf); - stream.next_out = zOutBuf; + * Write a file record into a ZIP archive at the current position of the write + * cursor for channel "chan". Add a ZFile record for the file to *ppList. If + * an error occurs, leave an error message on interp and return TCL_ERROR. + * Otherwise return TCL_OK. + */ +static int +writeFile( + Tcl_Interp *interp, /* Leave an error message here */ + Tcl_Channel out, /* Write the file here */ + Tcl_Channel in, /* Read data from this file */ + char *zSrc, /* Name the new ZIP file entry this */ + char *zDest, /* Name the new ZIP file entry this */ + ZFile **ppList) /* Put a ZFile struct for the new file here */ +{ + z_stream stream; + ZFile *p; + int iEndOfData; + int nameLen; + int skip; + int toOut; + char zHdr[30]; + char zInBuf[100000]; + char zOutBuf[100000]; + struct tm *tm; + time_t now; + struct stat stat; + + /* + * Create a new ZFile structure for this file. + * TODO: fill in date/time etc. + */ + nameLen = strlen(zDest); + p = newZFile(nameLen, ppList); + strcpy(p->zName, zDest); + p->isSpecial = 0; + Tcl_Stat(zSrc, &stat); + now=stat.st_mtime; + tm = localtime(&now); + UnixTimeDate(tm, &p->dosDate, &p->dosTime); + p->iOffset = Tcl_Tell(out); + p->nByte = 0; + p->nByteCompr = 0; + p->nExtra = 0; + p->iCRC = 0; + p->permissions = stat.st_mode; + + /* + * Fill in as much of the header as we know. + */ + + put32(&zHdr[0], 0x04034b50); + put16(&zHdr[4], 0x0014); + put16(&zHdr[6], 0); + put16(&zHdr[8], 8); + put16(&zHdr[10], p->dosTime); + put16(&zHdr[12], p->dosDate); + put16(&zHdr[26], nameLen); + put16(&zHdr[28], 0); + + /* + * Write the header and filename. + */ + + Tcl_Write(out, zHdr, 30); + Tcl_Write(out, zDest, nameLen); + + /* + * The first two bytes that come out of the deflate compressor are some + * kind of header that ZIP does not use. So skip the first two output + * bytes. + */ + + skip = 2; + + /* + * Write the compressed file. Compute the CRC as we progress. + */ + + stream.zalloc = (alloc_func)0; + stream.zfree = (free_func)0; + stream.opaque = 0; + stream.avail_in = 0; + stream.next_in = zInBuf; + stream.avail_out = sizeof(zOutBuf); + stream.next_out = zOutBuf; #if 1 - deflateInit(&stream, 9); + deflateInit(&stream, 9); #else - { - int i, err, WSIZE = 0x8000, windowBits, level=6; - for (i = ((unsigned)WSIZE), windowBits = 0; i != 1; i >>= 1, ++windowBits); - err = deflateInit2(&stream, level, Z_DEFLATED, -windowBits, 8, 0); + { + int i, err, WSIZE = 0x8000, windowBits, level=6; - } + for (i = ((unsigned)WSIZE), windowBits = 0; i != 1; i >>= 1, ++windowBits); + err = deflateInit2(&stream, level, Z_DEFLATED, -windowBits, 8, 0); + } #endif - p->iCRC = crc32(0, 0, 0); - while( !Tcl_Eof(in) ){ - if( stream.avail_in==0 ){ - int amt = Tcl_Read(in, zInBuf, sizeof(zInBuf)); - if( amt<=0 ) break; - p->iCRC = crc32(p->iCRC, zInBuf, amt); - stream.avail_in = amt; - stream.next_in = zInBuf; - } - deflate(&stream, 0); - toOut = sizeof(zOutBuf) - stream.avail_out; - if( toOut>skip ){ - Tcl_Write(out, &zOutBuf[skip], toOut - skip); - skip = 0; - }else{ - skip -= toOut; + + p->iCRC = crc32(0, 0, 0); + while( !Tcl_Eof(in) ){ + if( stream.avail_in==0 ){ + int amt = Tcl_Read(in, zInBuf, sizeof(zInBuf)); + + if( amt<=0 ) { + break; + } + p->iCRC = crc32(p->iCRC, zInBuf, amt); + stream.avail_in = amt; + stream.next_in = zInBuf; + } + deflate(&stream, 0); + toOut = sizeof(zOutBuf) - stream.avail_out; + if( toOut>skip ){ + Tcl_Write(out, &zOutBuf[skip], toOut - skip); + skip = 0; + }else{ + skip -= toOut; + } + stream.avail_out = sizeof(zOutBuf); + stream.next_out = zOutBuf; } - stream.avail_out = sizeof(zOutBuf); - stream.next_out = zOutBuf; - } - do{ - stream.avail_out = sizeof(zOutBuf); - stream.next_out = zOutBuf; - deflate(&stream, Z_FINISH); - toOut = sizeof(zOutBuf) - stream.avail_out; - if( toOut>skip ){ - Tcl_Write(out, &zOutBuf[skip], toOut - skip); - skip = 0; - }else{ - skip -= toOut; - } - }while( stream.avail_out==0 ); - p->nByte = stream.total_in; - p->nByteCompr = stream.total_out - 2; - deflateEnd(&stream); - Tcl_Flush(out); - - /* Remember were we are in the file. Then go back and write the - ** header, now that we know the compressed file size. - */ - iEndOfData = Tcl_Tell(out); - Tcl_Seek(out, p->iOffset, SEEK_SET); - put32(&zHdr[14], p->iCRC); - put32(&zHdr[18], p->nByteCompr); - put32(&zHdr[22], p->nByte); - Tcl_Write(out, zHdr, 30); - Tcl_Seek(out, iEndOfData, SEEK_SET); - - /* Close the input file. - */ - Tcl_Close(interp, in); - - /* Finished! - */ - return TCL_OK; + do{ + stream.avail_out = sizeof(zOutBuf); + stream.next_out = zOutBuf; + deflate(&stream, Z_FINISH); + toOut = sizeof(zOutBuf) - stream.avail_out; + if( toOut>skip ){ + Tcl_Write(out, &zOutBuf[skip], toOut - skip); + skip = 0; + }else{ + skip -= toOut; + } + }while( stream.avail_out==0 ); + p->nByte = stream.total_in; + p->nByteCompr = stream.total_out - 2; + deflateEnd(&stream); + Tcl_Flush(out); + + /* + * Remember were we are in the file. Then go back and write the header, + * now that we know the compressed file size. + */ + + iEndOfData = Tcl_Tell(out); + Tcl_Seek(out, p->iOffset, SEEK_SET); + put32(&zHdr[14], p->iCRC); + put32(&zHdr[18], p->nByteCompr); + put32(&zHdr[22], p->nByte); + Tcl_Write(out, zHdr, 30); + Tcl_Seek(out, iEndOfData, SEEK_SET); + + /* + * Close the input file. + */ + + Tcl_Close(interp, in); + return TCL_OK; } /* -** The arguments are two lists of ZFile structures sorted by iOffset. -** Either or both list may be empty. This routine merges the two -** lists together into a single sorted list and returns a pointer -** to the head of the unified list. -** -** This is part of the merge-sort algorithm. -*/ -static ZFile *mergeZFiles(ZFile *pLeft, ZFile *pRight){ - ZFile fakeHead; - ZFile *pTail; - - pTail = &fakeHead; - while( pLeft && pRight ){ - ZFile *p; - if( pLeft->iOffset <= pRight->iOffset ){ - p = pLeft; - pLeft = p->pNext; + * The arguments are two lists of ZFile structures sorted by iOffset. Either + * or both list may be empty. This routine merges the two lists together into + * a single sorted list and returns a pointer to the head of the unified list. + * + * This is part of the merge-sort algorithm. + */ +static ZFile * +mergeZFiles( + ZFile *pLeft, + ZFile *pRight) +{ + ZFile fakeHead; + ZFile *pTail; + + pTail = &fakeHead; + while( pLeft && pRight ){ + ZFile *p; + + if( pLeft->iOffset <= pRight->iOffset ){ + p = pLeft; + pLeft = p->pNext; + }else{ + p = pRight; + pRight = p->pNext; + } + pTail->pNext = p; + pTail = p; + } + if( pLeft ){ + pTail->pNext = pLeft; + }else if( pRight ){ + pTail->pNext = pRight; }else{ - p = pRight; - pRight = p->pNext; - } - pTail->pNext = p; - pTail = p; - } - if( pLeft ){ - pTail->pNext = pLeft; - }else if( pRight ){ - pTail->pNext = pRight; - }else{ - pTail->pNext = 0; - } - return fakeHead.pNext; + pTail->pNext = 0; + } + return fakeHead.pNext; } /* -** Sort a ZFile list so in accending order by iOffset. -*/ -static ZFile *sortZFiles(ZFile *pList){ -# define NBIN 30 - int i; - ZFile *p; - ZFile *aBin[NBIN+1]; - - for(i=0; i<=NBIN; i++) aBin[i] = 0; - while( pList ){ - p = pList; - pList = p->pNext; - p->pNext = 0; - for(i=0; ipNext; + p->pNext = 0; + for(i=0; ipNext){ - if( pList->isSpecial ) continue; - put32(&zBuf[0], 0x02014b50); - put16(&zBuf[4], 0x0317); - put16(&zBuf[6], 0x0014); - put16(&zBuf[8], 0); - put16(&zBuf[10], pList->nByte>pList->nByteCompr ? 0x0008 : 0x0000); - put16(&zBuf[12], pList->dosTime); - put16(&zBuf[14], pList->dosDate); - put32(&zBuf[16], pList->iCRC); - put32(&zBuf[20], pList->nByteCompr); - put32(&zBuf[24], pList->nByte); - put16(&zBuf[28], strlen(pList->zName)); - put16(&zBuf[30], 0); - put16(&zBuf[32], pList->nExtra); - put16(&zBuf[34], 1); - put16(&zBuf[36], 0); - put32(&zBuf[38], pList->permissions<<16); - put32(&zBuf[42], pList->iOffset); - Tcl_Write(chan, zBuf, 46); - Tcl_Write(chan, pList->zName, strlen(pList->zName)); - for(i=pList->nExtra; i>0; i-=40){ - int toWrite = i<40 ? i : 40; - Tcl_Write(chan," ",toWrite); - } - nEntry++; - } - iTocEnd = Tcl_Tell(chan); - put32(&zBuf[0], 0x06054b50); - put16(&zBuf[4], 0); - put16(&zBuf[6], 0); - put16(&zBuf[8], nEntry); - put16(&zBuf[10], nEntry); - put32(&zBuf[12], iTocEnd - iTocStart); - put32(&zBuf[16], iTocStart); - put16(&zBuf[20], 0); - Tcl_Write(chan, zBuf, 22); - Tcl_Flush(chan); + * Write a ZIP archive table of contents to the given channel. + */ +static void +writeTOC( + Tcl_Channel chan, + ZFile *pList) +{ + int iTocStart, iTocEnd; + int nEntry = 0; + int i; + char zBuf[100]; + + iTocStart = Tcl_Tell(chan); + for(; pList; pList=pList->pNext){ + if( pList->isSpecial ) { + continue; + } + put32(&zBuf[0], 0x02014b50); + put16(&zBuf[4], 0x0317); + put16(&zBuf[6], 0x0014); + put16(&zBuf[8], 0); + put16(&zBuf[10], pList->nByte>pList->nByteCompr ? 0x0008 : 0x0000); + put16(&zBuf[12], pList->dosTime); + put16(&zBuf[14], pList->dosDate); + put32(&zBuf[16], pList->iCRC); + put32(&zBuf[20], pList->nByteCompr); + put32(&zBuf[24], pList->nByte); + put16(&zBuf[28], strlen(pList->zName)); + put16(&zBuf[30], 0); + put16(&zBuf[32], pList->nExtra); + put16(&zBuf[34], 1); + put16(&zBuf[36], 0); + put32(&zBuf[38], pList->permissions<<16); + put32(&zBuf[42], pList->iOffset); + Tcl_Write(chan, zBuf, 46); + Tcl_Write(chan, pList->zName, strlen(pList->zName)); + for(i=pList->nExtra; i>0; i-=40){ + int toWrite = i<40 ? i : 40; + + /* CAREFUL! String below is intentionally 40 spaces! */ + Tcl_Write(chan," ", + toWrite); + } + nEntry++; + } + iTocEnd = Tcl_Tell(chan); + put32(&zBuf[0], 0x06054b50); + put16(&zBuf[4], 0); + put16(&zBuf[6], 0); + put16(&zBuf[8], nEntry); + put16(&zBuf[10], nEntry); + put32(&zBuf[12], iTocEnd - iTocStart); + put32(&zBuf[16], iTocStart); + put16(&zBuf[20], 0); + Tcl_Write(chan, zBuf, 22); + Tcl_Flush(chan); } - /* -** Implementation of the zvfs::append command. -** -** zvfs::append ARCHIVE (SOURCE DESTINATION)* -** -** This command reads SOURCE files and appends them (using the name -** DESTINATION) to the zip archive named ARCHIVE. A new zip archive -** is created if it does not already exist. If ARCHIVE refers to a -** file which exists but is not a zip archive, then this command -** turns ARCHIVE into a zip archive by appending the necessary -** records and the table of contents. Treat all files as binary. -** -** Note: No dup checking is done, so multiple occurances of the -** same file is allowed. -*/ -static int ZvfsAppendObjCmd( - void *NotUsed, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv /* Values of all arguments */ -){ - char *zArchive; - Tcl_Channel chan; - ZFile *pList = NULL, *pToc; - int rc = TCL_OK, i; - - /* Open the archive and read the table of contents - */ - if( objc<2 || (objc&1)!=0 ){ - Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE (SRC DEST)+"); - return TCL_ERROR; - } - - zArchive = Tcl_GetString(objv[1]); - chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); - if( chan==0 ) { - chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); - } - if( chan==0 ) return TCL_ERROR; - if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") - || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") - ){ - /* this should never happen */ - Tcl_Close(0, chan); - return TCL_ERROR; - } - - if (Tcl_Seek(chan, 0, SEEK_END) == 0) { - /* Null file is ok, we're creating new one. */ - } else { - Tcl_Seek(chan, 0, SEEK_SET); - rc = ZvfsReadTOC(interp, chan, &pList); - if( rc==TCL_ERROR ){ - deleteZFileList(pList); - Tcl_Close(interp, chan); - return rc; - } else rc=TCL_OK; - } - - /* Move the file pointer to the start of - ** the table of contents. - */ - for(pToc=pList; pToc; pToc=pToc->pNext){ - if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) break; - } - if( pToc ){ - Tcl_Seek(chan, pToc->iOffset, SEEK_SET); - }else{ - Tcl_Seek(chan, 0, SEEK_END); - } - - /* Add new files to the end of the archive. - */ - for(i=2; rc==TCL_OK && ipNext){ + if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) { + break; + } + } + if( pToc ){ + Tcl_Seek(chan, pToc->iOffset, SEEK_SET); + }else{ + Tcl_Seek(chan, 0, SEEK_END); + } + + /* + * Add new files to the end of the archive. + */ + + for(i=2; rc==TCL_OK && i p)) { p = NULL; @@ -2209,175 +2466,192 @@ GetExtension( CONST char *name) } /* -** Implementation of the zvfs::add command. -** -** zvfs::add ?-fconfigure optpairs? ARCHIVE FILE1 FILE2 ... -** -** This command is similar to append in that it adds files to the zip -** archive named ARCHIVE, however file names are relative the current directory. -** In addition, fconfigure is used to apply option pairs to set upon opening -** of each file. Otherwise, default translation is allowed -** for those file extensions listed in the ::zvfs::auto_ext var. -** Binary translation will be used for unknown extensions. -** -** NOTE Use '-fconfigure {}' to use auto translation for all. -*/ -static int ZvfsAddObjCmd( - void *NotUsed, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *CONST* objv /* Values of all arguments */ -){ - char *zArchive; - Tcl_Channel chan; - ZFile *pList = NULL, *pToc; - int rc = TCL_OK, i, j, oLen; - char *zOpts = NULL; - Tcl_Obj *confOpts = NULL; - int tobjc; - Tcl_Obj **tobjv; - Tcl_Obj *varObj = NULL; - - /* Open the archive and read the table of contents - */ - if (objc>3) { - zOpts = Tcl_GetStringFromObj(objv[1], &oLen); - if (!strncmp("-fconfigure", zOpts, oLen)) { - confOpts = objv[2]; - if (TCL_OK != Tcl_ListObjGetElements(interp, confOpts, &tobjc, &tobjv) || (tobjc%2)) { - return TCL_ERROR; - } - objc -= 2; - objv += 2; - } - } - if( objc==2) { - return TCL_OK; - } - - if( objc<3) { - Tcl_WrongNumArgs(interp, 1, objv, "?-fconfigure OPTPAIRS? ARCHIVE FILE1 FILE2 .."); - return TCL_ERROR; - } - zArchive = Tcl_GetString(objv[1]); - chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); - if( chan==0 ) { - chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); - } - if( chan==0 ) return TCL_ERROR; - if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") - || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") - ){ - /* this should never happen */ - Tcl_Close(0, chan); - return TCL_ERROR; - } - - if (Tcl_Seek(chan, 0, SEEK_END) == 0) { - /* Null file is ok, we're creating new one. */ - } else { - Tcl_Seek(chan, 0, SEEK_SET); - rc = ZvfsReadTOC(interp, chan, &pList); - if( rc==TCL_ERROR ){ - deleteZFileList(pList); - Tcl_Close(interp, chan); - return rc; - } else rc=TCL_OK; - } - - /* Move the file pointer to the start of - ** the table of contents. - */ - for(pToc=pList; pToc; pToc=pToc->pNext){ - if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) break; - } - if( pToc ){ - Tcl_Seek(chan, pToc->iOffset, SEEK_SET); - }else{ - Tcl_Seek(chan, 0, SEEK_END); - } - - /* Add new files to the end of the archive. - */ - for(i=2; rc==TCL_OK && i=tobjc) { - ext = NULL; - } + if (objc>3) { + zOpts = Tcl_GetStringFromObj(objv[1], &oLen); + if (!strncmp("-fconfigure", zOpts, oLen)) { + confOpts = objv[2]; + if (TCL_OK != Tcl_ListObjGetElements(interp, confOpts, + &tobjc, &tobjv) || (tobjc%2)) { + return TCL_ERROR; } + objc -= 2; + objv += 2; } - if (ext == NULL) { - if (( Tcl_SetChannelOption(interp, in, "-translation", "binary") - || Tcl_SetChannelOption(interp, in, "-encoding", "binary")) - ) { - /* this should never happen */ - Tcl_Close(0, in); - rc = TCL_ERROR; + } + if( objc==2) { + return TCL_OK; + } + + if( objc<3) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-fconfigure OPTPAIRS? ARCHIVE FILE1 FILE2 .."); + return TCL_ERROR; + } + zArchive = Tcl_GetString(objv[1]); + chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); + if( chan==0 ) { + chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); + } + if( chan==0 ) return TCL_ERROR; + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") + || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ + /* this should never happen */ + Tcl_Close(0, chan); + return TCL_ERROR; + } + + if (Tcl_Seek(chan, 0, SEEK_END) == 0) { + /* Null file is ok, we're creating new one. */ + } else { + Tcl_Seek(chan, 0, SEEK_SET); + rc = ZvfsReadTOC(interp, chan, &pList); + if( rc==TCL_ERROR ){ + deleteZFileList(pList); + Tcl_Close(interp, chan); + return rc; + } + rc=TCL_OK; + } + + /* + * Move the file pointer to the start of the table of contents. + */ + + for(pToc=pList; pToc; pToc=pToc->pNext){ + if( pToc->isSpecial && strcmp(pToc->zName, "*TOC*")==0 ) { break; - } } - } else { - for (j=0; jiOffset, SEEK_SET); + }else{ + Tcl_Seek(chan, 0, SEEK_END); + } + + /* + * Add new files to the end of the archive. + */ + + for(i=2; rc==TCL_OK && i=tobjc) { + ext = NULL; + } + } + } + if (ext == NULL) { + if (Tcl_SetChannelOption(interp, in, "-translation", "binary") + || Tcl_SetChannelOption(interp, in, "-encoding", + "binary")) { + /* this should never happen */ + Tcl_Close(0, in); + rc = TCL_ERROR; + break; + } + } + } else { + for (j=0; j Date: Mon, 1 Sep 2014 13:51:59 +0000 Subject: Squelch most warnings. --- generic/tclZipVfs.c | 555 ++++++++++++++++++++++++++-------------------------- 1 file changed, 277 insertions(+), 278 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index a774648..8b1fc3b 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -21,6 +21,7 @@ * This version has been modified to run under Tcl 8.6 */ #include "tcl.h" +#include #include #include #include @@ -36,8 +37,8 @@ * Size of the decompression input buffer */ #define COMPR_BUF_SIZE 8192 -static int maptolower=0; -static int openarch=0; /* Set to 1 when opening archive. */ +/*TODO: use thread-local as appropriate*/ +static int openarch = 0; /* Set to 1 when opening archive. */ /* * All static variables are collected into a structure named "local". That @@ -150,7 +151,7 @@ newZFile( int nName, ZFile **ppList) { - ZFile *pNew = Tcl_Alloc( sizeof(*pNew) + nName + 1 ); + ZFile *pNew = (void *) Tcl_Alloc(sizeof(*pNew) + nName + 1); memset(pNew, 0, sizeof(*pNew)); pNew->zName = (char*)&pNew[1]; @@ -263,51 +264,50 @@ CanonicalPath( int i, j, c; #ifdef __WIN32__ - if( isalpha(zTail[0]) && zTail[1]==':' ){ + if (isalpha(zTail[0]) && zTail[1] == ':') { zTail += 2; } - if( zTail[0]=='\\' ){ + if (zTail[0] == '\\') { zRoot = ""; zTail++; } #endif - if( zTail[0]=='/' ){ + if (zTail[0] == '/') { zRoot = ""; zTail++; } - zPath = Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 ); - if( zPath==0 ) { - return 0; - } + zPath = Tcl_Alloc(strlen(zRoot) + strlen(zTail) + 2); if (zTail[0]) { sprintf(zPath, "%s/%s", zRoot, zTail); } else { strcpy(zPath, zRoot); } - for(i=j=0; (c = zPath[i])!=0; i++){ + for (i=j=0 ; (c = zPath[i]) != 0 ; i++) { #ifdef __WIN32__ - if( isupper(c) ) { + if (isupper(c)) { if (maptolower) { c = tolower(c); } - } else if( c=='\\' ) { + } else if (c == '\\') { c = '/'; } #endif - if( c=='/' ){ + if (c == '/') { int c2 = zPath[i+1]; - if( c2=='/' ) { + + if (c2 == '/') { continue; } - if( c2=='.' ){ + if (c2 == '.') { int c3 = zPath[i+2]; - if( c3=='/' || c3==0 ){ + + if (c3 == '/' || c3 == 0) { i++; continue; } - if( c3=='.' && (zPath[i+3]=='.' || zPath[i+3]==0) ){ + if (c3 == '.' && (zPath[i+3] == '.' || zPath[i+3] == 0)) { i += 2; - while( j>0 && zPath[j-1]!='/' ){ + while (j > 0 && zPath[j-1] != '/') { j--; } continue; @@ -316,7 +316,7 @@ CanonicalPath( } zPath[j++] = c; } - if( j==0 ){ + if (j == 0) { zPath[j++] = '/'; } /* if (j>1 && zPath[j-1] == '/') j--; */ @@ -340,19 +340,19 @@ AbsolutePath( if (zRelative[0] == '~' && zRelative[1] == '/') { /* TODO: do this for all paths??? */ if (Tcl_TranslateFileName(0, zRelative, &pwd) != NULL) { - zResult = CanonicalPath( "", Tcl_DStringValue(&pwd)); + zResult = CanonicalPath("", Tcl_DStringValue(&pwd)); goto done; } - } else if( zRelative[0] != '/'){ + } else if (zRelative[0] != '/') { #ifdef __WIN32__ - if(!(zRelative[0]=='\\' || (zRelative[0] && zRelative[1] == ':'))) { + if (!(zRelative[0]=='\\' || (zRelative[0] && zRelative[1] == ':'))) { /*Tcl_GetCwd(0, &pwd); */ } #else Tcl_GetCwd(0, &pwd); #endif } - zResult = CanonicalPath( Tcl_DStringValue(&pwd), zRelative); + zResult = CanonicalPath(Tcl_DStringValue(&pwd), zRelative); done: Tcl_DStringFree(&pwd); len = strlen(zResult); @@ -369,16 +369,10 @@ ZvfsReadTOCStart( ZFile **pList, int *iStart) { - char *zArchiveName = 0; /* A copy of zArchive */ int nFile; /* Number of files in the archive */ int iPos; /* Current position in the archive file */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_HashEntry *pEntry; /* Hash table entry */ - int isNew; /* Flag to tell use when a hash entry is - * new */ unsigned char zBuf[100]; /* Space into which to read from the ZIP * archive */ - Tcl_HashSearch zSearch; /* Search all mount points */ ZFile *p; int zipStart; @@ -399,7 +393,7 @@ ZvfsReadTOCStart( */ iPos = Tcl_Seek(chan, -22, SEEK_END); - Tcl_Read(chan, zBuf, 22); + Tcl_Read(chan, (char *) zBuf, 22); if (memcmp(zBuf, "\120\113\05\06", 4)) { /* Tcl_AppendResult(interp, "not a ZIP archive", NULL); */ return TCL_BREAK; @@ -415,18 +409,12 @@ ZvfsReadTOCStart( iPos -= INT32(zBuf,12); Tcl_Seek(chan, iPos, SEEK_SET); - while(1) { + while (1) { int lenName; /* Length of the next filename */ int lenExtra; /* Length of "extra" data for next file */ int iData; /* Offset to start of file data */ - int dosTime; - int dosDate; - int isdir; - ZvfsFile *pZvfs; /* A new virtual file */ - char *zFullPath; /* Full pathname of the virtual file */ - char zName[1024]; /* Space to hold the filename */ - if (nFile-- <= 0 ){ + if (nFile-- <= 0) { break; } @@ -436,7 +424,7 @@ ZvfsReadTOCStart( * archive file of the file data. */ - Tcl_Read(chan, zBuf, 46); + Tcl_Read(chan, (char *) zBuf, 46); if (memcmp(zBuf, "\120\113\01\02", 4)) { Tcl_AppendResult(interp, "ill-formed central directory entry", NULL); @@ -445,7 +433,7 @@ ZvfsReadTOCStart( lenName = INT16(zBuf,28); lenExtra = INT16(zBuf,30) + INT16(zBuf,32); iData = INT32(zBuf,42); - if (iDatazName, lenName); p->zName[lenName] = 0; - if (lenName>0 && p->zName[lenName-1] == '/') { + if (lenName > 0 && p->zName[lenName-1] == '/') { p->isSpecial = 1; } p->dosDate = INT16(zBuf, 14); @@ -489,7 +477,7 @@ ZvfsReadTOC( { int iStart; - return ZvfsReadTOCStart( interp, chan, pList, &iStart); + return ZvfsReadTOCStart(interp, chan, pList, &iStart); } /* @@ -517,7 +505,7 @@ Tcl_Zvfs_Mount( Tcl_HashSearch zSearch; /* Search all mount points */ unsigned int startZip; - if( !local.isInit ) { + if (!local.isInit) { return TCL_ERROR; } @@ -529,13 +517,14 @@ Tcl_Zvfs_Mount( Tcl_DString dStr; Tcl_DStringInit(&dStr); - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch); while (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { + pArchive = Tcl_GetHashValue(pEntry); + if (pArchive) { Tcl_DStringAppendElement(&dStr, pArchive->zName); Tcl_DStringAppendElement(&dStr, pArchive->zMountPoint); } - pEntry=Tcl_NextHashEntry(&zSearch); + pEntry = Tcl_NextHashEntry(&zSearch); } Tcl_DStringResult(interp, &dStr); return TCL_OK; @@ -547,10 +536,11 @@ Tcl_Zvfs_Mount( /*TODO: cleanup allocations of Absolute() path.*/ if (!zMountPoint) { - zTrueName=AbsolutePath(zArchive); - pEntry = Tcl_FindHashEntry(&local.archiveHash,zTrueName); + zTrueName = AbsolutePath(zArchive); + pEntry = Tcl_FindHashEntry(&local.archiveHash, zTrueName); if (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { + pArchive = Tcl_GetHashValue(pEntry); + if (pArchive) { Tcl_AppendResult(interp, pArchive->zMountPoint, 0); } } @@ -574,7 +564,7 @@ Tcl_Zvfs_Mount( */ iPos = Tcl_Seek(chan, -22, SEEK_END); - Tcl_Read(chan, zBuf, 22); + Tcl_Read(chan, (char *) zBuf, 22); if (memcmp(zBuf, "\120\113\05\06", 4)) { Tcl_AppendResult(interp, "not a ZIP archive", NULL); return TCL_ERROR; @@ -586,7 +576,7 @@ Tcl_Zvfs_Mount( zArchiveName = AbsolutePath(zArchive); pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew); - if( !isNew ){ + if (!isNew) { pArchive = Tcl_GetHashValue(pEntry); Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint, 0); @@ -603,9 +593,9 @@ Tcl_Zvfs_Mount( zMountPoint = zTrueName = AbsolutePath(zArchive); } - pArchive = Tcl_Alloc(sizeof(*pArchive) + strlen(zMountPoint)+1); + pArchive = (void *) Tcl_Alloc(sizeof(*pArchive) + strlen(zMountPoint)+1); pArchive->zName = zArchiveName; - pArchive->zMountPoint = (char*)&pArchive[1]; + pArchive->zMountPoint = (char *) &pArchive[1]; strcpy(pArchive->zMountPoint, zMountPoint); pArchive->pFiles = 0; Tcl_SetHashValue(pEntry, pArchive); @@ -615,12 +605,12 @@ Tcl_Zvfs_Mount( * iPos then seek to that location. */ - nFile = INT16(zBuf,8); - iPos -= INT32(zBuf,12); + nFile = INT16(zBuf, 8); + iPos -= INT32(zBuf, 12); Tcl_Seek(chan, iPos, SEEK_SET); startZip = iPos; - while(1) { + while (1) { int lenName; /* Length of the next filename */ int lenExtra; /* Length of "extra" data for next file */ int iData; /* Offset to start of file data */ @@ -631,7 +621,7 @@ Tcl_Zvfs_Mount( char *zFullPath; /* Full pathname of the virtual file */ char zName[1024]; /* Space to hold the filename */ - if (nFile-- <= 0 ){ + if (nFile-- <= 0) { isdir = 1; zFullPath = CanonicalPath(zMountPoint, ""); iData = startZip; @@ -644,7 +634,7 @@ Tcl_Zvfs_Mount( * archive file of the file data. */ - Tcl_Read(chan, zBuf, 46); + Tcl_Read(chan, (char *) zBuf, 46); if (memcmp(zBuf, "\120\113\01\02", 4)) { Tcl_AppendResult(interp, "ill-formed central directory entry", NULL); @@ -653,16 +643,16 @@ Tcl_Zvfs_Mount( } return TCL_ERROR; } - lenName = INT16(zBuf,28); - lenExtra = INT16(zBuf,30) + INT16(zBuf,32); - iData = INT32(zBuf,42); + lenName = INT16(zBuf, 28); + lenExtra = INT16(zBuf, 30) + INT16(zBuf, 32); + iData = INT32(zBuf, 42); /* * If the virtual filename is too big to fit in zName[], then skip * this file */ - if( lenName >= sizeof(zName) ){ + if (lenName >= sizeof(zName)) { Tcl_Seek(chan, lenName + lenExtra, SEEK_CUR); continue; } @@ -672,21 +662,21 @@ Tcl_Zvfs_Mount( */ Tcl_Read(chan, zName, lenName); - isdir=0; - if (lenName>0 && zName[lenName-1] == '/') { + isdir = 0; + if (lenName > 0 && zName[lenName-1] == '/') { lenName--; - isdir=2; + isdir = 2; } zName[lenName] = 0; zFullPath = CanonicalPath(zMountPoint, zName); addentry: - pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) ); + pZvfs = (void *) Tcl_Alloc(sizeof(*pZvfs)); pZvfs->zName = zFullPath; pZvfs->pArchive = pArchive; pZvfs->isdir = isdir; - pZvfs->depth=strchrcnt(zFullPath,'/'); + pZvfs->depth = strchrcnt(zFullPath, '/'); pZvfs->iOffset = iData; - if (iDatanByte = INT32(zBuf, 24); pZvfs->nByteCompr = INT32(zBuf, 20); pZvfs->pNext = pArchive->pFiles; - pZvfs->permissions = (0xffff&(INT32(zBuf, 38) >> 16)); + pZvfs->permissions = 0xffff & (INT32(zBuf, 38) >> 16); pArchive->pFiles = pZvfs; pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullPath, &isNew); - if( isNew ){ + if (isNew) { pZvfs->pNextName = 0; } else { ZvfsFile *pOld = Tcl_GetHashValue(pEntry); @@ -721,7 +711,7 @@ Tcl_Zvfs_Mount( Tcl_Seek(chan, lenExtra, SEEK_CUR); } Tcl_Close(interp, chan); - done: + if (zTrueName) { Tcl_Free(zTrueName); } @@ -740,7 +730,7 @@ ZvfsLookup( Tcl_HashEntry *pEntry; ZvfsFile *pFile; - if( local.isInit==0 ) { + if (local.isInit == 0) { return 0; } zTrueName = AbsolutePath(zFilename); @@ -760,19 +750,20 @@ ZvfsLookupMount( ZvfsArchive *pArchive; /* The ZIP archive being mounted */ int match=0; - if( local.isInit==0 ) { + if (local.isInit == 0) { return 0; } zTrueName = AbsolutePath(zFilename); - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + pEntry = Tcl_FirstHashEntry(&local.archiveHash, &zSearch); while (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { - if (!strcmp(pArchive->zMountPoint,zTrueName)) { - match=1; + pArchive = Tcl_GetHashValue(pEntry); + if (pArchive) { + if (!strcmp(pArchive->zMountPoint, zTrueName)) { + match = 1; break; } } - pEntry=Tcl_NextHashEntry(&zSearch); + pEntry = Tcl_NextHashEntry(&zSearch); } Tcl_Free(zTrueName); return match; @@ -793,31 +784,31 @@ Tcl_Zvfs_Umount( zArchiveName = AbsolutePath(zArchive); pEntry = Tcl_FindHashEntry(&local.archiveHash, zArchiveName); Tcl_Free(zArchiveName); - if( pEntry==0 ) { + if (pEntry == 0) { return 0; } pArchive = Tcl_GetHashValue(pEntry); Tcl_DeleteHashEntry(pEntry); Tcl_Free(pArchive->zName); - for(pFile=pArchive->pFiles; pFile; pFile=pNextFile){ + for(pFile=pArchive->pFiles ; pFile; pFile=pNextFile) { pNextFile = pFile->pNext; - if( pFile->pNextName ){ + if (pFile->pNextName) { pFile->pNextName->pPrevName = pFile->pPrevName; } - if( pFile->pPrevName ){ + if (pFile->pPrevName) { pFile->pPrevName->pNextName = pFile->pNextName; - }else{ + } else { pEntry = Tcl_FindHashEntry(&local.fileHash, pFile->zName); - if( pEntry==0 ){ + if (pEntry == 0) { Tcl_Panic("This should never happen"); - }else if( pFile->pNextName ){ + } else if (pFile->pNextName) { Tcl_SetHashValue(pEntry, pFile->pNextName); - }else{ + } else { Tcl_DeleteHashEntry(pEntry); } } Tcl_Free(pFile->zName); - Tcl_Free((char*)pFile); + Tcl_Free((void *) pFile); } return 1; } @@ -848,12 +839,12 @@ ZvfsMountCmd( const char *argv[]) /* Values of all arguments */ { /*TODO: Convert to Tcl_Obj API!*/ - if( argc>3 ){ + if (argc > 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0); return TCL_ERROR; } - return Tcl_Zvfs_Mount(interp, argc>1?argv[1]:0, argc>2?argv[2]:0); + return Tcl_Zvfs_Mount(interp, argc>1?argv[1]:NULL, argc>2?argv[2]:NULL); } /* @@ -872,7 +863,7 @@ ZvfsUnmountCmd( Tcl_HashEntry *pEntry; /* Hash table entry */ Tcl_HashSearch zSearch; /* Search all mount points */ - if( argc!=2 ){ + if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ZIP-FILE\"", 0); return TCL_ERROR; @@ -881,23 +872,24 @@ ZvfsUnmountCmd( return TCL_OK; } - if( !local.isInit ) { + if (!local.isInit) { return TCL_ERROR; } - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch); while (pEntry) { - if (((pArchive = Tcl_GetHashValue(pEntry))) - && pArchive->zMountPoint[0] + pArchive = Tcl_GetHashValue(pEntry); + if (pArchive && pArchive->zMountPoint[0] && (strcmp(pArchive->zMountPoint, argv[1]) == 0)) { if (Tcl_Zvfs_Umount(pArchive->zName)) { return TCL_OK; } break; } - pEntry=Tcl_NextHashEntry(&zSearch); + pEntry = Tcl_NextHashEntry(&zSearch); } - Tcl_AppendResult(interp, "unknown zvfs mount point or file: ", argv[1], 0); + Tcl_AppendResult(interp, "unknown zvfs mount point or file: ", argv[1], + NULL); return TCL_ERROR; } @@ -916,12 +908,12 @@ ZvfsExistsObjCmd( { char *zFilename; - if( objc!=2 ){ + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); return TCL_ERROR; } zFilename = Tcl_GetString(objv[1]); - Tcl_SetBooleanObj( Tcl_GetObjResult(interp), ZvfsLookup(zFilename)!=0); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), ZvfsLookup(zFilename)!=0); return TCL_OK; } @@ -946,13 +938,13 @@ ZvfsInfoObjCmd( char *zFilename; ZvfsFile *pFile; - if( objc!=2 ){ + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); return TCL_ERROR; } zFilename = Tcl_GetString(objv[1]); pFile = ZvfsLookup(zFilename); - if( pFile ){ + if (pFile) { Tcl_Obj *pResult = Tcl_GetObjResult(interp); Tcl_ListObjAppendElement(interp, pResult, @@ -986,55 +978,60 @@ ZvfsListObjCmd( Tcl_HashSearch sSearch; Tcl_Obj *pResult = Tcl_GetObjResult(interp); - if( objc>3 ){ + if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?PATTERN?"); return TCL_ERROR; } - if( local.isInit==0 ) { + if (local.isInit == 0) { return TCL_OK; } - if( objc==3 ){ + if (objc == 3) { int n; char *zSwitch = Tcl_GetStringFromObj(objv[1], &n); - if( n>=2 && strncmp(zSwitch,"-glob",n)==0 ){ + if (n >= 2 && strncmp(zSwitch,"-glob",n) == 0) { zPattern = Tcl_GetString(objv[2]); - }else if( n>=2 && strncmp(zSwitch,"-regexp",n)==0 ){ + } else if (n >= 2 && strncmp(zSwitch,"-regexp",n) == 0) { pRegexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); - if( pRegexp==0 ) { + if (pRegexp == 0) { return TCL_ERROR; } - }else{ + } else { Tcl_AppendResult(interp, "unknown option: ", zSwitch, 0); return TCL_ERROR; } - } else if( objc==2 ){ + } else if (objc == 2) { zPattern = Tcl_GetString(objv[1]); } - if( zPattern ){ - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + + /* + * Do the listing. + */ + + if (zPattern) { + for (pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ ZvfsFile *pFile = Tcl_GetHashValue(pEntry); char *z = pFile->zName; - if( Tcl_StringCaseMatch(z, zPattern,1) ){ + if (Tcl_StringCaseMatch(z, zPattern, 1)) { Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); } } - }else if( pRegexp ){ + } else if (pRegexp) { for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ ZvfsFile *pFile = Tcl_GetHashValue(pEntry); char *z = pFile->zName; - if( Tcl_RegExpExec(interp, pRegexp, z, z) ){ + if (Tcl_RegExpExec(interp, pRegexp, z, z)) { Tcl_ListObjAppendElement(interp, pResult, Tcl_NewStringObj(z, -1)); } } - }else{ - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + } else { + for (pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ ZvfsFile *pFile = Tcl_GetHashValue(pEntry); char *z = pFile->zName; @@ -1091,15 +1088,15 @@ vfsClose( { ZvfsChannelInfo* pInfo = instanceData; - if( pInfo->zBuf ){ - Tcl_Free(pInfo->zBuf); + if (pInfo->zBuf) { + Tcl_Free((void *) pInfo->zBuf); inflateEnd(&pInfo->stream); } - if( pInfo->chan ){ + if (pInfo->chan) { Tcl_Close(interp, pInfo->chan); Tcl_DeleteExitHandler(vfsExit, pInfo); } - Tcl_Free((char*)pInfo); + Tcl_Free((void *) pInfo); return TCL_OK; } @@ -1116,17 +1113,17 @@ vfsInput( { ZvfsChannelInfo* pInfo = instanceData; - if( toRead > pInfo->nByte ){ + if (toRead > pInfo->nByte) { toRead = pInfo->nByte; } - if( toRead == 0 ){ + if (toRead == 0) { return 0; } - if( pInfo->isCompressed ){ + if (pInfo->isCompressed) { int err = Z_OK; z_stream *stream = &pInfo->stream; - stream->next_out = buf; + stream->next_out = (unsigned char *) buf; stream->avail_out = toRead; while (stream->avail_out) { if (!stream->avail_in) { @@ -1135,7 +1132,7 @@ vfsInput( if (len > COMPR_BUF_SIZE) { len = COMPR_BUF_SIZE; } - len = Tcl_Read(pInfo->chan, pInfo->zBuf, len); + len = Tcl_Read(pInfo->chan, (char *) pInfo->zBuf, len); pInfo->nByteCompr -= len; stream->next_in = pInfo->zBuf; stream->avail_in = len; @@ -1146,15 +1143,15 @@ vfsInput( } } if (err == Z_STREAM_END) { - if ((stream->avail_out != 0)) { + if (stream->avail_out != 0) { *pErrorCode = err; /* premature end */ return -1; } - }else if( err ){ + }else if (err) { *pErrorCode = err; /* some other zlib error */ return -1; } - }else{ + } else { toRead = Tcl_Read(pInfo->chan, buf, toRead); } pInfo->nByte -= toRead; @@ -1190,7 +1187,7 @@ vfsSeek( { ZvfsChannelInfo* pInfo = instanceData; - switch( mode ){ + switch (mode) { case SEEK_CUR: offset += pInfo->readSoFar; break; @@ -1204,12 +1201,12 @@ vfsSeek( if (offset < 0) { offset = 0; } - if( !pInfo->isCompressed ){ + if (!pInfo->isCompressed) { Tcl_Seek(pInfo->chan, offset + pInfo->startOfData, SEEK_SET); pInfo->nByte = pInfo->nData; pInfo->readSoFar = offset; - }else{ - if( offsetreadSoFar ){ + } else { + if (offset < pInfo->readSoFar) { z_stream *stream = &pInfo->stream; inflateEnd(stream); @@ -1226,12 +1223,12 @@ vfsSeek( pInfo->nByteCompr = pInfo->nData; pInfo->readSoFar = 0; } - while( pInfo->readSoFar < offset ){ + while (pInfo->readSoFar < offset) { int toRead, errCode; char zDiscard[100]; toRead = offset - pInfo->readSoFar; - if( toRead>sizeof(zDiscard) ) { + if (toRead > sizeof(zDiscard)) { toRead = sizeof(zDiscard); } vfsInput(instanceData, zDiscard, toRead, &errCode); @@ -1303,13 +1300,13 @@ ZvfsFileOpen( unsigned char zBuf[50]; pFile = ZvfsLookup(zFilename); - if( pFile==0 ) { + if (pFile == 0) { return NULL; } - openarch=1; + openarch = 1; chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); - openarch=0; - if( chan==0 ){ + openarch = 0; + if (chan == 0) { return 0; } if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") @@ -1319,41 +1316,40 @@ ZvfsFileOpen( return 0; } Tcl_Seek(chan, pFile->iOffset, SEEK_SET); - Tcl_Read(chan, zBuf, 30); - if( memcmp(zBuf, "\120\113\03\04", 4) ){ - if( interp ){ + Tcl_Read(chan, (char *) zBuf, 30); + if (memcmp(zBuf, "\120\113\03\04", 4)) { + if (interp) { Tcl_AppendResult(interp, "local header mismatch: ", NULL); } Tcl_Close(interp, chan); return 0; } - pInfo = Tcl_Alloc( sizeof(*pInfo) ); + pInfo = (void *) Tcl_Alloc(sizeof(*pInfo)); pInfo->chan = chan; Tcl_CreateExitHandler(vfsExit, pInfo); pInfo->isCompressed = INT16(zBuf, 8); - if( pInfo->isCompressed ){ + if (pInfo->isCompressed) { z_stream *stream = &pInfo->stream; - pInfo->zBuf = Tcl_Alloc(COMPR_BUF_SIZE); - stream->zalloc = (alloc_func)0; - stream->zfree = (free_func)0; - stream->opaque = (voidpf)0; + pInfo->zBuf = (void *) Tcl_Alloc(COMPR_BUF_SIZE); + stream->zalloc = NULL; + stream->zfree = NULL; + stream->opaque = NULL; stream->avail_in = 2; stream->next_in = pInfo->zBuf; pInfo->zBuf[0] = 0x78; pInfo->zBuf[1] = 0x01; inflateInit(&pInfo->stream); - }else{ + } else { pInfo->zBuf = 0; } - pInfo->nByte = INT32(zBuf,22); - pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18); + pInfo->nByte = INT32(zBuf, 22); + pInfo->nByteCompr = pInfo->nData = INT32(zBuf, 18); pInfo->readSoFar = 0; - Tcl_Seek(chan, INT16(zBuf,26)+INT16(zBuf,28), SEEK_CUR); + Tcl_Seek(chan, INT16(zBuf, 26) + INT16(zBuf, 28), SEEK_CUR); pInfo->startOfData = Tcl_Tell(chan); - sprintf(zName,"vfs_%x_%x",((int)pFile)>>12,count++); - chan = Tcl_CreateChannel(&vfsChannelType, zName, - (ClientData)pInfo, TCL_READABLE); + sprintf(zName, "vfs_%lx_%x", ((ptrdiff_t)pFile)>>12, count++); + chan = Tcl_CreateChannel(&vfsChannelType, zName, pInfo, TCL_READABLE); return chan; } @@ -1368,7 +1364,7 @@ ZvfsFileStat( ZvfsFile *pFile; pFile = ZvfsLookup(path); - if( pFile==0 ){ + if (pFile == 0) { return -1; } memset(buf, 0, sizeof(*buf)); @@ -1395,11 +1391,11 @@ ZvfsFileAccess( { ZvfsFile *pFile; - if( mode & 3 ){ + if (mode & 3) { return -1; } pFile = ZvfsLookup(path); - if( pFile==0 ){ + if (pFile == 0) { return -1; } return 0; @@ -1449,6 +1445,7 @@ Tobe_FSOpenFileChannelProc( { static int inopen=0; Tcl_Channel chan; + if (inopen) { puts("recursive zvfs open"); return NULL; @@ -1508,28 +1505,29 @@ Tobe_FSMatchInDirectoryProc( return TCL_ERROR; } if (pattern != NULL) { - l=strlen(pattern); + l = strlen(pattern); if (!zp) { - zPattern=strdup(pattern); + zPattern = Tcl_Alloc(len + 1); + memcpy(zPattern, pattern, len + 1); } else { - zPattern=(char*)malloc(len+l+3); - sprintf(zPattern,"%s%s%s", zp, zp[len-1]=='/'?"":"/",pattern); + zPattern = Tcl_Alloc(len + l + 3); + sprintf(zPattern, "%s%s%s", zp, zp[len-1]=='/'?"":"/", pattern); } - scnt=strchrcnt(zPattern,'/'); + scnt = strchrcnt(zPattern, '/'); } dirglob = (types && types->type && (types->type&TCL_GLOB_TYPE_DIR)); dirmnt = (types && types->type && (types->type&TCL_GLOB_TYPE_MOUNT)); if (strcmp(zp, "/") == 0 && strcmp(zPattern, ".*") == 0) { /*TODO: What goes here?*/ } - for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + for (pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ ZvfsFile *pFile = Tcl_GetHashValue(pEntry); char *z = pFile->zName; if (zPattern != NULL) { - if( Tcl_StringCaseMatch(z, zPattern, 0) == 0 || - (scnt!=pFile->depth /* && !dirglob */ )) { // TODO: ??? + if (Tcl_StringCaseMatch(z, zPattern, 0) == 0 || + (scnt != pFile->depth /* && !dirglob */)) { // TODO: ??? continue; } } else { @@ -1545,7 +1543,7 @@ Tobe_FSMatchInDirectoryProc( if (!pFile->isdir) { continue; } - } else if (types && !(types->type&TCL_GLOB_TYPE_DIR)) { + } else if (types && !(types->type & TCL_GLOB_TYPE_DIR)) { if (pFile->isdir) { continue; } @@ -1553,7 +1551,7 @@ Tobe_FSMatchInDirectoryProc( Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z, -1)); } if (zPattern) { - free(zPattern); + Tcl_Free(zPattern); } return TCL_OK; } @@ -1568,7 +1566,7 @@ Tobe_FSPathInFilesystemProc( ClientData *clientDataPtr) { ZvfsFile *zFile; - char *path=Tcl_GetString(pathPtr); + char *path = Tcl_GetString(pathPtr); // if (ZvfsLookupMount(path)!=0) // return TCL_OK; @@ -1577,7 +1575,7 @@ Tobe_FSPathInFilesystemProc( return -1; } zFile = ZvfsLookup(path); - if (zFile!=NULL && strcmp(path,zFile->pArchive->zName)) { + if (zFile != NULL && strcmp(path, zFile->pArchive->zName)) { return TCL_OK; } return -1; @@ -1589,21 +1587,20 @@ Tobe_FSListVolumesProc(void) Tcl_HashEntry *pEntry; /* Hash table entry */ Tcl_HashSearch zSearch; /* Search all mount points */ ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_Obj *pVols=NULL, *pVol; + Tcl_Obj *pVols = NULL, *pVol; - pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); + pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch); while (pEntry) { - if (pArchive = Tcl_GetHashValue(pEntry)) { + pArchive = Tcl_GetHashValue(pEntry); + if (pArchive) { if (!pVols) { - pVols=Tcl_NewListObj(0,0); + pVols = Tcl_NewListObj(0, 0); Tcl_IncrRefCount(pVols); } - pVol=Tcl_NewStringObj(pArchive->zMountPoint,-1); - Tcl_IncrRefCount(pVol); - Tcl_ListObjAppendElement(NULL, pVols,pVol); - Tcl_DecrRefCount(pVol); + pVol = Tcl_NewStringObj(pArchive->zMountPoint, -1); + Tcl_ListObjAppendElement(NULL, pVols, pVol); } - pEntry=Tcl_NextHashEntry(&zSearch); + pEntry = Tcl_NextHashEntry(&zSearch); } return pVols; } @@ -1616,20 +1613,22 @@ Tobe_FSChdirProc( return TCL_OK; } -const char ** +const char * const* Tobe_FSFileAttrStringsProc( Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) { - Tcl_Obj *listPtr; - Tcl_Interp *interp = NULL; - char *path=Tcl_GetString(pathPtr); + char *path = Tcl_GetString(pathPtr); #ifdef __WIN32__ - static CONST char *attrs[] = { "-archive", "-hidden", "-readonly", "-system", "-shortname", 0 }; + static const char *attrs[] = { + "-archive", "-hidden", "-readonly", "-system", "-shortname", 0 + }; #else - static CONST char *attrs[] = { "-group", "-owner", "-permissions", 0 }; + static const char *attrs[] = { + "-group", "-owner", "-permissions", 0 + }; #endif - if (ZvfsLookup(path)==0) { + if (ZvfsLookup(path) == 0) { return NULL; } return attrs; @@ -1642,12 +1641,13 @@ Tobe_FSFileAttrsGetProc( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { - char *path=Tcl_GetString(pathPtr); + char *path = Tcl_GetString(pathPtr); char buf[50]; - ZvfsFile *zFile; + ZvfsFile *zFile = ZvfsLookup(path); - if ((zFile = ZvfsLookup(path))==0) + if (zFile == 0) { return TCL_ERROR; + } switch (index) { #ifdef __WIN32__ @@ -1884,11 +1884,11 @@ static Tcl_Filesystem Tobe_Filesystem = { ////////////////////////////////////////////////////////////// -void (*Zvfs_PostInit)(Tcl_Interp *)=0; -static int ZvfsAppendObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); -static int ZvfsAddObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); -static int ZvfsDumpObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); -static int ZvfsStartObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +void (*Zvfs_PostInit)(Tcl_Interp *) = 0; +static int ZvfsAppendObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int ZvfsAddObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int ZvfsDumpObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int ZvfsStartObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); /* * Initialize the ZVFS system. @@ -1900,7 +1900,7 @@ Zvfs_doInit( { int n; #ifdef USE_TCL_STUBS - if( Tcl_InitStubs(interp,"8.0",0)==0 ){ + if (Tcl_InitStubs(interp, "8.0", 0) == 0) { return TCL_ERROR; } #endif @@ -1916,12 +1916,13 @@ Zvfs_doInit( Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "zvfs::dump", ZvfsDumpObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "zvfs::start", ZvfsStartObjCmd, 0, 0); - Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "::zvfs::auto_ext", + ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); /* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ #ifndef USE_TCL_VFS Tcl_GlobalEval(interp, zFileCopy); #endif - if( !local.isInit ){ + if (!local.isInit) { /* One-time initialization of the ZVFS */ #ifdef USE_TCL_VFS n = Tcl_FSRegister(0, &Tobe_Filesystem); @@ -1948,14 +1949,14 @@ int Tcl_Zvfs_Init( Tcl_Interp *interp) { - return Zvfs_doInit(interp,0); + return Zvfs_doInit(interp, 0); } int Tcl_Zvfs_SafeInit( Tcl_Interp *interp) { - return Zvfs_doInit(interp,1); + return Zvfs_doInit(interp, 1); } /************************************************************************/ @@ -1984,23 +1985,23 @@ ZvfsDumpObjCmd( int rc; Tcl_Obj *pResult; - if( objc!=2 ){ + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); return TCL_ERROR; } zFilename = Tcl_GetString(objv[1]); chan = Tcl_OpenFileChannel(interp, zFilename, "r", 0); - if( chan==0 ) { + if (chan == 0) { return TCL_ERROR; } rc = ZvfsReadTOC(interp, chan, &pList); - if( rc==TCL_ERROR ){ + if (rc == TCL_ERROR) { deleteZFileList(pList); return rc; } Tcl_Close(interp, chan); pResult = Tcl_GetObjResult(interp); - while( pList ){ + while (pList) { Tcl_Obj *pEntry = Tcl_NewObj(); ZFile *pNext; char zDateTime[100]; @@ -2019,7 +2020,7 @@ ZvfsDumpObjCmd( Tcl_NewIntObj(pList->nByteCompr)); Tcl_ListObjAppendElement(interp, pResult, pEntry); pNext = pList->pNext; - Tcl_Free((char*)pList); + Tcl_Free((void *) pList); pList = pList->pNext; } return TCL_OK; @@ -2062,7 +2063,7 @@ writeFile( strcpy(p->zName, zDest); p->isSpecial = 0; Tcl_Stat(zSrc, &stat); - now=stat.st_mtime; + now = stat.st_mtime; tm = localtime(&now); UnixTimeDate(tm, &p->dosDate, &p->dosTime); p->iOffset = Tcl_Tell(out); @@ -2104,13 +2105,13 @@ writeFile( * Write the compressed file. Compute the CRC as we progress. */ - stream.zalloc = (alloc_func)0; - stream.zfree = (free_func)0; + stream.zalloc = NULL; + stream.zfree = NULL; stream.opaque = 0; stream.avail_in = 0; - stream.next_in = zInBuf; + stream.next_in = (unsigned char *) zInBuf; stream.avail_out = sizeof(zOutBuf); - stream.next_out = zOutBuf; + stream.next_out = (unsigned char *) zOutBuf; #if 1 deflateInit(&stream, 9); #else @@ -2123,40 +2124,42 @@ writeFile( #endif p->iCRC = crc32(0, 0, 0); - while( !Tcl_Eof(in) ){ - if( stream.avail_in==0 ){ + while (!Tcl_Eof(in)) { + if (stream.avail_in == 0) { int amt = Tcl_Read(in, zInBuf, sizeof(zInBuf)); - if( amt<=0 ) { + if (amt <= 0) { break; } - p->iCRC = crc32(p->iCRC, zInBuf, amt); + p->iCRC = crc32(p->iCRC, (unsigned char *) zInBuf, amt); stream.avail_in = amt; - stream.next_in = zInBuf; + stream.next_in = (unsigned char *) zInBuf; } deflate(&stream, 0); toOut = sizeof(zOutBuf) - stream.avail_out; - if( toOut>skip ){ + if (toOut > skip) { Tcl_Write(out, &zOutBuf[skip], toOut - skip); skip = 0; - }else{ + } else { skip -= toOut; } stream.avail_out = sizeof(zOutBuf); - stream.next_out = zOutBuf; + stream.next_out = (unsigned char *) zOutBuf; } + do{ stream.avail_out = sizeof(zOutBuf); - stream.next_out = zOutBuf; + stream.next_out = (unsigned char *) zOutBuf; deflate(&stream, Z_FINISH); toOut = sizeof(zOutBuf) - stream.avail_out; - if( toOut>skip ){ + if (toOut > skip) { Tcl_Write(out, &zOutBuf[skip], toOut - skip); skip = 0; - }else{ + } else { skip -= toOut; } - }while( stream.avail_out==0 ); + } while (stream.avail_out == 0); + p->nByte = stream.total_in; p->nByteCompr = stream.total_out - 2; deflateEnd(&stream); @@ -2199,24 +2202,24 @@ mergeZFiles( ZFile *pTail; pTail = &fakeHead; - while( pLeft && pRight ){ + while (pLeft && pRight) { ZFile *p; - if( pLeft->iOffset <= pRight->iOffset ){ + if (pLeft->iOffset <= pRight->iOffset) { p = pLeft; pLeft = p->pNext; - }else{ + } else { p = pRight; pRight = p->pNext; } pTail->pNext = p; pTail = p; } - if( pLeft ){ + if (pLeft) { pTail->pNext = pLeft; - }else if( pRight ){ + } else if (pRight) { pTail->pNext = pRight; - }else{ + } else { pTail->pNext = 0; } return fakeHead.pNext; @@ -2234,22 +2237,22 @@ sortZFiles( ZFile *p; ZFile *aBin[NBIN+1]; - for(i=0; i<=NBIN; i++) { + for (i=0; i<=NBIN; i++) { aBin[i] = 0; } - while( pList ){ + while (pList) { p = pList; pList = p->pNext; p->pNext = 0; - for(i=0; ipNext){ - if( pList->isSpecial ) { + for (; pList; pList=pList->pNext) { + if (pList->isSpecial) { continue; } put32(&zBuf[0], 0x02014b50); @@ -2294,7 +2297,7 @@ writeTOC( put32(&zBuf[42], pList->iOffset); Tcl_Write(chan, zBuf, 46); Tcl_Write(chan, pList->zName, strlen(pList->zName)); - for(i=pList->nExtra; i>0; i-=40){ + for (i=pList->nExtra; i>0; i-=40) { int toWrite = i<40 ? i : 40; /* CAREFUL! String below is intentionally 40 spaces! */ @@ -2347,20 +2350,20 @@ ZvfsAppendObjCmd( * Open the archive and read the table of contents */ - if( objc<2 || (objc&1)!=0 ){ + if (objc<2 || (objc&1)!=0) { Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE (SRC DEST)+"); return TCL_ERROR; } zArchive = Tcl_GetString(objv[1]); chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); - if( chan==0 ) { + if (chan == 0) { chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); - if( chan==0 ) { + if (chan == 0) { return TCL_ERROR; } } - if(Tcl_SetChannelOption(interp, chan, "-translation", "binary") + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ /* this should never happen */ Tcl_Close(0, chan); @@ -2371,27 +2374,25 @@ ZvfsAppendObjCmd( /* Null file is ok, we're creating new one. */ } else { Tcl_Seek(chan, 0, SEEK_SET); - rc = ZvfsReadTOC(interp, chan, &pList); - if( rc==TCL_ERROR ){ + if (ZvfsReadTOC(interp, chan, &pList) == TCL_ERROR) { deleteZFileList(pList); Tcl_Close(interp, chan); - return rc; - } else { - rc=TCL_OK; + return TCL_ERROR; } + rc = TCL_OK; } /* * Move the file pointer to the start of the table of contents. */ - for(pToc=pList; pToc; pToc=pToc->pNext){ - if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) { + for (pToc=pList; pToc; pToc=pToc->pNext) { + if (pToc->isSpecial && strcmp(pToc->zName, "*TOC*") == 0) { break; } } - if( pToc ){ + if (pToc) { Tcl_Seek(chan, pToc->iOffset, SEEK_SET); - }else{ + } else { Tcl_Seek(chan, 0, SEEK_END); } @@ -2399,7 +2400,7 @@ ZvfsAppendObjCmd( * Add new files to the end of the archive. */ - for(i=2; rc==TCL_OK && i3) { + if (objc > 3) { zOpts = Tcl_GetStringFromObj(objv[1], &oLen); if (!strncmp("-fconfigure", zOpts, oLen)) { confOpts = objv[2]; @@ -2512,21 +2513,24 @@ ZvfsAddObjCmd( objv += 2; } } - if( objc==2) { + if (objc == 2) { return TCL_OK; } - if( objc<3) { + if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?-fconfigure OPTPAIRS? ARCHIVE FILE1 FILE2 .."); return TCL_ERROR; } + zArchive = Tcl_GetString(objv[1]); chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); - if( chan==0 ) { + if (chan == 0) { chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); + if (chan == 0) { + return TCL_ERROR; + } } - if( chan==0 ) return TCL_ERROR; if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ /* this should never happen */ @@ -2538,27 +2542,26 @@ ZvfsAddObjCmd( /* Null file is ok, we're creating new one. */ } else { Tcl_Seek(chan, 0, SEEK_SET); - rc = ZvfsReadTOC(interp, chan, &pList); - if( rc==TCL_ERROR ){ + if (ZvfsReadTOC(interp, chan, &pList) == TCL_ERROR) { deleteZFileList(pList); Tcl_Close(interp, chan); - return rc; + return TCL_ERROR; } - rc=TCL_OK; + rc = TCL_OK; } /* * Move the file pointer to the start of the table of contents. */ - for(pToc=pList; pToc; pToc=pToc->pNext){ - if( pToc->isSpecial && strcmp(pToc->zName, "*TOC*")==0 ) { + for (pToc=pList; pToc; pToc=pToc->pNext) { + if (pToc->isSpecial && strcmp(pToc->zName, "*TOC*") == 0) { break; } } - if( pToc ){ + if (pToc) { Tcl_Seek(chan, pToc->iOffset, SEEK_SET); - }else{ + } else { Tcl_Seek(chan, 0, SEEK_END); } @@ -2566,22 +2569,25 @@ ZvfsAddObjCmd( * Add new files to the end of the archive. */ - for(i=2; rc==TCL_OK && i=tobjc) { + if (j >= tobjc) { ext = NULL; } } @@ -2654,26 +2660,20 @@ ZvfsStartObjCmd( { char *zArchive; Tcl_Channel chan; - ZFile *pList = NULL, *pToc; - int rc = TCL_OK, i, j, oLen; - char *zOpts = NULL; - Tcl_Obj *confOpts = NULL; - int tobjc; - Tcl_Obj **tobjv; - Tcl_Obj *varObj = NULL; + ZFile *pList = NULL; int zipStart; /* * Open the archive and read the table of contents */ - if( objc != 2) { + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE"); return TCL_ERROR; } zArchive = Tcl_GetString(objv[1]); chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0644); - if( chan==0 ) { + if (chan == 0) { return TCL_ERROR; } if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") @@ -2689,8 +2689,7 @@ ZvfsStartObjCmd( } Tcl_Seek(chan, 0, SEEK_SET); - rc = ZvfsReadTOCStart(interp, chan, &pList, &zipStart); - if( rc!=TCL_OK ){ + if (ZvfsReadTOCStart(interp, chan, &pList, &zipStart) != TCL_OK) { deleteZFileList(pList); Tcl_Close(interp, chan); Tcl_AppendResult(interp, "not an archive", 0); -- cgit v0.12 From 1d9824ec60bc37945dfde4597fe763ed78bba999 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 1 Sep 2014 23:23:37 +0000 Subject: Tweaking the Makefile instructions for Tclkits under unix --- unix/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index d41e0d9..a228497 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -654,7 +654,7 @@ ${TCLKIT_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} PWD=`pwd` - cd $(SCRIPT_INSTALL_DIR) ; zip -rAq ${PWD}/tclkit.zip tcl8 tcl8.6 + cd ${prefix}/lib ; zip -rAq ${PWD}/tclkit.zip tcl8 tcl8.6 cat tclkit.zip >> ${TCLKIT_EXE} # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above -- cgit v0.12 From 811d367c49b7c02192b14be4301f9066dd7fe95e Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 2 Sep 2014 11:04:53 +0000 Subject: Rather than make a special executable, tclkits are now a copy of tclsh with an attached zip file --- unix/Makefile.in | 7 +++---- win/Makefile.in | 8 +++----- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index a228497..bb6af0c 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -649,12 +649,11 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCL_EXE} -${TCLKIT_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} - ${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} ${TCLSH_OBJS} \ - ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} +${TCLKIT_EXE}: ${TCL_EXE} + rm -f tclkit.zip PWD=`pwd` cd ${prefix}/lib ; zip -rAq ${PWD}/tclkit.zip tcl8 tcl8.6 + cp -f ${TCL_EXE} ${TCLKIT_EXE} cat tclkit.zip >> ${TCLKIT_EXE} # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above diff --git a/win/Makefile.in b/win/Makefile.in index 07c8db1..f302ed6 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -426,13 +426,11 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclkit: $(TCLKIT) -$(TCLKIT): $(TCLSH_OBJS) @LIBRARIES@ ${TCL_OBJS} $(CAT32) tclsh.$(RES) - $(CC) $(CFLAGS) ${TCL_OBJS} $(TCLSH_OBJS) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - PWD=`pwd` +$(TCLKIT): $(TCLSH) rm -f tclkit.zip - cp $(TCLSH) $(TCLKIT) + PWD=`pwd` cd ${prefix}/lib ; zip -rq ${PWD}/tclkit.zip tcl8 tcl8.6 + cp -f $(TCLSH) $(TCLKIT) cat tclkit.zip >> $(TCLKIT) cat32.$(OBJEXT): cat.c -- cgit v0.12 From 8c90b3ae99f9acb04b46875ed09def2dcf9641f3 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 2 Sep 2014 15:21:23 +0000 Subject: Patch to make the default behavior for Tcl under Windows to embed the Zlib sources rather than add a dependency to a dynamic zlib.dll --- win/configure | 6546 ++++++++++++++++++++++++++++-------------------------- win/configure.in | 24 +- 2 files changed, 3361 insertions(+), 3209 deletions(-) diff --git a/win/configure b/win/configure index cf2b201..d8ee198 100755 --- a/win/configure +++ b/win/configure @@ -1,81 +1,423 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59. +# Generated by GNU Autoconf 2.68. +# +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software +# Foundation, Inc. +# # -# Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. -## --------------------- ## -## M4sh Initialization. ## -## --------------------- ## +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## -# Be Bourne compatible -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' -elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then - set -o posix + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac fi -DUALCASE=1; export DUALCASE # for MKS sh -# Support unset when possible. -if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - as_unset=unset -else - as_unset=false + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } fi -# Work around bugs in pre-3.0 UWIN ksh. -$as_unset ENV MAIL MAILPATH +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + # We cannot yet assume a decent shell, so we have to provide a + # neutralization value for shells without unset; and this also + # works around shells that cannot unset nonexistent variables. + # Preserve -v and -x to the replacement shell. + BASH_ENV=/dev/null + ENV=/dev/null + (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV + export CONFIG_SHELL + case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; + esac + exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." else - $as_unset $as_var + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." fi -done + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status -# Required to use basename. -if expr a : '\(a\)' >/dev/null 2>&1; then +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi -if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi -# Name of the executable. -as_me=`$as_basename "$0" || +as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)$' \| \ - . : '\(.\)' 2>/dev/null || -echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } - /^X\/\(\/\/\)$/{ s//\1/; q; } - /^X\/\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` -# PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -83,146 +425,107 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh -fi - - - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" || { - # Find who we are. Look in the path if we contain no path at all - # relative or not. - case $0 in - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break -done - - ;; - esac - # We did not find ourselves, most probably we were run as `sh COMMAND' - # in which case we are not to be found in the path. - if test "x$as_myself" = x; then - as_myself=$0 - fi - if test ! -f "$as_myself"; then - { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 - { (exit 1); exit 1; }; } - fi - case $CONFIG_SHELL in - '') - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for as_base in sh bash ksh sh5; do - case $as_dir in - /*) - if ("$as_dir/$as_base" -c ' - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then - $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } - $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } - CONFIG_SHELL=$as_dir/$as_base - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$0" ${1+"$@"} - fi;; - esac - done -done -;; - esac - # Create $as_me.lineno as a copy of $as_myself, but with $LINENO - # uniformly replaced by the line number. The first 'sed' inserts a - # line-number line before each line; the second 'sed' does the real - # work. The second script uses 'N' to pair each line-number line - # with the numbered line, and appends trailing '-' during - # substitution so that $LINENO is not a special case at line end. - # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the - # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) - sed '=' <$as_myself | + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno N - s,$,-, - : loop - s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop - s,-$,, - s,^['$as_cr_digits']*\n,, + s/-\n.*// ' >$as_me.lineno && - chmod +x $as_me.lineno || - { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 - { (exit 1); exit 1; }; } + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensible to this). - . ./$as_me.lineno + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" # Exit status is that of the last command. exit } - -case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in - *c*,-n*) ECHO_N= ECHO_C=' -' ECHO_T=' ' ;; - *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; - *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; esac -if expr a : '\(a\)' >/dev/null 2>&1; then - as_expr=expr +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file else - as_expr=false + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null fi - -rm -f conf$$ conf$$.exe conf$$.file -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - # We could just check for DJGPP; but this test a) works b) is more generic - # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). - if test -f conf$$.exe; then - # Don't use ln at all; we don't have any links - as_ln_s='cp -p' - else +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' fi -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln else as_ln_s='cp -p' fi -rm -f conf$$ conf$$.exe conf$$.file +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then - as_mkdir_p=: + as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi -as_executable_p="test -f" +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -231,38 +534,25 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" -# IFS -# We need space, tab and new line, in precisely that order. -as_nl=' -' -IFS=" $as_nl" - -# CDPATH. -$as_unset CDPATH - +test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. -# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` -exec 6>&1 - # # Initializations. # ac_default_prefix=/usr/local +ac_clean_files= ac_config_libobj_dir=. +LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= -SHELL=${CONFIG_SHELL-/bin/sh} - -# Maximum number of lines to put in a shell here document. -# This variable seems obsolete. It should probably be removed, and -# only ac_max_sed_lines should be used. -: ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME= @@ -270,51 +560,214 @@ PACKAGE_TARNAME= PACKAGE_VERSION= PACKAGE_STRING= PACKAGE_BUGREPORT= +PACKAGE_URL= ac_unique_file="../generic/tcl.h" # Factoring default headers for most tests. ac_includes_default="\ #include -#if HAVE_SYS_TYPES_H +#ifdef HAVE_SYS_TYPES_H # include #endif -#if HAVE_SYS_STAT_H +#ifdef HAVE_SYS_STAT_H # include #endif -#if STDC_HEADERS +#ifdef STDC_HEADERS # include # include #else -# if HAVE_STDLIB_H +# ifdef HAVE_STDLIB_H # include # endif #endif -#if HAVE_STRING_H -# if !STDC_HEADERS && HAVE_MEMORY_H +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif -#if HAVE_STRINGS_H +#ifdef HAVE_STRINGS_H # include #endif -#if HAVE_INTTYPES_H +#ifdef HAVE_INTTYPES_H # include -#else -# if HAVE_STDINT_H -# include -# endif #endif -#if HAVE_UNISTD_H +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H # include #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 ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_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 MAKE_STUB_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_vars='LTLIBOBJS +LIBOBJS +RES +RC_DEFINES +RC_DEFINE +RC_INCLUDE +RC_TYPE +RC_OUT +TCL_REG_MINOR_VERSION +TCL_REG_MAJOR_VERSION +TCL_REG_VERSION +TCL_DDE_MINOR_VERSION +TCL_DDE_MAJOR_VERSION +TCL_DDE_VERSION +TCL_PACKAGE_PATH +TCL_LIB_VERSIONS_OK +TCL_EXP_FILE +TCL_BUILD_EXP_FILE +TCL_NEEDS_EXP_FILE +TCL_LD_SEARCH_FLAGS +TCL_BUILD_LIB_SPEC +MAKE_EXE +MAKE_DLL +POST_MAKE_LIB +MAKE_STUB_LIB +MAKE_LIB +LIBRARIES +EXESUFFIX +LIBSUFFIX +LIBPREFIX +DLLSUFFIX +LIBS_GUI +TCL_SHARED_BUILD +SHLIB_SUFFIX +SHLIB_CFLAGS +SHLIB_LD_LIBS +SHLIB_LD +STLIB_LD +LDFLAGS_WINDOW +LDFLAGS_CONSOLE +LDFLAGS_OPTIMIZE +LDFLAGS_DEBUG +CC_EXENAME +CC_OBJNAME +DEPARG +EXTRA_CFLAGS +CFG_TCL_EXPORT_FILE_SUFFIX +CFG_TCL_UNSHARED_LIB_SUFFIX +CFG_TCL_SHARED_LIB_SUFFIX +TCL_DBGX +TCL_BIN_DIR +TCL_SRC_DIR +TCL_DLL_FILE +TCL_BUILD_STUB_LIB_PATH +TCL_BUILD_STUB_LIB_SPEC +TCL_INCLUDE_SPEC +TCL_STUB_LIB_PATH +TCL_STUB_LIB_SPEC +TCL_STUB_LIB_FLAG +TCL_STUB_LIB_FILE +TCL_LIB_SPEC +TCL_IMPORT_LIB_FLAG +TCL_IMPORT_LIB_FILE +TCL_STATIC_LIB_FLAG +TCL_STATIC_LIB_FILE +TCL_LIB_FLAG +TCL_LIB_FILE +TCL_EXE +PKG_CFG_ARGS +TCL_PATCH_LEVEL +TCL_MINOR_VERSION +TCL_MAJOR_VERSION +TCL_VERSION +MACHINE +TCL_WIN_VERSION +VC_MANIFEST_EMBED_EXE +VC_MANIFEST_EMBED_DLL +LDFLAGS_DEFAULT +CFLAGS_DEFAULT +ZLIB_LIBS +ZLIB_OBJS +CFLAGS_WARNING +CFLAGS_OPTIMIZE +CFLAGS_DEBUG +DL_LIBS +CELIB_DIR +CYGPATH +TCL_THREADS +SET_MAKE +RC +RANLIB +AR +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_threads +with_encoding +enable_shared +enable_64bit +enable_wince +with_celib +with_zlib +enable_symbols +enable_embedded_manifest +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + # Initialize some variables set by options. ac_init_help= ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null @@ -337,34 +790,49 @@ x_libraries=NONE # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' -datadir='${prefix}/share' +datarootdir='${prefix}/share' +datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' -libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' -infodir='${prefix}/info' -mandir='${prefix}/man' +docdir='${datarootdir}/doc/${PACKAGE}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' ac_prev= +ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then - eval "$ac_prev=\$ac_option" + eval $ac_prev=\$ac_option ac_prev= continue fi - ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac # Accept the important Cygnus configure options, so we can diagnose typos. - case $ac_option in + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; @@ -386,33 +854,59 @@ do --config-cache | -C) cache_file=config.cache ;; - -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ - | --da=*) + -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + -disable-* | --disable-*) - ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid feature name: $ac_feature" >&2 - { (exit 1); exit 1; }; } - ac_feature=`echo $ac_feature | sed 's/-/_/g'` - eval "enable_$ac_feature=no" ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; -enable-* | --enable-*) - ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid feature name: $ac_feature" >&2 - { (exit 1); exit 1; }; } - ac_feature=`echo $ac_feature | sed 's/-/_/g'` - case $ac_option in - *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; - *) ac_optarg=yes ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; esac - eval "enable_$ac_feature='$ac_optarg'" ;; + eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -439,6 +933,12 @@ do -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; @@ -463,13 +963,16 @@ do | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst \ - | --locals | --local | --loca | --loc | --lo) + | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* \ - | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) @@ -534,6 +1037,16 @@ do | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; @@ -584,26 +1097,36 @@ do ac_init_version=: ;; -with-* | --with-*) - ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid package name: $ac_package" >&2 - { (exit 1); exit 1; }; } - ac_package=`echo $ac_package| sed 's/-/_/g'` - case $ac_option in - *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; - *) ac_optarg=yes ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; esac - eval "with_$ac_package='$ac_optarg'" ;; + eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) - ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid package name: $ac_package" >&2 - { (exit 1); exit 1; }; } - ac_package=`echo $ac_package | sed 's/-/_/g'` - eval "with_$ac_package=no" ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. @@ -623,27 +1146,26 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) { echo "$as_me: error: unrecognized option: $ac_option -Try \`$0 --help' for more information." >&2 - { (exit 1); exit 1; }; } + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. - expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 - { (exit 1); exit 1; }; } - ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` - eval "$ac_envvar='$ac_optarg'" + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. - echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac @@ -651,31 +1173,36 @@ done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - { echo "$as_me: error: missing argument to $ac_option" >&2 - { (exit 1); exit 1; }; } + as_fn_error $? "missing argument to $ac_option" fi -# Be sure to have absolute paths. -for ac_var in exec_prefix prefix -do - eval ac_val=$`echo $ac_var` - case $ac_val in - [\\/$]* | ?:[\\/]* | NONE | '' ) ;; - *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 - { (exit 1); exit 1; }; };; +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac -done +fi -# Be sure to have absolute paths. -for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ - localstatedir libdir includedir oldincludedir infodir mandir +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir do - eval ac_val=$`echo $ac_var` + eval ac_val=\$$ac_var + # Remove trailing slashes. case $ac_val in - [\\/$]* | ?:[\\/]* ) ;; - *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 - { (exit 1); exit 1; }; };; + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' @@ -689,8 +1216,8 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe - echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. - If a cross compiler is detected then cross compile mode will be used." >&2 + $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -702,74 +1229,72 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes - # Try the directory containing this script, then its parent. - ac_confdir=`(dirname "$0") 2>/dev/null || -$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$0" : 'X\(//\)[^/]' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$0" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` srcdir=$ac_confdir - if test ! -r $srcdir/$ac_unique_file; then + if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi -if test ! -r $srcdir/$ac_unique_file; then - if test "$ac_srcdir_defaulted" = yes; then - { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 - { (exit 1); exit 1; }; } - else - { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 - { (exit 1); exit 1; }; } - fi -fi -(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || - { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 - { (exit 1); exit 1; }; } -srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` -ac_env_build_alias_set=${build_alias+set} -ac_env_build_alias_value=$build_alias -ac_cv_env_build_alias_set=${build_alias+set} -ac_cv_env_build_alias_value=$build_alias -ac_env_host_alias_set=${host_alias+set} -ac_env_host_alias_value=$host_alias -ac_cv_env_host_alias_set=${host_alias+set} -ac_cv_env_host_alias_value=$host_alias -ac_env_target_alias_set=${target_alias+set} -ac_env_target_alias_value=$target_alias -ac_cv_env_target_alias_set=${target_alias+set} -ac_cv_env_target_alias_value=$target_alias -ac_env_CC_set=${CC+set} -ac_env_CC_value=$CC -ac_cv_env_CC_set=${CC+set} -ac_cv_env_CC_value=$CC -ac_env_CFLAGS_set=${CFLAGS+set} -ac_env_CFLAGS_value=$CFLAGS -ac_cv_env_CFLAGS_set=${CFLAGS+set} -ac_cv_env_CFLAGS_value=$CFLAGS -ac_env_LDFLAGS_set=${LDFLAGS+set} -ac_env_LDFLAGS_value=$LDFLAGS -ac_cv_env_LDFLAGS_set=${LDFLAGS+set} -ac_cv_env_LDFLAGS_value=$LDFLAGS -ac_env_CPPFLAGS_set=${CPPFLAGS+set} -ac_env_CPPFLAGS_value=$CPPFLAGS -ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} -ac_cv_env_CPPFLAGS_value=$CPPFLAGS -ac_env_CPP_set=${CPP+set} -ac_env_CPP_value=$CPP -ac_cv_env_CPP_set=${CPP+set} -ac_cv_env_CPP_value=$CPP +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done # # Report the --help message. @@ -792,20 +1317,17 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking...' messages + -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] -_ACEOF - - cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] + [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] + [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify @@ -815,18 +1337,25 @@ for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --datadir=DIR read-only architecture-independent data [PREFIX/share] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --infodir=DIR info documentation [PREFIX/info] - --mandir=DIR man documentation [PREFIX/man] + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF @@ -838,6 +1367,7 @@ if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-threads build with threads (default: on) @@ -853,168 +1383,393 @@ Optional Packages: --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values --with-celib=DIR use Windows/CE support library from DIR + --with-zlib use Native Zlib library Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory - CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have - headers in a nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. +Report bugs to the package provider. _ACEOF +ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. - ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d $ac_dir || continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue ac_builddir=. -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix case $srcdir in - .) # No --srcdir option. We are building in place. + .) # We are building in place. ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; -esac - -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac - - cd $ac_dir - # Check for guested configure; otherwise get Cygnus style configure. - if test -f $ac_srcdir/configure.gnu; then - echo - $SHELL $ac_srcdir/configure.gnu --help=recursive - elif test -f $ac_srcdir/configure; then - echo - $SHELL $ac_srcdir/configure --help=recursive - elif test -f $ac_srcdir/configure.ac || - test -f $ac_srcdir/configure.in; then - echo - $ac_configure --help +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive else - echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi - cd $ac_popdir + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } done fi -test -n "$ac_init_help" && exit 0 +test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF +configure +generated by GNU Autoconf 2.68 -Copyright (C) 2003 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF - exit 0 + exit fi -exec 5>config.log -cat >&5 <<_ACEOF -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by $as_me, which was -generated by GNU Autoconf 2.59. Invocation command line was - $ $0 $@ +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## -_ACEOF +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () { -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` +} # ac_fn_c_try_compile -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -hostinfo = `(hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -_ASUNAME + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - echo "PATH: $as_dir" -done +} # ac_fn_c_try_cpp -} >&5 +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -cat >&5 <<_ACEOF + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES +# --------------------------------------------- +# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# accordingly. +ac_fn_c_check_decl () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + as_decl_name=`echo $2|sed 's/ *(.*//'` + as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 +$as_echo_n "checking whether $as_decl_name is declared... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +#ifndef $as_decl_name +#ifdef __cplusplus + (void) $as_decl_use; +#else + (void) $as_decl_name; +#endif +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_decl + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES +# ------------------------------------------- +# Tests whether TYPE exists after having included INCLUDES, setting cache +# variable VAR accordingly. +ac_fn_c_check_type () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_type +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.68. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF ## ----------- ## @@ -1032,7 +1787,6 @@ _ACEOF ac_configure_args= ac_configure_args0= ac_configure_args1= -ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do @@ -1043,13 +1797,13 @@ do -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) - ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in - 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) - ac_configure_args1="$ac_configure_args1 '$ac_arg'" + as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else @@ -1065,104 +1819,115 @@ do -* ) ac_must_keep_next=true ;; esac fi - ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" - # Get rid of the leading space. - ac_sep=" " + as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done -$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } -$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. -# WARNING: Be sure not to use single quotes in there, as some shells, -# such as our DU 5.0 friend, will then `close' the trap. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo - cat <<\_ASBOX -## ---------------- ## + $as_echo "## ---------------- ## ## Cache variables. ## -## ---------------- ## -_ASBOX +## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, -{ +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done (set) 2>&1 | - case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in - *ac_space=\ *) + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) sed -n \ - "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" - ;; + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( *) - sed -n \ - "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; - esac; -} + esac | + sort +) echo - cat <<\_ASBOX -## ----------------- ## + $as_echo "## ----------------- ## ## Output variables. ## -## ----------------- ## -_ASBOX +## ----------------- ##" echo for ac_var in $ac_subst_vars do - eval ac_val=$`echo $ac_var` - echo "$ac_var='"'"'$ac_val'"'"'" + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then - cat <<\_ASBOX -## ------------- ## -## Output files. ## -## ------------- ## -_ASBOX + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" echo for ac_var in $ac_subst_files do - eval ac_val=$`echo $ac_var` - echo "$ac_var='"'"'$ac_val'"'"'" + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then - cat <<\_ASBOX -## ----------- ## + $as_echo "## ----------- ## ## confdefs.h. ## -## ----------- ## -_ASBOX +## ----------- ##" echo - sed "/^$/d" confdefs.h | sort + cat confdefs.h echo fi test "$ac_signal" != 0 && - echo "$as_me: caught signal $ac_signal" - echo "$as_me: exit $exit_status" + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" } >&5 - rm -f core *.core && - rm -rf conftest* confdefs* conf$$* $ac_clean_files && + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status - ' 0 +' 0 for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo >confdefs.h +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. @@ -1170,112 +1935,137 @@ cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + # Let the site file select an alternate cache file if it wants to. -# Prefer explicitly selected file to automatically selected ones. -if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" - fi +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site fi -for ac_site_file in $CONFIG_SITE; do - if test -r "$ac_site_file"; then - { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 -echo "$as_me: loading site script $ac_site_file" >&6;} +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5 ; } fi done if test -r "$cache_file"; then - # Some versions of bash will fail to source /dev/null (special - # files actually), so we avoid doing that. - if test -f "$cache_file"; then - { echo "$as_me:$LINENO: loading cache $cache_file" >&5 -echo "$as_me: loading cache $cache_file" >&6;} + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in - [\\/]* | ?:[\\/]* ) . $cache_file;; - *) . ./$cache_file;; + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; esac fi else - { echo "$as_me:$LINENO: creating cache $cache_file" >&5 -echo "$as_me: creating cache $cache_file" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false -for ac_var in `(set) 2>&1 | - sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do +for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set - eval ac_old_val="\$ac_cv_env_${ac_var}_value" - eval ac_new_val="\$ac_env_${ac_var}_value" + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) - { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 -echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then - { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 -echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 -echo "$as_me: former value: $ac_old_val" >&2;} - { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 -echo "$as_me: current value: $ac_new_val" >&2;} - ac_cache_corrupted=: + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) - ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. - *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then - { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 -echo "$as_me: error: changes in the environment can compromise the build" >&2;} - { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 -echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} - { (exit 1); exit 1; }; } + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' @@ -1286,23 +2076,6 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu - - - - - - - - - - - - - - - - - # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. @@ -1362,10 +2135,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1375,35 +2148,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -1413,39 +2188,50 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - CC=$ac_ct_CC + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1455,77 +2241,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 -fi - -fi -if test -z "$ac_cv_prog_CC"; then - ac_ct_CC=$CC - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_CC="cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done -done - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - CC=$ac_ct_CC -else - CC="$ac_cv_prog_CC" -fi + fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1536,18 +2282,19 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. @@ -1565,24 +2312,25 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then - for ac_prog in cl + for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1592,39 +2340,41 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC - for ac_prog in cl + for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -1634,66 +2384,78 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + test -n "$ac_ct_CC" && break done - CC=$ac_ct_CC + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi fi fi -test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH -See \`config.log' for more details." >&5 -echo "$as_me: error: no acceptable C compiler found in \$PATH -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5 ; } # Provide some information about the compiler. -echo "$as_me:$LINENO:" \ - "checking for C compiler version" >&5 -ac_compiler=`set X $ac_compile; echo $2` -{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 - (eval $ac_compiler --version &5) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } -{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 - (eval $ac_compiler -v &5) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } -{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 - (eval $ac_compiler -V &5) 2>&5 +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -1705,112 +2467,108 @@ main () } _ACEOF ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.exe b.out" +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. -echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 -echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 -ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` -if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 - (eval $ac_link_default) 2>&5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; then - # Find the output, starting from the most likely. This scheme is -# not robust to junk in `.', hence go to wildcards (a.*) only as a last -# resort. - -# Be careful to initialize this variable, since it used to be cached. -# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. -ac_cv_exeext= -# b.out is created by i960 compilers. -for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) - ;; - conftest.$ac_ext ) - # This is the source file. + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - # FIXME: I believe we export ac_cv_exeext for Libtool, - # but it would be cool to find out if it's true. Does anybody - # maintain Libtool? --akim. - export ac_cv_exeext + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. break;; * ) break;; esac done +test "$ac_cv_exeext" = no && ac_cv_exeext= + else - echo "$as_me: failed program was:" >&5 + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { echo "$as_me:$LINENO: error: C compiler cannot create executables -See \`config.log' for more details." >&5 -echo "$as_me: error: C compiler cannot create executables -See \`config.log' for more details." >&2;} - { (exit 77); exit 77; }; } +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5 ; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } fi - +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } ac_exeext=$ac_cv_exeext -echo "$as_me:$LINENO: result: $ac_file" >&5 -echo "${ECHO_T}$ac_file" >&6 - -# Check the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -echo "$as_me:$LINENO: checking whether the C compiler works" >&5 -echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 -# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 -# If not cross compiling, check that we can run a simple program. -if test "$cross_compiling" != yes; then - if { ac_try='./$ac_file' - { (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 - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { echo "$as_me:$LINENO: error: cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details." >&5 -echo "$as_me: error: cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } - fi - fi -fi -echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 -rm -f a.out a.exe conftest$ac_cv_exeext b.out +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save -# Check the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 -echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 -echo "$as_me:$LINENO: result: $cross_compiling" >&5 -echo "${ECHO_T}$cross_compiling" >&6 - -echo "$as_me:$LINENO: checking for suffix of executables" >&5 -echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; then + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with @@ -1818,88 +2576,141 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - export ac_cv_exeext break;; * ) break;; esac done else - { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details." >&5 -echo "$as_me: error: cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5 ; } fi - -rm -f conftest$ac_cv_exeext -echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 -echo "${ECHO_T}$ac_cv_exeext" >&6 +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT -echo "$as_me:$LINENO: checking for suffix of object files" >&5 -echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 -if test "${ac_cv_objext+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 +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - +#include int main () { +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF -rm -f conftest.o conftest.obj -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>&5 +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; then - for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; - *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` - break;; - esac -done -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile -See \`config.log' for more details." >&5 -echo "$as_me: error: cannot compute suffix of object files: cannot compile -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } -fi - -rm -f conftest.$ac_cv_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 -echo "${ECHO_T}$ac_cv_objext" >&6 -OBJEXT=$ac_cv_objext -ac_objext=$OBJEXT -echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 -echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 -if test "${ac_cv_c_compiler_gnu+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5 ; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5 ; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -1913,55 +2724,34 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_compiler_gnu=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_compiler_gnu=no + ac_compiler_gnu=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi -echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 -echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 -GCC=`test $ac_compiler_gnu = yes && echo yes` +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS -CFLAGS="-g" -echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 -echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 -if test "${ac_cv_prog_cc_g+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 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -1972,39 +2762,49 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_g=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ -ac_cv_prog_cc_g=no + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag fi -echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 -echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then @@ -2020,18 +2820,14 @@ else CFLAGS= fi fi -echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 -echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 -if test "${ac_cv_prog_cc_stdc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 else - ac_cv_prog_cc_stdc=no + ac_cv_prog_cc_c89=no ac_save_CC=$CC -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include @@ -2059,12 +2855,17 @@ static char *f (char * (*g) (char **, int), char **p, ...) /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std1 is added to get + as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std1. */ + that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; @@ -2079,205 +2880,37 @@ return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; return 0; } _ACEOF -# Don't try gcc -ansi; that turns off useful extensions and -# breaks some systems' header files. -# AIX -qlanglvl=ansi -# Ultrix and OSF/1 -std1 -# HP-UX 10.20 and later -Ae -# HP-UX older versions -Aa -D_HPUX_SOURCE -# SVR4 -Xc -D__EXTENSIONS__ -for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" - rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_prog_cc_stdc=$ac_arg -break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg fi -rm -f conftest.err conftest.$ac_objext +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break done -rm -f conftest.$ac_ext conftest.$ac_objext +rm -f conftest.$ac_ext CC=$ac_save_CC fi - -case "x$ac_cv_prog_cc_stdc" in - x|xno) - echo "$as_me:$LINENO: result: none needed" >&5 -echo "${ECHO_T}none needed" >&6 ;; +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; *) - echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 -echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 - CC="$CC $ac_cv_prog_cc_stdc" ;; + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; esac +if test "x$ac_cv_prog_cc_c89" != xno; then : -# Some people use a C++ compiler to compile C. Since we use `exit', -# in C++ we need to declare it. In case someone uses the same compiler -# for both compiling C and C++ we need to have the C++ compiler decide -# the declaration of exit, since it's the most demanding environment. -cat >conftest.$ac_ext <<_ACEOF -#ifndef __cplusplus - choke me -#endif -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - for ac_declaration in \ - '' \ - 'extern "C" void std::exit (int) throw (); using std::exit;' \ - 'extern "C" void std::exit (int); using std::exit;' \ - 'extern "C" void exit (int) throw ();' \ - 'extern "C" void exit (int);' \ - 'void exit (int);' -do - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_declaration -#include -int -main () -{ -exit (42); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - : -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -continue -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_declaration -int -main () -{ -exit (42); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -done -rm -f conftest* -if test -n "$ac_declaration"; then - echo '#ifdef __cplusplus' >>confdefs.h - echo $ac_declaration >>confdefs.h - echo '#endif' >>confdefs.h fi -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -2285,18 +2918,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -echo "$as_me:$LINENO: checking for inline" >&5 -echo $ECHO_N "checking for inline... $ECHO_C" >&6 -if test "${ac_cv_c_inline+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } +if ${ac_cv_c_inline+:} false; then : + $as_echo_n "(cached) " >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; @@ -2305,41 +2934,16 @@ $ac_kw foo_t foo () {return 0; } #endif _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_c_inline=$ac_kw; break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_inline=$ac_kw fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$ac_cv_c_inline" != no && break done fi -echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 -echo "${ECHO_T}$ac_cv_c_inline" >&6 - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 +$as_echo "$ac_cv_c_inline" >&6; } case $ac_cv_c_inline in inline | yes) ;; @@ -2361,15 +2965,15 @@ ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu -echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 -echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" @@ -2383,11 +2987,7 @@ do # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __STDC__ # include @@ -2396,78 +2996,34 @@ cat >>conftest.$ac_ext <<_ACEOF #endif Syntax error _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - : -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if ac_fn_c_try_cpp "$LINENO"; then : +else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext - # OK, works on sane cases. Now check whether non-existent headers + # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then +if ac_fn_c_try_cpp "$LINENO"; then : # Broken: success on invalid input. continue else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - # Passes both tests. ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext -if $ac_preproc_ok; then +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : break fi @@ -2479,8 +3035,8 @@ fi else ac_cv_prog_CPP=$CPP fi -echo "$as_me:$LINENO: result: $CPP" >&5 -echo "${ECHO_T}$CPP" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do @@ -2490,11 +3046,7 @@ do # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __STDC__ # include @@ -2503,85 +3055,40 @@ cat >>conftest.$ac_ext <<_ACEOF #endif Syntax error _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - : -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if ac_fn_c_try_cpp "$LINENO"; then : +else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext - # OK, works on sane cases. Now check whether non-existent headers + # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then +if ac_fn_c_try_cpp "$LINENO"; then : # Broken: success on invalid input. continue else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - # Passes both tests. ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext -if $ac_preproc_ok; then - : +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + else - { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." >&5 -echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5 ; } fi ac_ext=c @@ -2591,31 +3098,142 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -echo "$as_me:$LINENO: checking for egrep" >&5 -echo $ECHO_N "checking for egrep... $ECHO_C" >&6 -if test "${ac_cv_prog_egrep+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 else - if echo a | (grep -E '(a|b)') >/dev/null 2>&1 - then ac_cv_prog_egrep='grep -E' - else ac_cv_prog_egrep='egrep' + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + fi -echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 -echo "${ECHO_T}$ac_cv_prog_egrep" >&6 - EGREP=$ac_cv_prog_egrep +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" -echo "$as_me:$LINENO: checking for ANSI C header files" >&5 -echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 -if test "${ac_cv_header_stdc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include @@ -2630,51 +3248,23 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_header_stdc=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_header_stdc=no + ac_cv_header_stdc=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then - : + $EGREP "memchr" >/dev/null 2>&1; then : + else ac_cv_header_stdc=no fi @@ -2684,18 +3274,14 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then - : + $EGREP "free" >/dev/null 2>&1; then : + else ac_cv_header_stdc=no fi @@ -2705,16 +3291,13 @@ fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then + if test "$cross_compiling" = yes; then : : else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include +#include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) @@ -2734,41 +3317,26 @@ main () for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) - exit(2); - exit (0); + return 2; + return 0; } _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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 - : -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if ac_fn_c_try_run "$LINENO"; then : -( exit $ac_status ) -ac_cv_header_stdc=no +else + ac_cv_header_stdc=no fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi + fi fi -echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 -echo "${ECHO_T}$ac_cv_header_stdc" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then -cat >>confdefs.h <<\_ACEOF -#define STDC_HEADERS 1 -_ACEOF +$as_echo "#define STDC_HEADERS 1" >>confdefs.h fi @@ -2776,10 +3344,10 @@ fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_AR+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. @@ -2789,35 +3357,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_AR="${ac_tool_prefix}ar" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then - echo "$as_me:$LINENO: result: $AR" >&5 -echo "${ECHO_T}$AR" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_AR+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. @@ -2827,27 +3397,38 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_AR="ar" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then - echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 -echo "${ECHO_T}$ac_ct_AR" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - AR=$ac_ct_AR + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi else AR="$ac_cv_prog_AR" fi @@ -2855,10 +3436,10 @@ fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -2868,35 +3449,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then - echo "$as_me:$LINENO: result: $RANLIB" >&5 -echo "${ECHO_T}$RANLIB" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. @@ -2906,27 +3489,38 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_RANLIB="ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then - echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 -echo "${ECHO_T}$ac_ct_RANLIB" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - RANLIB=$ac_ct_RANLIB + if test "x$ac_ct_RANLIB" = x; then + RANLIB="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi else RANLIB="$ac_cv_prog_RANLIB" fi @@ -2934,10 +3528,10 @@ fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. set dummy ${ac_tool_prefix}windres; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_RC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. @@ -2947,35 +3541,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_RC="${ac_tool_prefix}windres" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi RC=$ac_cv_prog_RC if test -n "$RC"; then - echo "$as_me:$LINENO: result: $RC" >&5 -echo "${ECHO_T}$RC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5 +$as_echo "$RC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_RC"; then ac_ct_RC=$RC # Extract the first word of "windres", so it can be a program name with args. set dummy windres; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_RC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RC"; then ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. @@ -2985,27 +3581,38 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_RC="windres" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_RC=$ac_cv_prog_ac_ct_RC if test -n "$ac_ct_RC"; then - echo "$as_me:$LINENO: result: $ac_ct_RC" >&5 -echo "${ECHO_T}$ac_ct_RC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5 +$as_echo "$ac_ct_RC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - RC=$ac_ct_RC + if test "x$ac_ct_RC" = x; then + RC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RC=$ac_ct_RC + fi else RC="$ac_cv_prog_RC" fi @@ -3015,32 +3622,34 @@ fi # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- -echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` -if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF +SHELL = /bin/sh all: - @echo 'ac_maketemp="$(MAKE)"' + @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` -if test -n "$ac_maketemp"; then - eval ac_cv_prog_make_${ac_make}_set=yes -else - eval ac_cv_prog_make_${ac_make}_set=no -fi +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac rm -f conftest.make fi -if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } SET_MAKE= else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi @@ -3057,34 +3666,30 @@ fi #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking for building with threads" >&5 -echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 - # Check whether --enable-threads or --disable-threads was given. -if test "${enable_threads+set}" = set; then - enableval="$enable_threads" - tcl_ok=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5 +$as_echo_n "checking for building with threads... " >&6; } + # Check whether --enable-threads was given. +if test "${enable_threads+set}" = set; then : + enableval=$enable_threads; tcl_ok=$enableval else tcl_ok=yes -fi; +fi + if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes (default)" >&5 -echo "${ECHO_T}yes (default)" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (default)" >&5 +$as_echo "yes (default)" >&6; } TCL_THREADS=1 - cat >>confdefs.h <<\_ACEOF -#define TCL_THREADS 1 -_ACEOF + $as_echo "#define TCL_THREADS 1" >>confdefs.h # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention - cat >>confdefs.h <<\_ACEOF -#define USE_THREAD_ALLOC 1 -_ACEOF + $as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h else TCL_THREADS=0 - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi @@ -3095,11 +3700,11 @@ echo "${ECHO_T}no" >&6 -# Check whether --with-encoding or --without-encoding was given. -if test "${with_encoding+set}" = set; then - withval="$with_encoding" - with_tcencoding=${withval} -fi; +# Check whether --with-encoding was given. +if test "${with_encoding+set}" = set; then : + withval=$with_encoding; with_tcencoding=${withval} +fi + if test x"${with_tcencoding}" != x ; then cat >>confdefs.h <<_ACEOF @@ -3108,9 +3713,7 @@ _ACEOF else # Default encoding on windows is not "iso8859-1" - cat >>confdefs.h <<\_ACEOF -#define TCL_CFGVAL_ENCODING "cp1252" -_ACEOF + $as_echo "#define TCL_CFGVAL_ENCODING \"cp1252\"" >>confdefs.h fi @@ -3121,15 +3724,15 @@ _ACEOF #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking how to build libraries" >&5 -echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 - # Check whether --enable-shared or --disable-shared was given. -if test "${enable_shared+set}" = set; then - enableval="$enable_shared" - tcl_ok=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 +$as_echo_n "checking how to build libraries... " >&6; } + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; tcl_ok=$enableval else tcl_ok=yes -fi; +fi + if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -3139,17 +3742,15 @@ fi; fi if test "$tcl_ok" = "yes" ; then - echo "$as_me:$LINENO: result: shared" >&5 -echo "${ECHO_T}shared" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5 +$as_echo "shared" >&6; } SHARED_BUILD=1 else - echo "$as_me:$LINENO: result: static" >&5 -echo "${ECHO_T}static" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5 +$as_echo "static" >&6; } SHARED_BUILD=0 -cat >>confdefs.h <<\_ACEOF -#define STATIC_BUILD 1 -_ACEOF +$as_echo "#define STATIC_BUILD 1" >>confdefs.h fi @@ -3161,70 +3762,15 @@ _ACEOF #-------------------------------------------------------------------- # On IRIX 5.3, sys/types and inttypes.h are conflicting. - - - - - - - - - for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+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. */ -$ac_includes_default - -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - eval "$as_ac_Header=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_Header=no" -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -if test `eval echo '${'$as_ac_Header'}'` = yes; then +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -3236,59 +3782,57 @@ done # Step 0: Enable 64 bit support? - echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 -echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 - # Check whether --enable-64bit or --disable-64bit was given. -if test "${enable_64bit+set}" = set; then - enableval="$enable_64bit" - do64bit=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 +$as_echo_n "checking if 64bit support is requested... " >&6; } + # Check whether --enable-64bit was given. +if test "${enable_64bit+set}" = set; then : + enableval=$enable_64bit; do64bit=$enableval else do64bit=no -fi; - echo "$as_me:$LINENO: result: $do64bit" >&5 -echo "${ECHO_T}$do64bit" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 +$as_echo "$do64bit" >&6; } # Cross-compiling options for Windows/CE builds - echo "$as_me:$LINENO: checking if Windows/CE build is requested" >&5 -echo $ECHO_N "checking if Windows/CE build is requested... $ECHO_C" >&6 - # Check whether --enable-wince or --disable-wince was given. -if test "${enable_wince+set}" = set; then - enableval="$enable_wince" - doWince=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Windows/CE build is requested" >&5 +$as_echo_n "checking if Windows/CE build is requested... " >&6; } + # Check whether --enable-wince was given. +if test "${enable_wince+set}" = set; then : + enableval=$enable_wince; doWince=$enableval else doWince=no -fi; - echo "$as_me:$LINENO: result: $doWince" >&5 -echo "${ECHO_T}$doWince" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doWince" >&5 +$as_echo "$doWince" >&6; } - echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5 -echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows/CE celib directory" >&5 +$as_echo_n "checking for Windows/CE celib directory... " >&6; } -# Check whether --with-celib or --without-celib was given. -if test "${with_celib+set}" = set; then - withval="$with_celib" - CELIB_DIR=$withval +# Check whether --with-celib was given. +if test "${with_celib+set}" = set; then : + withval=$with_celib; CELIB_DIR=$withval else CELIB_DIR=NO_CELIB -fi; - echo "$as_me:$LINENO: result: $CELIB_DIR" >&5 -echo "${ECHO_T}$CELIB_DIR" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CELIB_DIR" >&5 +$as_echo "$CELIB_DIR" >&6; } # Set some defaults (may get changed below) EXTRA_CFLAGS="" -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE extern -_ACEOF +$as_echo "#define MODULE_SCOPE extern" >>confdefs.h # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CYGPATH+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. @@ -3298,28 +3842,30 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CYGPATH="cygpath -w" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" fi fi CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then - echo "$as_me:$LINENO: result: $CYGPATH" >&5 -echo "${ECHO_T}$CYGPATH" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, @@ -3328,16 +3874,12 @@ fi if test "$GCC" = "yes"; then - echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5 -echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6 -if test "${ac_cv_cross+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5 +$as_echo_n "checking for cross-compile version of gcc... " >&6; } +if ${ac_cv_cross+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef _WIN32 @@ -3352,40 +3894,16 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_cross=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_cross=yes + ac_cv_cross=yes fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_cross" >&5 -echo "${ECHO_T}$ac_cv_cross" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5 +$as_echo "$ac_cv_cross" >&6; } if test "$ac_cv_cross" = "yes"; then case "$do64bit" in @@ -3420,20 +3938,20 @@ echo "${ECHO_T}$ac_cv_cross" >&6 echo "101 \"name\"" >> $conftest echo "END" >> $conftest - echo "$as_me:$LINENO: checking for Windows native path bug in windres" >&5 -echo $ECHO_N "checking for Windows native path bug in windres... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5 +$as_echo_n "checking for Windows native path bug in windres... " >&6; } cyg_conftest=`$CYGPATH $conftest` if { ac_try='$RC -o conftest.res.o $cyg_conftest' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } ; then - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; } ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } else - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } CYGPATH=echo fi conftest= @@ -3451,16 +3969,12 @@ echo "${ECHO_T}yes" >&6 if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" - echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5 -echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6 -if test "${ac_cv_win32+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5 +$as_echo_n "checking for mingw32 version of gcc... " >&6; } +if ${ac_cv_win32+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef _WIN32 @@ -3475,57 +3989,73 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_win32=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_win32=yes + ac_cv_win32=yes fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_win32" >&5 -echo "${ECHO_T}$ac_cv_win32" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5 +$as_echo "$ac_cv_win32" >&6; } if test "$ac_cv_win32" != "yes"; then - { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5 -echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5 fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" - echo "$as_me:$LINENO: checking for working -municode linker flag" >&5 -echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6 -if test "${ac_cv_municode+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5 +$as_echo_n "checking for working -municode linker flag... " >&6; } +if ${ac_cv_municode+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -3539,41 +4069,17 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_municode=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_municode=no + ac_cv_municode=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_municode" >&5 -echo "${ECHO_T}$ac_cv_municode" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5 +$as_echo "$ac_cv_municode" >&6; } CFLAGS=$hold_cflags if test "$ac_cv_municode" = "yes" ; then extra_ldflags="$extra_ldflags -municode" @@ -3582,8 +4088,8 @@ echo "${ECHO_T}$ac_cv_municode" >&6 fi fi - echo "$as_me:$LINENO: checking compiler flags" >&5 -echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5 +$as_echo_n "checking compiler flags... " >&6; } if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS='${LIBS}' @@ -3604,23 +4110,20 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${SHARED_BUILD}" = "0" ; then # static - echo "$as_me:$LINENO: result: using static flags" >&5 -echo "${ECHO_T}using static flags" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5 +$as_echo "using static flags" >&6; } runtime= LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic - echo "$as_me:$LINENO: result: using shared flags" >&5 -echo "${ECHO_T}using shared flags" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5 +$as_echo "using shared flags" >&6; } # ad-hoc check to see if CC supports -shared. if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then - { { echo "$as_me:$LINENO: error: ${CC} does not support the -shared option. - You will need to upgrade to a newer version of the toolchain." >&5 -echo "$as_me: error: ${CC} does not support the -shared option. - You will need to upgrade to a newer version of the toolchain." >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "${CC} does not support the -shared option. + You will need to upgrade to a newer version of the toolchain." "$LINENO" 5 fi runtime= @@ -3674,20 +4177,16 @@ echo "$as_me: error: ${CC} does not support the -shared option. case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 +$as_echo " Using 64-bit $MACHINE mode" >&6; } ;; ia64) MACHINE="IA64" - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 +$as_echo " Using 64-bit $MACHINE mode" >&6; } ;; *) - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef _WIN64 @@ -3702,57 +4201,33 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_win_64bit=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_win_64bit=no + tcl_win_64bit=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then do64bit=amd64 MACHINE="AMD64" - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 +$as_echo " Using 64-bit $MACHINE mode" >&6; } fi ;; esac else if test "${SHARED_BUILD}" = "0" ; then # static - echo "$as_me:$LINENO: result: using static flags" >&5 -echo "${ECHO_T}using static flags" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5 +$as_echo "using static flags" >&6; } runtime=-MT LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic - echo "$as_me:$LINENO: result: using shared flags" >&5 -echo "${ECHO_T}using shared flags" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5 +$as_echo "using shared flags" >&6; } runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. LIBRARIES="\${SHARED_LIBRARIES}" @@ -3785,14 +4260,14 @@ echo "${ECHO_T}using shared flags" >&6 ;; esac if test ! -d "${PATH64}" ; then - { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 -echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} - { echo "$as_me:$LINENO: WARNING: Ensure latest Platform SDK is installed" >&5 -echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 +$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ensure latest Platform SDK is installed" >&5 +$as_echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} do64bit="no" else - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 +$as_echo " Using 64-bit $MACHINE mode" >&6; } fi fi @@ -3803,64 +4278,9 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 # TEA_PATH_NOSPACE to avoid this issue. # Check if _WIN64 is already recognized, and if so we don't # need to modify CC. - echo "$as_me:$LINENO: checking whether _WIN64 is declared" >&5 -echo $ECHO_N "checking whether _WIN64 is declared... $ECHO_C" >&6 -if test "${ac_cv_have_decl__WIN64+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. */ -$ac_includes_default -int -main () -{ -#ifndef _WIN64 - char *p = (char *) _WIN64; -#endif - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_have_decl__WIN64=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + ac_fn_c_check_decl "$LINENO" "_WIN64" "ac_cv_have_decl__WIN64" "$ac_includes_default" +if test "x$ac_cv_have_decl__WIN64" = xyes; then : -ac_cv_have_decl__WIN64=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_have_decl__WIN64" >&5 -echo "${ECHO_T}$ac_cv_have_decl__WIN64" >&6 -if test $ac_cv_have_decl__WIN64 = yes; then - : else CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ -I\"${MSSDK}/Include/crt\" \ @@ -3928,15 +4348,11 @@ fi SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` if test ! -d "${CELIB_DIR}/inc"; then - { { echo "$as_me:$LINENO: error: Invalid celib directory \"${CELIB_DIR}\"" >&5 -echo "$as_me: error: Invalid celib directory \"${CELIB_DIR}\"" >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "Invalid celib directory \"${CELIB_DIR}\"" "$LINENO" 5 fi if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then - { { echo "$as_me:$LINENO: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&5 -echo "$as_me: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" "$LINENO" 5 else CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" if test -d "${CEINCLUDE}/${TARGETCPU}" ; then @@ -4032,26 +4448,20 @@ _ACEOF fi if test "$do64bit" != "no" ; then - cat >>confdefs.h <<\_ACEOF -#define TCL_CFG_DO64BIT 1 -_ACEOF + $as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h fi if test "${GCC}" = "yes" ; then - echo "$as_me:$LINENO: checking for SEH support in compiler" >&5 -echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6 -if test "${tcl_cv_seh+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5 +$as_echo_n "checking for SEH support in compiler... " >&6; } +if ${tcl_cv_seh+:} false; then : + $as_echo_n "(cached) " >&6 else - if test "$cross_compiling" = yes; then + if test "$cross_compiling" = yes; then : tcl_cv_seh=no else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -4070,37 +4480,22 @@ cat >>conftest.$ac_ext <<_ACEOF } _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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 +if ac_fn_c_try_run "$LINENO"; then : tcl_cv_seh=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_seh=no + tcl_cv_seh=no fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi + fi -echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5 -echo "${ECHO_T}$tcl_cv_seh" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 +$as_echo "$tcl_cv_seh" >&6; } if test "$tcl_cv_seh" = "no" ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_NO_SEH 1 -_ACEOF +$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h fi @@ -4110,16 +4505,12 @@ _ACEOF # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # - echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5 -echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6 -if test "${tcl_cv_eh_disposition+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5 +$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; } +if ${tcl_cv_eh_disposition+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ # define WIN32_LEAN_AND_MEAN @@ -4136,45 +4527,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_eh_disposition=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_eh_disposition=no + tcl_cv_eh_disposition=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5 -echo "${ECHO_T}$tcl_cv_eh_disposition" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5 +$as_echo "$tcl_cv_eh_disposition" >&6; } if test "$tcl_cv_eh_disposition" = "no" ; then -cat >>confdefs.h <<\_ACEOF -#define EXCEPTION_DISPOSITION int -_ACEOF +$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h fi @@ -4182,16 +4547,12 @@ _ACEOF # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. - echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5 -echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6 -if test "${tcl_cv_winnt_ignore_void+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5 +$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; } +if ${tcl_cv_winnt_ignore_void+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define VOID void @@ -4211,45 +4572,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_winnt_ignore_void=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_winnt_ignore_void=no + tcl_cv_winnt_ignore_void=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5 -echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5 +$as_echo "$tcl_cv_winnt_ignore_void" >&6; } if test "$tcl_cv_winnt_ignore_void" = "yes" ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_WINNT_IGNORE_VOID 1 -_ACEOF +$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h fi @@ -4257,16 +4592,12 @@ _ACEOF # This is used to stop gcc from printing a compiler # warning when initializing a union member. - echo "$as_me:$LINENO: checking for cast to union support" >&5 -echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 -if test "${tcl_cv_cast_to_union+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 +$as_echo_n "checking for cast to union support... " >&6; } +if ${tcl_cv_cast_to_union+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4280,45 +4611,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_cast_to_union=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cast_to_union=no + tcl_cv_cast_to_union=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 -echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 +$as_echo "$tcl_cv_cast_to_union" >&6; } if test "$tcl_cv_cast_to_union" = "yes"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_CAST_TO_UNION 1 -_ACEOF +$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi fi @@ -4345,7 +4650,7 @@ esac # as we just assume that the platform hasn't got a usable z.lib #------------------------------------------------------------------------ -if test "${enable_shared+set}" = "set"; then +if test "${enable_shared+set}" = "set"; then : enableval="$enable_shared" tcl_ok=$enableval @@ -4356,311 +4661,130 @@ else fi -if test "$tcl_ok" = "yes"; then +# Check whether --with-zlib was given. +if test "${with_zlib+set}" = set; then : + withval=$with_zlib; with_zlib=$withval +else + with_zlib=NO_ZLIB - ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} +fi - if test "$do64bit" = "yes"; then +if test "with_zlib" = "NO_ZLIB"; then : + ZLIB_OBJS=\${ZLIB_OBJS} - if test "$GCC" == "yes"; then +elif test "$tcl_ok" != "yes"; then : + ZLIB_OBJS=\${ZLIB_OBJS} - ZLIB_LIBS=\${ZLIB_DIR}/win64/libz.dll.a +elif test "$do64bit" = "yes"; then : + ZLIB_OBJS=\${ZLIB_OBJS} +elif test "$with_zlib" = "yes" ; then : + ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib else - - ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib + ZLIB_LIBS=$with_zlib fi +$as_echo "#define HAVE_ZLIB 1" >>confdefs.h -else - - ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib +ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default" +if test "x$ac_cv_type_intptr_t" = xyes; then : -fi +$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h else - ZLIB_OBJS=\${ZLIB_OBJS} - - -fi - - -cat >>confdefs.h <<\_ACEOF -#define HAVE_ZLIB 1 -_ACEOF - - -echo "$as_me:$LINENO: checking for intptr_t" >&5 -echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 -if test "${ac_cv_type_intptr_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5 +$as_echo_n "checking for pointer-size signed integer type... " >&6; } +if ${tcl_cv_intptr_t+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int main () { -if ((intptr_t *) 0) - return 0; -if (sizeof (intptr_t)) - return 0; +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +test_array [0] = 0 + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_intptr_t=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_ok=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_intptr_t=no + tcl_ok=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5 +$as_echo "$tcl_cv_intptr_t" >&6; } + if test "$tcl_cv_intptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define intptr_t $tcl_cv_intptr_t +_ACEOF + + fi + fi -echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 -echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 -if test $ac_cv_type_intptr_t = yes; then +ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default" +if test "x$ac_cv_type_uintptr_t" = xyes; then : -cat >>confdefs.h <<\_ACEOF -#define HAVE_INTPTR_T 1 -_ACEOF + +$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h else - echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 -echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 -if test "${tcl_cv_intptr_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5 +$as_echo_n "checking for pointer-size unsigned integer type... " >&6; } +if ${tcl_cv_uintptr_t+:} false; then : + $as_echo_n "(cached) " >&6 else - for tcl_cv_intptr_t in "int" "long" "long long" none; do - if test "$tcl_cv_intptr_t" != none; then - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int main () { -static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; test_array [0] = 0 ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_ok=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_ok=no + tcl_ok=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext test "$tcl_ok" = yes && break; fi done fi -echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 -echo "${ECHO_T}$tcl_cv_intptr_t" >&6 - if test "$tcl_cv_intptr_t" != none; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5 +$as_echo "$tcl_cv_uintptr_t" >&6; } + if test "$tcl_cv_uintptr_t" != none; then cat >>confdefs.h <<_ACEOF -#define intptr_t $tcl_cv_intptr_t -_ACEOF - - fi - -fi - -echo "$as_me:$LINENO: checking for uintptr_t" >&5 -echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 -if test "${ac_cv_type_uintptr_t+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. */ -$ac_includes_default -int -main () -{ -if ((uintptr_t *) 0) - return 0; -if (sizeof (uintptr_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_uintptr_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_uintptr_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 -echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 -if test $ac_cv_type_uintptr_t = yes; then - - -cat >>confdefs.h <<\_ACEOF -#define HAVE_UINTPTR_T 1 -_ACEOF - -else - - echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 -echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 -if test "${tcl_cv_uintptr_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ - none; do - if test "$tcl_cv_uintptr_t" != none; then - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; -test_array [0] = 0 - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_ok=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_ok=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - test "$tcl_ok" = yes && break; fi - done -fi -echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 -echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 - if test "$tcl_cv_uintptr_t" != none; then - -cat >>confdefs.h <<_ACEOF -#define uintptr_t $tcl_cv_uintptr_t +#define uintptr_t $tcl_cv_uintptr_t _ACEOF fi @@ -4676,16 +4800,12 @@ fi # missing from winbase.h. This is known to be # a problem with VC++ 5.2. -echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 -echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 -if test "${tcl_cv_findex_enums+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 +$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } +if ${tcl_cv_findex_enums+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -4703,60 +4823,30 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_findex_enums=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_findex_enums=no + tcl_cv_findex_enums=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 -echo "${ECHO_T}$tcl_cv_findex_enums" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 +$as_echo "$tcl_cv_findex_enums" >&6; } if test "$tcl_cv_findex_enums" = "no"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_NO_FINDEX_ENUMS 1 -_ACEOF +$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h fi # See if the compiler supports intrinsics. -echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5 -echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6 -if test "${tcl_cv_intrinsics+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5 +$as_echo_n "checking for intrinsics support in compiler... " >&6; } +if ${tcl_cv_intrinsics+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -4774,61 +4864,31 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_intrinsics=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_intrinsics=no + tcl_cv_intrinsics=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5 -echo "${ECHO_T}$tcl_cv_intrinsics" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5 +$as_echo "$tcl_cv_intrinsics" >&6; } if test "$tcl_cv_intrinsics" = "yes"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_INTRIN_H 1 -_ACEOF +$as_echo "#define HAVE_INTRIN_H 1" >>confdefs.h fi # See if the header file is present -echo "$as_me:$LINENO: checking for wspiapi.h" >&5 -echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6 -if test "${tcl_cv_wspiapi_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5 +$as_echo_n "checking for wspiapi.h... " >&6; } +if ${tcl_cv_wspiapi_h+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -4841,45 +4901,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_wspiapi_h=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_wspiapi_h=no + tcl_cv_wspiapi_h=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5 -echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5 +$as_echo "$tcl_cv_wspiapi_h" >&6; } if test "$tcl_cv_wspiapi_h" = "yes"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_WSPIAPI_H 1 -_ACEOF +$as_echo "#define HAVE_WSPIAPI_H 1" >>confdefs.h fi @@ -4887,16 +4921,12 @@ fi # missing from winbase.h. This is known to be # a problem with VC++ 5.2. -echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 -echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 -if test "${tcl_cv_findex_enums+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 +$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } +if ${tcl_cv_findex_enums+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -4914,45 +4944,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_findex_enums=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_findex_enums=no + tcl_cv_findex_enums=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 -echo "${ECHO_T}$tcl_cv_findex_enums" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 +$as_echo "$tcl_cv_findex_enums" >&6; } if test "$tcl_cv_findex_enums" = "no"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_NO_FINDEX_ENUMS 1 -_ACEOF +$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h fi @@ -4963,39 +4967,35 @@ fi #-------------------------------------------------------------------- - 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. -if test "${enable_symbols+set}" = set; then - enableval="$enable_symbols" - tcl_ok=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 +$as_echo_n "checking for build with symbols... " >&6; } + # Check whether --enable-symbols was given. +if test "${enable_symbols+set}" = set; then : + enableval=$enable_symbols; tcl_ok=$enableval else tcl_ok=no -fi; +fi + # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" -cat >>confdefs.h <<\_ACEOF -#define NDEBUG 1 -_ACEOF +$as_echo "#define NDEBUG 1" >>confdefs.h - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } - cat >>confdefs.h <<\_ACEOF -#define TCL_CFG_OPTIMIZED 1 -_ACEOF + $as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=g if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 -echo "${ECHO_T}yes (standard debugging)" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 +$as_echo "yes (standard debugging)" >&6; } fi fi @@ -5003,32 +5003,26 @@ echo "${ECHO_T}yes (standard debugging)" >&6 if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then -cat >>confdefs.h <<\_ACEOF -#define TCL_MEM_DEBUG 1 -_ACEOF +$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then -cat >>confdefs.h <<\_ACEOF -#define TCL_COMPILE_DEBUG 1 -_ACEOF +$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define TCL_COMPILE_STATS 1 -_ACEOF +$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then - echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 -echo "${ECHO_T}enabled symbols mem compile debugging" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5 +$as_echo "enabled symbols mem compile debugging" >&6; } else - echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 -echo "${ECHO_T}enabled $tcl_ok debugging" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 +$as_echo "enabled $tcl_ok debugging" >&6; } fi fi @@ -5040,15 +5034,15 @@ TCL_DBGX=${DBGX} #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking whether to embed manifest" >&5 -echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6 - # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given. -if test "${enable_embedded_manifest+set}" = set; then - enableval="$enable_embedded_manifest" - embed_ok=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5 +$as_echo_n "checking whether to embed manifest... " >&6; } + # Check whether --enable-embedded-manifest was given. +if test "${enable_embedded_manifest+set}" = set; then : + enableval=$enable_embedded_manifest; embed_ok=$enableval else embed_ok=yes -fi; +fi + VC_MANIFEST_EMBED_DLL= VC_MANIFEST_EMBED_EXE= @@ -5056,11 +5050,7 @@ fi; if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ -a "$GCC" != "yes" ; then # Add the magic to embed the manifest into the dll/exe - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #if defined(_MSC_VER) && _MSC_VER >= 1400 @@ -5069,7 +5059,7 @@ print("manifest needed") _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "manifest needed" >/dev/null 2>&1; then + $EGREP "manifest needed" >/dev/null 2>&1; then : # Could do a CHECK_PROG for mt, but should always be with MSVC8+ # Could add 'if test -f' check, but manifest should be created @@ -5088,8 +5078,8 @@ fi rm -f conftest* fi - echo "$as_me:$LINENO: result: $result" >&5 -echo "${ECHO_T}$result" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $result" >&5 +$as_echo "$result" >&6; } @@ -5275,7 +5265,8 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d - ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest" +ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest" + cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure @@ -5294,39 +5285,70 @@ _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. -# So, don't put newlines in cache variables' values. +# So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -{ +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | - case `(ac_space=' '; set | grep ac_space) 2>&1` in - *ac_space=\ *) - # `set' does not quote correctly, so add quotes (double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \). + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" - ;; + ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n \ - "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; - esac; -} | + esac | + sort +) | sed ' + /^ac_cv_env_/b end t clear - : clear + :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end - /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - : end' >>confcache -if diff $cache_file confcache >/dev/null 2>&1; then :; else - if test -w $cache_file; then - test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" - cat confcache >$cache_file + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi else - echo "not updating unwritable cache $cache_file" + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache @@ -5335,63 +5357,55 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' -# VPATH may cause trouble with some makes, so we remove $(srcdir), -# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and -# trailing colons and then remove the whole line if VPATH becomes empty -# (actually we leave an empty line to preserve line numbers). -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=/{ -s/:*\$(srcdir):*/:/; -s/:*\${srcdir}:*/:/; -s/:*@srcdir@:*/:/; -s/^\([^=]*=[ ]*\):*/\1/; -s/:*$//; -s/^[^=]*=[ ]*$//; -}' -fi - # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that -# take arguments), then we branch to the quote section. Otherwise, +# take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. -cat >confdef2opt.sed <<\_ACEOF +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} t clear -: clear -s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote -s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote -d -: quote -s,[ `~#$^&*(){}\\|;'"<>?],\\&,g -s,\[,\\&,g -s,\],\\&,g -s,\$,$$,g -p -_ACEOF -# We use echo to avoid assuming a particular line-breaking character. -# The extra dot is to prevent the shell from consuming trailing -# line-breaks from the sub-command output. A line-break within -# single-quotes doesn't work because, if this script is created in a -# platform that uses two characters for line-breaks (e.g., DOS), tr -# would break. -ac_LF_and_DOT=`echo; echo .` -DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` -rm -f confdef2opt.sed +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= +U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. - ac_i=`echo "$ac_i" | - sed 's/\$U\././;s/\.o$//;s/\.obj$//'` - # 2. Add them. - ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" - ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs @@ -5399,12 +5413,14 @@ LTLIBOBJS=$ac_ltlibobjs -: ${CONFIG_STATUS=./config.status} +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 -echo "$as_me: creating $CONFIG_STATUS" >&6;} -cat >$CONFIG_STATUS <<_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. @@ -5414,81 +5430,253 @@ cat >$CONFIG_STATUS <<_ACEOF debug=false ac_cs_recheck=false ac_cs_silent=false -SHELL=\${CONFIG_SHELL-$SHELL} -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -## --------------------- ## -## M4sh Initialization. ## -## --------------------- ## - -# Be Bourne compatible -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' -elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then - set -o posix + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac fi -DUALCASE=1; export DUALCASE # for MKS sh -# Support unset when possible. -if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - as_unset=unset -else - as_unset=false + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' fi +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS -# Work around bugs in pre-3.0 UWIN ksh. -$as_unset ENV MAIL MAILPATH + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME -do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var - else - $as_unset $as_var +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi -done + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status -# Required to use basename. -if expr a : '\(a\)' >/dev/null 2>&1; then +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi -if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi -# Name of the executable. -as_me=`$as_basename "$0" || +as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)$' \| \ - . : '\(.\)' 2>/dev/null || -echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } - /^X\/\(\/\/\)$/{ s//\1/; q; } - /^X\/\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` - -# PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -5496,148 +5684,123 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh -fi - - - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" || { - # Find who we are. Look in the path if we contain no path at all - # relative or not. - case $0 in - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break -done - - ;; - esac - # We did not find ourselves, most probably we were run as `sh COMMAND' - # in which case we are not to be found in the path. - if test "x$as_myself" = x; then - as_myself=$0 - fi - if test ! -f "$as_myself"; then - { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 -echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} - { (exit 1); exit 1; }; } - fi - case $CONFIG_SHELL in - '') - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for as_base in sh bash ksh sh5; do - case $as_dir in - /*) - if ("$as_dir/$as_base" -c ' - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then - $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } - $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } - CONFIG_SHELL=$as_dir/$as_base - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$0" ${1+"$@"} - fi;; - esac - done -done -;; - esac - - # Create $as_me.lineno as a copy of $as_myself, but with $LINENO - # uniformly replaced by the line number. The first 'sed' inserts a - # line-number line before each line; the second 'sed' does the real - # work. The second script uses 'N' to pair each line-number line - # with the numbered line, and appends trailing '-' during - # substitution so that $LINENO is not a special case at line end. - # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the - # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) - sed '=' <$as_myself | - sed ' - N - s,$,-, - : loop - s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, - t loop - s,-$,, - s,^['$as_cr_digits']*\n,, - ' >$as_me.lineno && - chmod +x $as_me.lineno || - { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 -echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} - { (exit 1); exit 1; }; } - - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensible to this). - . ./$as_me.lineno - # Exit status is that of the last command. - exit -} - - -case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in - *c*,-n*) ECHO_N= ECHO_C=' -' ECHO_T=' ' ;; - *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; - *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; esac -if expr a : '\(a\)' >/dev/null 2>&1; then - as_expr=expr +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file else - as_expr=false + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null fi - -rm -f conf$$ conf$$.exe conf$$.file -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - # We could just check for DJGPP; but this test a) works b) is more generic - # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). - if test -f conf$$.exe; then - # Don't use ln at all; we don't have any links - as_ln_s='cp -p' - else +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' fi -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln else as_ln_s='cp -p' fi -rm -f conf$$ conf$$.exe conf$$.file +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then - as_mkdir_p=: + as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi -as_executable_p="test -f" +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -5646,31 +5809,20 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" -# IFS -# We need space, tab and new line, in precisely that order. -as_nl=' -' -IFS=" $as_nl" - -# CDPATH. -$as_unset CDPATH - exec 6>&1 - -# Open the log real soon, to keep \$[0] and so on meaningful, and to +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. Logging --version etc. is OK. -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX -} >&5 -cat >&5 <<_CSEOF - +# values after options handling. +ac_log=" This file was extended by $as_me, which was -generated by GNU Autoconf 2.59. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -5678,124 +5830,116 @@ generated by GNU Autoconf 2.59. Invocation command line was CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ -_CSEOF -echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 -echo >&5 +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + _ACEOF -# Files that config.status was made for. -if test -n "$ac_config_files"; then - echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS -fi +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac -if test -n "$ac_config_headers"; then - echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS -fi -if test -n "$ac_config_links"; then - echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS -fi -if test -n "$ac_config_commands"; then - echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS -fi +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" -cat >>$CONFIG_STATUS <<\_ACEOF +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -\`$as_me' instantiates files from templates according to the -current configuration. +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. -Usage: $0 [OPTIONS] [FILE]... +Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit - -V, --version print version number, then exit - -q, --quiet do not print progress messages + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE Configuration files: $config_files -Report bugs to ." -_ACEOF +Report bugs to the package provider." -cat >>$CONFIG_STATUS <<_ACEOF +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ config.status -configured by $0, generated by GNU Autoconf 2.59, - with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" +configured by $0, generated by GNU Autoconf 2.68, + with options \\"\$ac_cs_config\\" -Copyright (C) 2003 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." -srcdir=$srcdir + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -# If no file are specified by the user, then we need to provide default -# value. By we need to know if files were specified by the user. +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in - --*=*) - ac_option=`expr "x$1" : 'x\([^=]*\)='` - ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; - -*) + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; - *) # This is not an option, so the user has probably given explicit - # arguments. - ac_option=$1 - ac_need_defaults=false;; esac case $ac_option in # Handling of the options. -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; - --version | --vers* | -V ) - echo "$ac_cs_version"; exit 0 ;; - --he | --h) - # Conflict between --help and --header - { { echo "$as_me:$LINENO: error: ambiguous option: $1 -Try \`$0 --help' for more information." >&5 -echo "$as_me: error: ambiguous option: $1 -Try \`$0 --help' for more information." >&2;} - { (exit 1); exit 1; }; };; - --help | --hel | -h ) - echo "$ac_cs_usage"; exit 0 ;; - --debug | --d* | -d ) + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift - CONFIG_FILES="$CONFIG_FILES $ac_optarg" - ac_need_defaults=false;; - --header | --heade | --head | --hea ) - $ac_shift - CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. - -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 -Try \`$0 --help' for more information." >&5 -echo "$as_me: error: unrecognized option: $1 -Try \`$0 --help' for more information." >&2;} - { (exit 1); exit 1; }; } ;; + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; - *) ac_config_targets="$ac_config_targets $1" ;; + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; esac shift @@ -5809,33 +5953,47 @@ if $ac_cs_silent; then fi _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then - echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 - exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" fi _ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - - -cat >>$CONFIG_STATUS <<\_ACEOF +# Handling of arguments. for ac_config_target in $ac_config_targets do - case "$ac_config_target" in - # Handling of arguments. - "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; - "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; - "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; - "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; - *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 -echo "$as_me: error: invalid argument: $ac_config_target" >&2;} - { (exit 1); exit 1; }; };; + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; + "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; + "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;; esac done + # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely @@ -5845,420 +6003,414 @@ if $ac_need_defaults; then fi # Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason to put it here, and in addition, +# simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. -# Create a temporary directory, and hook for its removal unless debugging. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. $debug || { - trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 - trap '{ (exit 1); exit 1; }' 1 2 13 15 + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 } - # Create a (secure) tmp directory for tmp files. { - tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" } || { - tmp=./confstat$$-$RANDOM - (umask 077 && mkdir $tmp) -} || + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} { - echo "$me: cannot create a temporary directory in ." >&2 - { (exit 1); exit 1; } + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi -# -# CONFIG_FILES section. -# +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" -# No need to generate the scripts if there are no CONFIG_FILES. -# This happens for instance when ./config.status config.h -if test -n "\$CONFIG_FILES"; then - # Protect against being on the right side of a sed subst in config.status. - sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; - s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF -s,@SHELL@,$SHELL,;t t -s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t -s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t -s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t -s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t -s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t -s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t -s,@exec_prefix@,$exec_prefix,;t t -s,@prefix@,$prefix,;t t -s,@program_transform_name@,$program_transform_name,;t t -s,@bindir@,$bindir,;t t -s,@sbindir@,$sbindir,;t t -s,@libexecdir@,$libexecdir,;t t -s,@datadir@,$datadir,;t t -s,@sysconfdir@,$sysconfdir,;t t -s,@sharedstatedir@,$sharedstatedir,;t t -s,@localstatedir@,$localstatedir,;t t -s,@libdir@,$libdir,;t t -s,@includedir@,$includedir,;t t -s,@oldincludedir@,$oldincludedir,;t t -s,@infodir@,$infodir,;t t -s,@mandir@,$mandir,;t t -s,@build_alias@,$build_alias,;t t -s,@host_alias@,$host_alias,;t t -s,@target_alias@,$target_alias,;t t -s,@DEFS@,$DEFS,;t t -s,@ECHO_C@,$ECHO_C,;t t -s,@ECHO_N@,$ECHO_N,;t t -s,@ECHO_T@,$ECHO_T,;t t -s,@LIBS@,$LIBS,;t t -s,@CC@,$CC,;t t -s,@CFLAGS@,$CFLAGS,;t t -s,@LDFLAGS@,$LDFLAGS,;t t -s,@CPPFLAGS@,$CPPFLAGS,;t t -s,@ac_ct_CC@,$ac_ct_CC,;t t -s,@EXEEXT@,$EXEEXT,;t t -s,@OBJEXT@,$OBJEXT,;t t -s,@CPP@,$CPP,;t t -s,@EGREP@,$EGREP,;t t -s,@AR@,$AR,;t t -s,@ac_ct_AR@,$ac_ct_AR,;t t -s,@RANLIB@,$RANLIB,;t t -s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t -s,@RC@,$RC,;t t -s,@ac_ct_RC@,$ac_ct_RC,;t t -s,@SET_MAKE@,$SET_MAKE,;t t -s,@TCL_THREADS@,$TCL_THREADS,;t t -s,@CYGPATH@,$CYGPATH,;t t -s,@CELIB_DIR@,$CELIB_DIR,;t t -s,@DL_LIBS@,$DL_LIBS,;t t -s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t -s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t -s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t -s,@ZLIB_DLL_FILE@,$ZLIB_DLL_FILE,;t t -s,@ZLIB_LIBS@,$ZLIB_LIBS,;t t -s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t -s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t -s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t -s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t -s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t -s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t -s,@MACHINE@,$MACHINE,;t t -s,@TCL_VERSION@,$TCL_VERSION,;t t -s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t -s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t -s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t -s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t -s,@TCL_EXE@,$TCL_EXE,;t t -s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t -s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t -s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t -s,@TCL_STATIC_LIB_FLAG@,$TCL_STATIC_LIB_FLAG,;t t -s,@TCL_IMPORT_LIB_FILE@,$TCL_IMPORT_LIB_FILE,;t t -s,@TCL_IMPORT_LIB_FLAG@,$TCL_IMPORT_LIB_FLAG,;t t -s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t -s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t -s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t -s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t -s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t -s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t -s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t -s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t -s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t -s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t -s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t -s,@TCL_DBGX@,$TCL_DBGX,;t t -s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t -s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t -s,@CFG_TCL_EXPORT_FILE_SUFFIX@,$CFG_TCL_EXPORT_FILE_SUFFIX,;t t -s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t -s,@DEPARG@,$DEPARG,;t t -s,@CC_OBJNAME@,$CC_OBJNAME,;t t -s,@CC_EXENAME@,$CC_EXENAME,;t t -s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t -s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t -s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t -s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t -s,@STLIB_LD@,$STLIB_LD,;t t -s,@SHLIB_LD@,$SHLIB_LD,;t t -s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t -s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t -s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t -s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t -s,@LIBS_GUI@,$LIBS_GUI,;t t -s,@DLLSUFFIX@,$DLLSUFFIX,;t t -s,@LIBPREFIX@,$LIBPREFIX,;t t -s,@LIBSUFFIX@,$LIBSUFFIX,;t t -s,@EXESUFFIX@,$EXESUFFIX,;t t -s,@LIBRARIES@,$LIBRARIES,;t t -s,@MAKE_LIB@,$MAKE_LIB,;t t -s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t -s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t -s,@MAKE_DLL@,$MAKE_DLL,;t t -s,@MAKE_EXE@,$MAKE_EXE,;t t -s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t -s,@TCL_LD_SEARCH_FLAGS@,$TCL_LD_SEARCH_FLAGS,;t t -s,@TCL_NEEDS_EXP_FILE@,$TCL_NEEDS_EXP_FILE,;t t -s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t -s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t -s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t -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_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,@RC_OUT@,$RC_OUT,;t t -s,@RC_TYPE@,$RC_TYPE,;t t -s,@RC_INCLUDE@,$RC_INCLUDE,;t t -s,@RC_DEFINE@,$RC_DEFINE,;t t -s,@RC_DEFINES@,$RC_DEFINES,;t t -s,@RES@,$RES,;t t -s,@LIBOBJS@,$LIBOBJS,;t t -s,@LTLIBOBJS@,$LTLIBOBJS,;t t -CEOF -_ACEOF +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift - cat >>$CONFIG_STATUS <<\_ACEOF - # Split the substitutions into bite-sized pieces for seds with - # small command number limits, like on Digital OSF/1 and HP-UX. - ac_max_sed_lines=48 - ac_sed_frag=1 # Number of current file. - ac_beg=1 # First line for current file. - ac_end=$ac_max_sed_lines # Line after last line for current file. - ac_more_lines=: - ac_sed_cmds= - while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag - else - sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag - fi - if test ! -s $tmp/subs.frag; then - ac_more_lines=false - else - # The purpose of the label and of the branching condition is to - # speed up the sed processing (if there are no `@' at all, there - # is no need to browse any of the substitutions). - # These are the two extra sed commands mentioned above. - (echo ':t - /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" - else - ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" - fi - ac_sed_frag=`expr $ac_sed_frag + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_lines` + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} fi - done - if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat - fi -fi # test -n "$CONFIG_FILES" + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case $ac_file in - - | *:- | *:-:* ) # input from stdin - cat >$tmp/stdin - ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; - *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; - * ) ac_file_in=$ac_file.in ;; + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; esac - # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. - ac_dir=`(dirname "$ac_file") 2>/dev/null || + ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - { if $as_mkdir_p; then - mkdir -p "$ac_dir" - else - as_dir="$ac_dir" - as_dirs= - while test ! -d "$as_dir"; do - as_dirs="$as_dir $as_dirs" - as_dir=`(dirname "$as_dir") 2>/dev/null || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - done - test ! -n "$as_dirs" || mkdir $as_dirs - fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 -echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} - { (exit 1); exit 1; }; }; } - + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix case $srcdir in - .) # No --srcdir option. We are building in place. + .) # We are building in place. ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; -esac + case $ac_mode in + :F) + # + # CONFIG_FILE + # +_ACEOF - if test x"$ac_file" != x-; then - { echo "$as_me:$LINENO: creating $ac_file" >&5 -echo "$as_me: creating $ac_file" >&6;} - rm -f "$ac_file" - fi - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - if test x"$ac_file" = x-; then - configure_input= - else - configure_input="$ac_file. " - fi - configure_input=$configure_input"Generated from `echo $ac_file_in | - sed 's,.*/,,'` by configure." - - # First look for the input files in the build tree, otherwise in the - # src tree. - ac_file_inputs=`IFS=: - for f in $ac_file_in; do - case $f in - -) echo $tmp/stdin ;; - [\\/$]*) - # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 -echo "$as_me: error: cannot find input file: $f" >&2;} - { (exit 1); exit 1; }; } - echo "$f";; - *) # Relative - if test -f "$f"; then - # Build tree - echo "$f" - elif test -f "$srcdir/$f"; then - # Source tree - echo "$srcdir/$f" - else - # /dev/null tree - { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 -echo "$as_me: error: cannot find input file: $f" >&2;} - { (exit 1); exit 1; }; } - fi;; - esac - done` || { (exit 1); exit 1; } +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF - sed "$ac_vpsub + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub $extrasub _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s,@configure_input@,$configure_input,;t t -s,@srcdir@,$ac_srcdir,;t t -s,@abs_srcdir@,$ac_abs_srcdir,;t t -s,@top_srcdir@,$ac_top_srcdir,;t t -s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t -s,@builddir@,$ac_builddir,;t t -s,@abs_builddir@,$ac_abs_builddir,;t t -s,@top_builddir@,$ac_top_builddir,;t t -s,@abs_top_builddir@,$ac_abs_top_builddir,;t t -" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out - rm -f $tmp/stdin - if test x"$ac_file" != x-; then - mv $tmp/out $ac_file - else - cat $tmp/out - rm -f $tmp/out - fi +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; -done -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -{ (exit 0); exit 0; } + esac + +done # for ac_tag + + +as_fn_exit 0 _ACEOF -chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. @@ -6278,7 +6430,11 @@ if test "$no_create" != yes; then exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. - $ac_cs_success || { (exit 1); exit 1; } + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi diff --git a/win/configure.in b/win/configure.in index aa47505..01366f5 100644 --- a/win/configure.in +++ b/win/configure.in @@ -126,20 +126,16 @@ AS_IF([test "${enable_shared+set}" = "set"], [ ], [ tcl_ok=yes ]) -AS_IF([test "$tcl_ok" = "yes"], [ - AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) - AS_IF([test "$do64bit" = "yes"], [ - AS_IF([test "$GCC" == "yes"],[ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/libz.dll.a]) - ], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib]) - ]) - ], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib]) - ]) -], [ - AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) -]) +AC_ARG_WITH(zlib, [ --with-zlib use Native Zlib library], + with_zlib=$withval, with_zlib=NO_ZLIB +) +AS_IF( + [test "with_zlib" = "NO_ZLIB"], [AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])], + [test "$tcl_ok" != "yes"], [AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])], + [test "$do64bit" = "yes"], [AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])], + [test "$with_zlib" = "yes"] , [AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib])], + [AC_SUBST(ZLIB_LIBS,[$with_zlib])] +) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) AC_CHECK_TYPE([intptr_t], [ -- cgit v0.12 From cd9922f497673e31b6fffa759cff4c869927b7fb Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 2 Sep 2014 18:30:23 +0000 Subject: Pared down tclZipVfs to eliminate #ifdef branches that we don't have to worry about with a modern Tcl. Replaced dummy calls to VFS with NULL Where practical, replaced string-based Tcl IO calls with their new obj-based successors. (Tcl_FSOpenChannel, Tcl_FSStat, etc) Eliminated compiler warnings under Windows --- generic/tclZipVfs.c | 360 +++++++++++++--------------------------------------- 1 file changed, 86 insertions(+), 274 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index 8b1fc3b..9b377c0 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -29,10 +29,6 @@ #include #include -#ifdef TCL_FILESYSTEM_VERSION_1 -#define USE_TCL_VFS 1 -#endif - /* * Size of the decompression input buffer */ @@ -285,9 +281,7 @@ CanonicalPath( for (i=j=0 ; (c = zPath[i]) != 0 ; i++) { #ifdef __WIN32__ if (isupper(c)) { - if (maptolower) { - c = tolower(c); - } + c = tolower(c); } else if (c == '\\') { c = '/'; } @@ -411,7 +405,7 @@ ZvfsReadTOCStart( while (1) { int lenName; /* Length of the next filename */ - int lenExtra; /* Length of "extra" data for next file */ + int lenExtra=0; /* Length of "extra" data for next file */ int iData; /* Offset to start of file data */ if (nFile-- <= 0) { @@ -612,7 +606,7 @@ Tcl_Zvfs_Mount( while (1) { int lenName; /* Length of the next filename */ - int lenExtra; /* Length of "extra" data for next file */ + int lenExtra=0; /* Length of "extra" data for next file */ int iData; /* Offset to start of file data */ int dosTime; int dosDate; @@ -740,35 +734,6 @@ ZvfsLookup( return pFile; } -static int -ZvfsLookupMount( - char *zFilename) -{ - char *zTrueName; - Tcl_HashEntry *pEntry; /* Hash table entry */ - Tcl_HashSearch zSearch; /* Search all mount points */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - int match=0; - - if (local.isInit == 0) { - return 0; - } - zTrueName = AbsolutePath(zFilename); - pEntry = Tcl_FirstHashEntry(&local.archiveHash, &zSearch); - while (pEntry) { - pArchive = Tcl_GetHashValue(pEntry); - if (pArchive) { - if (!strcmp(pArchive->zMountPoint, zTrueName)) { - match = 1; - break; - } - } - pEntry = Tcl_NextHashEntry(&zSearch); - } - Tcl_Free(zTrueName); - return match; -} - /* * Unmount all the files in the given ZIP archive. */ @@ -813,13 +778,6 @@ Tcl_Zvfs_Umount( return 1; } -static void -Zvfs_Unmount( - const char *zArchive) -{ - Tcl_Zvfs_Umount(zArchive); -} - /* * zvfs::mount Zip-archive-name mount-point * @@ -832,19 +790,19 @@ Zvfs_Unmount( * string, mount on file path. */ static int -ZvfsMountCmd( +ZvfsMountObjCmd( ClientData clientData, /* Client data for this command */ Tcl_Interp *interp, /* The interpreter used to report errors */ - int argc, /* Number of arguments */ - const char *argv[]) /* Values of all arguments */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv) /* Values of all arguments */ { /*TODO: Convert to Tcl_Obj API!*/ - if (argc > 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + if (objc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", Tcl_GetString(objv[0]), " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0); return TCL_ERROR; } - return Tcl_Zvfs_Mount(interp, argc>1?argv[1]:NULL, argc>2?argv[2]:NULL); + return Tcl_Zvfs_Mount(interp, objc>1?Tcl_GetString(objv[1]):NULL, objc>2?Tcl_GetString(objv[2]):NULL); } /* @@ -853,33 +811,33 @@ ZvfsMountCmd( * Undo the effects of zvfs::mount. */ static int -ZvfsUnmountCmd( +ZvfsUnmountObjCmd( ClientData clientData, /* Client data for this command */ Tcl_Interp *interp, /* The interpreter used to report errors */ - int argc, /* Number of arguments */ - const char *argv[]) /* Values of all arguments */ + int objc, /* Number of arguments */ + Tcl_Obj *const* objv) /* Values of all arguments */ { ZvfsArchive *pArchive; /* The ZIP archive being mounted */ Tcl_HashEntry *pEntry; /* Hash table entry */ Tcl_HashSearch zSearch; /* Search all mount points */ - - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + char *zFilename; + if (objc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", Tcl_GetString(objv[0]), " ZIP-FILE\"", 0); return TCL_ERROR; } - if (Tcl_Zvfs_Umount(argv[1])) { - return TCL_OK; - } - if (!local.isInit) { return TCL_ERROR; } + zFilename=Tcl_GetString(objv[1]); + if (Tcl_Zvfs_Umount(zFilename)) { + return TCL_OK; + } pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch); while (pEntry) { pArchive = Tcl_GetHashValue(pEntry); if (pArchive && pArchive->zMountPoint[0] - && (strcmp(pArchive->zMountPoint, argv[1]) == 0)) { + && (strcmp(pArchive->zMountPoint, zFilename) == 0)) { if (Tcl_Zvfs_Umount(pArchive->zName)) { return TCL_OK; } @@ -888,7 +846,7 @@ ZvfsUnmountCmd( pEntry = Tcl_NextHashEntry(&zSearch); } - Tcl_AppendResult(interp, "unknown zvfs mount point or file: ", argv[1], + Tcl_AppendResult(interp, "unknown zvfs mount point or file: ", zFilename, NULL); return TCL_ERROR; } @@ -1348,7 +1306,7 @@ ZvfsFileOpen( pInfo->readSoFar = 0; Tcl_Seek(chan, INT16(zBuf, 26) + INT16(zBuf, 28), SEEK_CUR); pInfo->startOfData = Tcl_Tell(chan); - sprintf(zName, "vfs_%lx_%x", ((ptrdiff_t)pFile)>>12, count++); + sprintf(zName, "zvfs_%x",count++); chan = Tcl_CreateChannel(&vfsChannelType, zName, pInfo, TCL_READABLE); return chan; } @@ -1357,10 +1315,11 @@ ZvfsFileOpen( * This routine does a stat() system call for a ZVFS file. */ static int -ZvfsFileStat( - char *path, - struct stat *buf) +Tobe_FSStatProc( + Tcl_Obj *pathObj, + Tcl_StatBuf *buf) { + char *path=Tcl_GetString(pathObj); ZvfsFile *pFile; pFile = ZvfsLookup(path); @@ -1385,10 +1344,11 @@ ZvfsFileStat( * This routine does an access() system call for a ZVFS file. */ static int -ZvfsFileAccess( - char *path, +Tobe_FSAccessProc( + Tcl_Obj *pathPtr, int mode) { + char *path=Tcl_GetString(pathPtr); ZvfsFile *pFile; if (mode & 3) { @@ -1401,41 +1361,6 @@ ZvfsFileAccess( return 0; } -#ifndef USE_TCL_VFS - -/* - * This TCL procedure can be used to copy a file. The built-in "file copy" - * command of TCL bypasses the I/O system and does not work with zvfs. You - * have to use a procedure like the following instead. - */ -static char zFileCopy[] = -"proc zvfs::filecopy {from to {outtype binary}} {\n" -" set f [open $from r]\n" -" if {[catch {\n" -" fconfigure $f -translation binary\n" -" set t [open $to w]\n" -" } msg]} {\n" -" close $f\n" -" error $msg\n" -" }\n" -" if {[catch {\n" -" fconfigure $t -translation $outtype\n" -" set size [file size $from]\n" -" for {set i 0} {$i<$size} {incr i 40960} {\n" -" puts -nonewline $t [read $f 40960]\n" -" }\n" -" } msg]} {\n" -" close $f\n" -" close $t\n" -" error $msg\n" -" }\n" -" close $f\n" -" close $t\n" -"}\n" -; - -#else - Tcl_Channel Tobe_FSOpenFileChannelProc( Tcl_Interp *interp, @@ -1457,31 +1382,9 @@ Tobe_FSOpenFileChannelProc( return chan; } -/* - * This routine does a stat() system call for a ZVFS file. - */ -int -Tobe_FSStatProc( - Tcl_Obj *pathPtr, - struct stat *buf) -{ - return ZvfsFileStat(Tcl_GetString(pathPtr), buf); -} - -/* - * This routine does an access() system call for a ZVFS file. - */ -int -Tobe_FSAccessProc( - Tcl_Obj *pathPtr, - int mode) -{ - return ZvfsFileAccess(Tcl_GetString(pathPtr), mode); -} - -/* Tcl_Obj* Tobe_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) { +Tcl_Obj* Tobe_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) { return Tcl_NewStringObj("/",-1);; -} */ +} /* * Function to process a 'Tobe_FSMatchInDirectory()'. If not implemented, @@ -1567,10 +1470,7 @@ Tobe_FSPathInFilesystemProc( { ZvfsFile *zFile; char *path = Tcl_GetString(pathPtr); - -// if (ZvfsLookupMount(path)!=0) -// return TCL_OK; -// // TODO: also check this is the archive. + if (openarch) { return -1; } @@ -1605,14 +1505,6 @@ Tobe_FSListVolumesProc(void) return pVols; } -int -Tobe_FSChdirProc( - Tcl_Obj *pathPtr) -{ - /* Someday, we should actually check if this is a valid path. */ - return TCL_OK; -} - const char * const* Tobe_FSFileAttrStringsProc( Tcl_Obj *pathPtr, @@ -1642,7 +1534,9 @@ Tobe_FSFileAttrsGetProc( Tcl_Obj **objPtrRef) { char *path = Tcl_GetString(pathPtr); +#ifndef __WIN32__ char buf[50]; +#endif ZvfsFile *zFile = ZvfsLookup(path); if (zFile == 0) { @@ -1677,79 +1571,15 @@ Tobe_FSFileAttrsGetProc( /****************************************************/ -// At some point, some of the following might get implemented? - -#if 1 -#define Tobe_FSFilesystemSeparatorProc 0 -#define Tobe_FSLoadFileProc 0 -#define Tobe_FSUnloadFileProc 0 -#define Tobe_FSGetCwdProc 0 -#define Tobe_FSGetCwdProc 0 -#define Tobe_FSCreateDirectoryProc 0 -#define Tobe_FSDeleteFileProc 0 -#define Tobe_FSCopyDirectoryProc 0 -#define Tobe_FSCopyFileProc 0 -#define Tobe_FSRemoveDirectoryProc 0 -#define Tobe_FSFileAttrsSetProc 0 -#define Tobe_FSNormalizePathProc 0 -#define Tobe_FSUtimeProc 0 -#define Tobe_FSRenameFileProc 0 -#define Tobe_FSCreateInternalRepProc 0 -#define Tobe_FSInternalToNormalizedProc 0 -#define Tobe_FSDupInternalRepProc 0 -#define Tobe_FSFreeInternalRepProc 0 -#define Tobe_FSFilesystemPathTypeProc 0 -#define Tobe_FSLinkProc 0 -#else - -/* - * Function to process a 'Tobe_FSLoadFile()' call. If not implemented, Tcl - * will fall back on a copy to native-temp followed by a Tobe_FSLoadFile on - * that temporary copy. - */ -int -Tobe_FSLoadFileProc( - Tcl_Interp * interp, - Tcl_Obj *pathPtr, - char * sym1, - char * sym2, - Tcl_PackageInitProc ** proc1Ptr, - Tcl_PackageInitProc ** proc2Ptr, - ClientData * clientDataPtr) -{ - return 0; -} - /* * Function to unload a previously successfully loaded file. If load was * implemented, then this should also be implemented, if there is any cleanup * action required. */ -void Tobe_FSUnloadFileProc(ClientData clientData) { return; } -Tcl_Obj* Tobe_FSGetCwdProc(Tcl_Interp *interp) { return 0; } -int Tobe_FSCreateDirectoryProc(Tcl_Obj *pathPtr) { return 0; } -int Tobe_FSDeleteFileProc(Tcl_Obj *pathPtr) { return 0; } -int Tobe_FSCopyDirectoryProc(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, - Tcl_Obj **errorPtr) { return 0; } -int Tobe_FSCopyFileProc(Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr) { return 0; } -int Tobe_FSRemoveDirectoryProc(Tcl_Obj *pathPtr, int recursive, - Tcl_Obj **errorPtr) { return 0; } -int Tobe_FSRenameFileProc(Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr) { return 0; } /* We have to declare the utime structure here. */ int Tobe_FSUtimeProc(Tcl_Obj *pathPtr, struct utimbuf *tval) { return 0; } -int Tobe_FSNormalizePathProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, - int nextCheckpoint) { return 0; } int Tobe_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) { return 0; } -Tcl_Obj* Tobe_FSLinkProc(Tcl_Obj *pathPtr) { return 0; } -Tcl_Obj* Tobe_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) { return 0; } -void Tobe_FSFreeInternalRepProc(ClientData clientData) { return; } -ClientData Tobe_FSDupInternalRepProc(ClientData clientData) { return 0; } -Tcl_Obj* Tobe_FSInternalToNormalizedProc(ClientData clientData) { return 0; } -ClientData Tobe_FSCreateInternalRepProc(Tcl_Obj *pathPtr) { return 0; } -#endif static Tcl_Filesystem Tobe_Filesystem = { "tobe", /* The name of the filesystem. */ @@ -1759,17 +1589,17 @@ static Tcl_Filesystem Tobe_Filesystem = { Tobe_FSPathInFilesystemProc,/* Function to check whether a path is in this * filesystem. This is the most important * filesystem procedure. */ - Tobe_FSDupInternalRepProc, /* Function to duplicate internal fs rep. May + NULL, /* Function to duplicate internal fs rep. May * be NULL (but then fs is less efficient). */ - Tobe_FSFreeInternalRepProc, /* Function to free internal fs rep. Must be + NULL, /* Function to free internal fs rep. Must be * implemented, if internal representations * need freeing, otherwise it can be NULL. */ - Tobe_FSInternalToNormalizedProc, + NULL, /* Function to convert internal representation * to a normalized path. Only required if the * fs creates pure path objects with no * string/path representation. */ - Tobe_FSCreateInternalRepProc, + NULL, /* Function to create a filesystem-specific * internal representation. May be NULL if * paths have no internal representation, or @@ -1777,11 +1607,11 @@ static Tcl_Filesystem Tobe_Filesystem = { * filesystem always immediately creates an * internal representation for paths it * accepts. */ - Tobe_FSNormalizePathProc, /* Function to normalize a path. Should be + NULL, /* Function to normalize a path. Should be * implemented for all filesystems which can * have multiple string representations for * the same path object. */ - Tobe_FSFilesystemPathTypeProc, + NULL, /* Function to determine the type of a path in * this filesystem. May be NULL. */ Tobe_FSFilesystemSeparatorProc, @@ -1808,7 +1638,7 @@ static Tcl_Filesystem Tobe_Filesystem = { * reading) of times with 'file mtime', 'file * atime' and the open-r/open-w/fcopy * implementation of 'file copy'. */ - Tobe_FSLinkProc, /* Function to process a 'Tobe_FSLink()' call. + NULL, /* Function to process a 'Tobe_FSLink()' call. * Should be implemented only if the * filesystem supports links. */ Tobe_FSListVolumesProc, /* Function to list any filesystem volumes @@ -1828,42 +1658,42 @@ static Tcl_Filesystem Tobe_Filesystem = { Tobe_FSFileAttrsSetProc, /* Function to process a * 'Tobe_FSFileAttrsSet()' call, used by 'file * attributes'. */ - Tobe_FSCreateDirectoryProc, /* Function to process a + NULL, /* Function to process a * 'Tobe_FSCreateDirectory()' call. Should be * implemented unless the FS is read-only. */ - Tobe_FSRemoveDirectoryProc, /* Function to process a + NULL, /* Function to process a * 'Tobe_FSRemoveDirectory()' call. Should be * implemented unless the FS is read-only. */ - Tobe_FSDeleteFileProc, /* Function to process a 'Tobe_FSDeleteFile()' + NULL, /* Function to process a 'Tobe_FSDeleteFile()' * call. Should be implemented unless the FS * is read-only. */ - Tobe_FSCopyFileProc, /* Function to process a 'Tobe_FSCopyFile()' + NULL, /* Function to process a 'Tobe_FSCopyFile()' * call. If not implemented Tcl will fall * back on open-r, open-w and fcopy as a * copying mechanism. */ - Tobe_FSRenameFileProc, /* Function to process a 'Tobe_FSRenameFile()' + NULL, /* Function to process a 'Tobe_FSRenameFile()' * call. If not implemented, Tcl will fall * back on a copy and delete mechanism. */ - Tobe_FSCopyDirectoryProc, /* Function to process a + NULL, /* Function to process a * 'Tobe_FSCopyDirectory()' call. If not * implemented, Tcl will fall back on a * recursive create-dir, file copy * mechanism. */ - Tobe_FSLoadFileProc, /* Function to process a 'Tobe_FSLoadFile()' + NULL, /* Function to process a 'Tobe_FSLoadFile()' * call. If not implemented, Tcl will fall * back on a copy to native-temp followed by a * Tobe_FSLoadFile on that temporary copy. */ - Tobe_FSUnloadFileProc, /* Function to unload a previously + NULL, /* Function to unload a previously * successfully loaded file. If load was * implemented, then this should also be * implemented, if there is any cleanup action * required. */ - Tobe_FSGetCwdProc, /* Function to process a 'Tobe_FSGetCwd()' + NULL, /* Function to process a 'Tobe_FSGetCwd()' * call. Most filesystems need not implement * this. It will usually only be called once, * if 'getcwd' is called before 'chdir'. May * be NULL. */ - Tobe_FSChdirProc, /* Function to process a 'Tobe_FSChdir()' + NULL, /* Function to process a 'Tobe_FSChdir()' * call. If filesystems do not implement this, * it will be emulated by a series of * directory access checks. Otherwise, virtual @@ -1880,8 +1710,6 @@ static Tcl_Filesystem Tobe_Filesystem = { * filesystem. */ }; -#endif - ////////////////////////////////////////////////////////////// void (*Zvfs_PostInit)(Tcl_Interp *) = 0; @@ -1898,7 +1726,6 @@ Zvfs_doInit( Tcl_Interp *interp, int safe) { - int n; #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.0", 0) == 0) { return TCL_ERROR; @@ -1906,8 +1733,8 @@ Zvfs_doInit( #endif Tcl_StaticPackage(interp, "zvfs", Tcl_Zvfs_Init, Tcl_Zvfs_SafeInit); if (!safe) { - Tcl_CreateCommand(interp, "zvfs::mount", ZvfsMountCmd, 0, 0); - Tcl_CreateCommand(interp, "zvfs::unmount", ZvfsUnmountCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::mount", ZvfsMountObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::unmount", ZvfsUnmountObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "zvfs::append", ZvfsAppendObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "zvfs::add", ZvfsAddObjCmd, 0, 0); } @@ -1919,22 +1746,12 @@ Zvfs_doInit( Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); /* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ -#ifndef USE_TCL_VFS - Tcl_GlobalEval(interp, zFileCopy); -#endif + if (!local.isInit) { /* One-time initialization of the ZVFS */ -#ifdef USE_TCL_VFS - n = Tcl_FSRegister(0, &Tobe_Filesystem); -#else - extern void TclAccessInsertProc(); - extern void TclStatInsertProc(); - extern void TclOpenFileChannelInsertProc(); - - TclAccessInsertProc(ZvfsFileAccess); - TclStatInsertProc(ZvfsFileStat); - TclOpenFileChannelInsertProc(ZvfsFileOpen); -#endif + if(Tcl_FSRegister(NULL, &Tobe_Filesystem)) { + return TCL_ERROR; + } Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); local.isInit = 1; @@ -1979,7 +1796,7 @@ ZvfsDumpObjCmd( int objc, /* Number of arguments */ Tcl_Obj *const* objv) /* Values of all arguments */ { - char *zFilename; + Tcl_Obj *zFilenameObj; Tcl_Channel chan; ZFile *pList; int rc; @@ -1989,8 +1806,8 @@ ZvfsDumpObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); return TCL_ERROR; } - zFilename = Tcl_GetString(objv[1]); - chan = Tcl_OpenFileChannel(interp, zFilename, "r", 0); + zFilenameObj=objv[1]; + chan = Tcl_FSOpenFileChannel(interp, zFilenameObj, "r", 0); if (chan == 0) { return TCL_ERROR; } @@ -2021,7 +1838,7 @@ ZvfsDumpObjCmd( Tcl_ListObjAppendElement(interp, pResult, pEntry); pNext = pList->pNext; Tcl_Free((void *) pList); - pList = pList->pNext; + pList = pNext; } return TCL_OK; } @@ -2037,10 +1854,12 @@ writeFile( Tcl_Interp *interp, /* Leave an error message here */ Tcl_Channel out, /* Write the file here */ Tcl_Channel in, /* Read data from this file */ - char *zSrc, /* Name the new ZIP file entry this */ - char *zDest, /* Name the new ZIP file entry this */ + Tcl_Obj *zSrcPtr, /* Name the new ZIP file entry this */ + Tcl_Obj *zDestPtr, /* Name the new ZIP file entry this */ ZFile **ppList) /* Put a ZFile struct for the new file here */ { + char *zDest=Tcl_GetString(zDestPtr); + z_stream stream; ZFile *p; int iEndOfData; @@ -2052,7 +1871,7 @@ writeFile( char zOutBuf[100000]; struct tm *tm; time_t now; - struct stat stat; + Tcl_StatBuf stat; /* * Create a new ZFile structure for this file. @@ -2062,7 +1881,7 @@ writeFile( p = newZFile(nameLen, ppList); strcpy(p->zName, zDest); p->isSpecial = 0; - Tcl_Stat(zSrc, &stat); + Tcl_FSStat(zSrcPtr, &stat); now = stat.st_mtime; tm = localtime(&now); UnixTimeDate(tm, &p->dosDate, &p->dosTime); @@ -2112,16 +1931,8 @@ writeFile( stream.next_in = (unsigned char *) zInBuf; stream.avail_out = sizeof(zOutBuf); stream.next_out = (unsigned char *) zOutBuf; -#if 1 deflateInit(&stream, 9); -#else - { - int i, err, WSIZE = 0x8000, windowBits, level=6; - for (i = ((unsigned)WSIZE), windowBits = 0; i != 1; i >>= 1, ++windowBits); - err = deflateInit2(&stream, level, Z_DEFLATED, -windowBits, 8, 0); - } -#endif p->iCRC = crc32(0, 0, 0); while (!Tcl_Eof(in)) { @@ -2341,7 +2152,7 @@ ZvfsAppendObjCmd( int objc, /* Number of arguments */ Tcl_Obj *const* objv) /* Values of all arguments */ { - char *zArchive; + Tcl_Obj *zArchiveObj; Tcl_Channel chan; ZFile *pList = NULL, *pToc; int rc = TCL_OK, i; @@ -2355,10 +2166,10 @@ ZvfsAppendObjCmd( return TCL_ERROR; } - zArchive = Tcl_GetString(objv[1]); - chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644); + zArchiveObj=objv[1]; + chan = Tcl_FSOpenFileChannel(interp, zArchiveObj, "r+", 0644); if (chan == 0) { - chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644); + chan = Tcl_FSOpenFileChannel(interp, zArchiveObj, "w+", 0644); if (chan == 0) { return TCL_ERROR; } @@ -2401,15 +2212,15 @@ ZvfsAppendObjCmd( */ for (i=2; rc==TCL_OK && i Date: Tue, 2 Sep 2014 20:16:54 +0000 Subject: Added a hac^H^H^Hpatch from ferrieux to mask around the exit hang on windows until the issues are fixed at the core level. --- generic/tclEvent.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 941d566..3bb6c62 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1299,18 +1299,19 @@ Tcl_FinalizeThread(void) TclFinalizeAsync(); TclFinalizeThreadObjects(); } - - /* - * Blow away all thread local storage blocks. - * - * Note that Tcl API allows creation of threads which do not use any Tcl - * interp or other Tcl subsytems. Those threads might, however, use thread - * local storage, so we must unconditionally finalize it. - * - * Fix [Bug #571002] - */ - - TclFinalizeThreadData(); + if (!TclInExit()) { + /* + * Blow away all thread local storage blocks. + * + * Note that Tcl API allows creation of threads which do not use any Tcl + * interp or other Tcl subsytems. Those threads might, however, use thread + * local storage, so we must unconditionally finalize it. + * + * Fix [Bug #571002] + */ + + TclFinalizeThreadData(); + } } /* -- cgit v0.12 From 8ca1a78b1a5befabf5e8d8e27bd5d80fb6ab9582 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 2 Sep 2014 20:26:50 +0000 Subject: Revised patch (per ferrieux) --- generic/tclEvent.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 3bb6c62..a7cd467 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1299,7 +1299,7 @@ Tcl_FinalizeThread(void) TclFinalizeAsync(); TclFinalizeThreadObjects(); } - if (!TclInExit()) { + if (TclFullFinalizationRequested()) { /* * Blow away all thread local storage blocks. * -- cgit v0.12 From 06547a29be3e6ccdecc327ce843d939bea668600 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 2 Sep 2014 21:16:20 +0000 Subject: Fix for the cases where a dynamic build is used --- win/configure | 41 ++++++++++++++++++++++++++++++++--------- win/configure.in | 24 +++++++++++++++++++----- 2 files changed, 51 insertions(+), 14 deletions(-) diff --git a/win/configure b/win/configure index d8ee198..4414f2d 100755 --- a/win/configure +++ b/win/configure @@ -678,8 +678,9 @@ VC_MANIFEST_EMBED_EXE VC_MANIFEST_EMBED_DLL LDFLAGS_DEFAULT CFLAGS_DEFAULT -ZLIB_LIBS ZLIB_OBJS +ZLIB_LIBS +ZLIB_DLL_FILE CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG @@ -4669,20 +4670,42 @@ else fi -if test "with_zlib" = "NO_ZLIB"; then : - ZLIB_OBJS=\${ZLIB_OBJS} +if test "$tcl_ok" = "yes"; then : -elif test "$tcl_ok" != "yes"; then : - ZLIB_OBJS=\${ZLIB_OBJS} + ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} -elif test "$do64bit" = "yes"; then : - ZLIB_OBJS=\${ZLIB_OBJS} +fi +tcl_no_zlib_dll=no +if test "$with_zlib" = "NO_ZLIB"; then : + tcl_no_zlib_dll=yes +elif test "$tcl_ok" != "yes"; then : + tcl_no_zlib_dll=yes +elif test "$do64bit" = "yes"; then : + tcl_no_zlib_dll=yes elif test "$with_zlib" = "yes" ; then : - ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib + + ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} + + ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib + else - ZLIB_LIBS=$with_zlib + + ZLIB_DLL_FILE=${with_zlib} + + ZLIB_LIBS=$with_zlib + + + +fi +if test "$tcl_no_zlib_dll" = "yes"; then : + + ZLIB_OBJS=\${ZLIB_OBJS} + + ZLIB_DLL_FILE="" + + ZLIB_LIBS="" fi diff --git a/win/configure.in b/win/configure.in index 01366f5..dec470a 100644 --- a/win/configure.in +++ b/win/configure.in @@ -129,13 +129,27 @@ AS_IF([test "${enable_shared+set}" = "set"], [ AC_ARG_WITH(zlib, [ --with-zlib use Native Zlib library], with_zlib=$withval, with_zlib=NO_ZLIB ) +AS_IF([test "$tcl_ok" = "yes"], [ + AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) +]) +tcl_no_zlib_dll=no AS_IF( - [test "with_zlib" = "NO_ZLIB"], [AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])], - [test "$tcl_ok" != "yes"], [AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])], - [test "$do64bit" = "yes"], [AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])], - [test "$with_zlib" = "yes"] , [AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib])], - [AC_SUBST(ZLIB_LIBS,[$with_zlib])] + [test "$with_zlib" = "NO_ZLIB"], [tcl_no_zlib_dll=yes], + [test "$tcl_ok" != "yes"], [tcl_no_zlib_dll=yes], + [test "$do64bit" = "yes"], [tcl_no_zlib_dll=yes], + [test "$with_zlib" = "yes"] , [ + AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib]) + ], [ + AC_SUBST(ZLIB_DLL_FILE,[${with_zlib}]) + AC_SUBST(ZLIB_LIBS,[$with_zlib]) + ] ) +AS_IF([test "$tcl_no_zlib_dll" = "yes"], [ + AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) + AC_SUBST(ZLIB_DLL_FILE,[""]) + AC_SUBST(ZLIB_LIBS,[""]) +]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) AC_CHECK_TYPE([intptr_t], [ -- cgit v0.12 From 6c2512bc35c2c94e80f3bac2dc723147db4d6461 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 3 Sep 2014 10:24:53 +0000 Subject: Clean up of docs, import basic text from comments in code, format. --- doc/zvfs.n | 153 +++++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 114 insertions(+), 39 deletions(-) diff --git a/doc/zvfs.n b/doc/zvfs.n index ba33fb6..f2ad9aa 100644 --- a/doc/zvfs.n +++ b/doc/zvfs.n @@ -1,39 +1,114 @@ -'\" -'\" Copyright (c) 2014 Sean Woods -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH zvfs n 0.1 Zvfs "Zvfs Commands" -.so man.macros -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -http \- Client-side implementation of the HTTP/1.1 protocol -.SH SYNOPSIS -\fBpackage require zvfs ?0.1?\fR -.sp -\fB::zvfs::mount \fIZIPFILE \fIMOUNTPOINT\fR ...? -.sp -\fB::zvfs::unmount \fIZIPFILE\fR ...? -.sp -\fB::zvfs::append ?\fI\-option value\fR ...? -.sp -\fB::zvfs::add ?\fI\-option value\fR ...? -.sp -\fB::zvfs::exists ?\fI\-option value\fR ...? -.sp -\fB::zvfs::info ?\fI\-option value\fR ...? -.sp -\fB::zvfs::list ?\fI\-option value\fR ...? -.sp -\fB::zvfs::dump ?\fI\-option value\fR ...? -.sp -\fB::zvfs::start ?\fI\-option value\fR ...? -.BE -.SH DESCRIPTION -.PP -The \fBzvfs\fR package provides tcl with the ability to manipulate -the contents of a zip file archive as a virtual file system. -.PP -The \fB::zvfs::mount\fR procedure mounts a zipfile as a VFS. \ No newline at end of file +'\" +'\" Copyright (c) 2014 Sean Woods +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH zvfs n 0.1 Zvfs "Zvfs Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +zvfs \- Mount and work with ZIP files within Tcl +.SH SYNOPSIS +.nf +\fBpackage require zvfs \fR?\fB0.1\fR? +.sp +\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR? +\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR? +\fB::zvfs::dump\fR \fIzipfile\fR +\fB::zvfs::exists\fR \fIfilename\fR +\fB::zvfs::info\fR \fIfile\fR +\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR? +\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR? +\fB::zvfs::start\fR \fIzipfile\fR +\fB::zvfs::unmount \fIarchive\fR +.fi +.BE +.SH DESCRIPTION +.PP +The \fBzvfs\fR package provides tcl with the ability to manipulate +the contents of a zip file archive as a virtual file system. +.TP +\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR? +. +The \fB::zvfs::mount\fR procedure mounts a zipfile as a VFS. +After this command +executes, files contained in the ZIP archive, \fIarchive\fR, will appear to Tcl to be +regular files at the mount point. +.RS +.PP +With no \fImountpoint\fR, returns the mount point for \fIarchive\fR. With no \fIarchive\fR, +return all archive/mount pairs. If \fImountpoint\fR is specified as an empty +string, mount on file path. +.RE +.TP +\fB::zvfs::unmount \fIarchive\fR +. +Unmounts a previously mounted zip, \fIarchive\fR. +.TP +\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR? +. +This command reads \fIsource\fR files and appends them (using the name +\fIdestination\fR) to the zip archive named \fIarchive\fR. A new zip archive is created +if it does not already exist. If \fIarchive\fR refers to a file which exists but +is not a zip archive, then this command turns \fIarchive\fR into a zip archive by +appending the necessary records and the table of contents. Treat all files +as binary. +.RS +.PP +Note: No duplicate checking is done, so multiple occurances of the same file is +allowed. +.RE +.TP +\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR? +. +This command is similar to \fBzvfs::append\fR in that it adds files to the zip archive +named \fIarchive\fR, however file names are relative the current directory. In +addition, \fBfconfigure\fR is used to apply option pairs to set upon opening of +each file. Otherwise, default translation is allowed for those file +extensions listed in the \fB::zvfs::auto_ext\fR variable. Binary translation will be +used for unknown extensions. +.RS +.PP +NOTE: Use +.QW "\fB\-fconfigure {}\fR" +to use auto translation for all. +.RE +.TP +\fB::zvfs::exists\fR \fIfilename\fR +. +Return TRUE if the given filename exists in the mounted ZVFS and FALSE if it does +not. +.TP +\fB::zvfs::info\fR \fIfile\fR +. +Return information about the given file in the mounted ZVFS. The information +consists of (1) the name of the ZIP archive that contains the file, (2) the +size of the file after decompressions, (3) the compressed size of the file, +and (4) the offset of the compressed data in the archive. +.RS +.PP +Note: querying the mount point gives the start of zip data offset in (4), +which can be used to truncate the zip info off an executable. +.RE +.TP +\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR? +. +Return a list of all files in the mounted ZVFS. The order of the names in the list +is arbitrary. +.TP +\fB::zvfs::dump\fR \fIzipfile\fR +. +Describe the contents of a zip. +.TP +\fB::zvfs::start\fR \fIzipfile\fR +. +This command strips returns the offset of zip data. +.SH "SEE ALSO" +tclsh(1), file(n), zlib(n) +.SH "KEYWORDS" +compress, filesystem, zip +'\" Local Variables: +'\" mode: nroff +'\" End: -- cgit v0.12 From 8d1d673760dab89fb53dc4ef0f4366c432e80bd5 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 3 Sep 2014 10:50:06 +0000 Subject: Backported dkf's documentation effort to the main core_zip_vfs branch --- doc/tclsh.1 | 9 +++++ doc/zvfs.n | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 123 insertions(+) create mode 100644 doc/zvfs.n diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 6ed5eb6..25d97c5 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -143,6 +143,15 @@ incomplete commands. .SH "STANDARD CHANNELS" .PP See \fBTcl_StandardChannels\fR for more explanations. +.SH ZIPVFS +.PP +When a zipfile is concatenated to the end of a \fBtclsh\fR, on +startup the contents of the zip archive will be mounted as the +virtual file system /zvfs. If a top level directory tcl8.6 is +present in the zip archive, it will become the directory loaded +as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present +in the top level directory of the zip archive, it will be sourced +instead of the shell's normal command line handing. .SH "SEE ALSO" auto_path(n), encoding(n), env(n), fconfigure(n) .SH KEYWORDS diff --git a/doc/zvfs.n b/doc/zvfs.n new file mode 100644 index 0000000..f2ad9aa --- /dev/null +++ b/doc/zvfs.n @@ -0,0 +1,114 @@ +'\" +'\" Copyright (c) 2014 Sean Woods +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH zvfs n 0.1 Zvfs "Zvfs Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +zvfs \- Mount and work with ZIP files within Tcl +.SH SYNOPSIS +.nf +\fBpackage require zvfs \fR?\fB0.1\fR? +.sp +\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR? +\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR? +\fB::zvfs::dump\fR \fIzipfile\fR +\fB::zvfs::exists\fR \fIfilename\fR +\fB::zvfs::info\fR \fIfile\fR +\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR? +\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR? +\fB::zvfs::start\fR \fIzipfile\fR +\fB::zvfs::unmount \fIarchive\fR +.fi +.BE +.SH DESCRIPTION +.PP +The \fBzvfs\fR package provides tcl with the ability to manipulate +the contents of a zip file archive as a virtual file system. +.TP +\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR? +. +The \fB::zvfs::mount\fR procedure mounts a zipfile as a VFS. +After this command +executes, files contained in the ZIP archive, \fIarchive\fR, will appear to Tcl to be +regular files at the mount point. +.RS +.PP +With no \fImountpoint\fR, returns the mount point for \fIarchive\fR. With no \fIarchive\fR, +return all archive/mount pairs. If \fImountpoint\fR is specified as an empty +string, mount on file path. +.RE +.TP +\fB::zvfs::unmount \fIarchive\fR +. +Unmounts a previously mounted zip, \fIarchive\fR. +.TP +\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR? +. +This command reads \fIsource\fR files and appends them (using the name +\fIdestination\fR) to the zip archive named \fIarchive\fR. A new zip archive is created +if it does not already exist. If \fIarchive\fR refers to a file which exists but +is not a zip archive, then this command turns \fIarchive\fR into a zip archive by +appending the necessary records and the table of contents. Treat all files +as binary. +.RS +.PP +Note: No duplicate checking is done, so multiple occurances of the same file is +allowed. +.RE +.TP +\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR? +. +This command is similar to \fBzvfs::append\fR in that it adds files to the zip archive +named \fIarchive\fR, however file names are relative the current directory. In +addition, \fBfconfigure\fR is used to apply option pairs to set upon opening of +each file. Otherwise, default translation is allowed for those file +extensions listed in the \fB::zvfs::auto_ext\fR variable. Binary translation will be +used for unknown extensions. +.RS +.PP +NOTE: Use +.QW "\fB\-fconfigure {}\fR" +to use auto translation for all. +.RE +.TP +\fB::zvfs::exists\fR \fIfilename\fR +. +Return TRUE if the given filename exists in the mounted ZVFS and FALSE if it does +not. +.TP +\fB::zvfs::info\fR \fIfile\fR +. +Return information about the given file in the mounted ZVFS. The information +consists of (1) the name of the ZIP archive that contains the file, (2) the +size of the file after decompressions, (3) the compressed size of the file, +and (4) the offset of the compressed data in the archive. +.RS +.PP +Note: querying the mount point gives the start of zip data offset in (4), +which can be used to truncate the zip info off an executable. +.RE +.TP +\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR? +. +Return a list of all files in the mounted ZVFS. The order of the names in the list +is arbitrary. +.TP +\fB::zvfs::dump\fR \fIzipfile\fR +. +Describe the contents of a zip. +.TP +\fB::zvfs::start\fR \fIzipfile\fR +. +This command strips returns the offset of zip data. +.SH "SEE ALSO" +tclsh(1), file(n), zlib(n) +.SH "KEYWORDS" +compress, filesystem, zip +'\" Local Variables: +'\" mode: nroff +'\" End: -- cgit v0.12 From b6f9bc7ca80044ec0d8f106974a7adb0544a339f Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 3 Sep 2014 20:41:12 +0000 Subject: More tweaks to makefiles --- unix/Makefile.in | 1 - win/Makefile.in | 13 ++++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 8f260d0..f9d713d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -654,7 +654,6 @@ null.zip: zip null.zip .empty ${TCLKIT_EXE}: ${TCL_EXE} null.zip - rm -f tclkit.zip PWD=`pwd` cp -f ${TCL_EXE} ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} diff --git a/win/Makefile.in b/win/Makefile.in index f302ed6..d99e204 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -426,12 +426,15 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclkit: $(TCLKIT) -$(TCLKIT): $(TCLSH) - rm -f tclkit.zip +null.zip: + touch .empty + zip null.zip .empty + +$(TCLKIT): $(TCLSH) null.zip PWD=`pwd` - cd ${prefix}/lib ; zip -rq ${PWD}/tclkit.zip tcl8 tcl8.6 - cp -f $(TCLSH) $(TCLKIT) - cat tclkit.zip >> $(TCLKIT) + cp -f $(WISH) $(TCLKIT) + cat null.zip >> $(TCLKIT) + cd ${prefix}/lib ; zip -rAq ${PWD}/$(TCLKIT) tcl8 tcl8.6 cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) -- cgit v0.12 From 4691bea988bc3a8d8eb072348163aa2e17c69b85 Mon Sep 17 00:00:00 2001 From: tne Date: Wed, 3 Sep 2014 22:03:08 +0000 Subject: Typo Fix --- win/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/Makefile.in b/win/Makefile.in index d99e204..0874147 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -432,7 +432,7 @@ null.zip: $(TCLKIT): $(TCLSH) null.zip PWD=`pwd` - cp -f $(WISH) $(TCLKIT) + cp -f $(TCLSH) $(TCLKIT) cat null.zip >> $(TCLKIT) cd ${prefix}/lib ; zip -rAq ${PWD}/$(TCLKIT) tcl8 tcl8.6 -- cgit v0.12 From b992e62207d7ecfeeacc81983c34cad57423930d Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 4 Sep 2014 00:30:04 +0000 Subject: Re-engineered the windows kitbuilding process to produce a standalone executable (in a similar process as tcltest is made). The kit specific functions of tclAppInit have been wrapped around define macros, and are only active if TCL_KIT is defined. (Which is only done when building the tclkit executable) --- generic/tclZipVfs.c | 3 +++ win/Makefile.in | 14 +++++++++++--- win/tclAppInit.c | 10 +++++++--- 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index 7baf469..ed2ddcc 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1785,7 +1785,10 @@ int Tcl_Zvfs_Boot(Tcl_Interp *interp) { Tcl_IncrRefCount(vfstklib); if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ Tcl_SetStartupScript(vfsinitscript,NULL); + } else { + Tcl_SetStartupScript(NULL,NULL); } if(Tcl_FSAccess(vfstcllib,F_OK)==0) { Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY); diff --git a/win/Makefile.in b/win/Makefile.in index 0874147..3e44cff 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -392,6 +392,9 @@ STUB_OBJS = \ TCLSH_OBJS = tclAppInit.$(OBJEXT) +TCLKIT_OBJS = tclKitInit.$(OBJEXT) + + ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ @@ -428,11 +431,13 @@ tclkit: $(TCLKIT) null.zip: touch .empty - zip null.zip .empty + zip -q null.zip .empty -$(TCLKIT): $(TCLSH) null.zip +$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip + $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ PWD=`pwd` - cp -f $(TCLSH) $(TCLKIT) cat null.zip >> $(TCLKIT) cd ${prefix}/lib ; zip -rAq ${PWD}/$(TCLKIT) tcl8 tcl8.6 @@ -499,6 +504,9 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +tclKitInit.$(OBJEXT): tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_KIT @DEPARG@ $(CC_OBJNAME) + # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed diff --git a/win/tclAppInit.c b/win/tclAppInit.c index a8eac66..c6b3b44 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -15,7 +15,6 @@ */ #include "tcl.h" -#include "tclInt.h" #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN @@ -124,7 +123,11 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif - +#if defined TCL_KIT + /* This voodoo ensures that Tcl_Main does not eat the first argument */ + Tcl_FindExecutable(argv[0]); + Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL); +#endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -152,8 +155,9 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { +#if defined TCL_KIT Tcl_Zvfs_Boot(interp); - +#endif if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } -- cgit v0.12 From 703177e26a844971a0376dd6feb70d586a8bae97 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 4 Sep 2014 01:22:20 +0000 Subject: Adapted the Unix startup process to ifdef out the KIT specific behaviors. tclkit is now build as a standalone exectuble. --- unix/Makefile.in | 18 +++++++++++++----- unix/tclAppInit.c | 11 +++++++++-- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index f9d713d..8f77687 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -285,6 +285,9 @@ ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o +TCLKIT_OBJS = tclKitInit.o + + TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o @@ -648,19 +651,24 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCL_EXE} + +# Must be empty so it doesn't conflict with rule for ${TCL_EXE} above +${NATIVE_TCLSH}: null.zip: touch .empty zip null.zip .empty -${TCLKIT_EXE}: ${TCL_EXE} null.zip +${TCLKIT_EXE}: ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip + $(CC) -c $(APP_CC_SWITCHES) \ + -DTCL_KIT $(UNIX_DIR)/tclAppInit.c -o tclKitInit.o + ${CC} ${CFLAGS} ${LDFLAGS} tclKitInit.o \ + @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ + ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} PWD=`pwd` cp -f ${TCL_EXE} ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} cd ${prefix}/lib ; zip -rAq ${PWD}/${TCLKIT_EXE} tcl8 tcl8.6 - -# Must be empty so it doesn't conflict with rule for ${TCL_EXE} above -${NATIVE_TCLSH}: Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status @@ -1035,7 +1043,7 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} @if test -f tclAppInit.sav ; then \ mv tclAppInit.sav tclAppInit.o; \ fi; - + # Object files used on all Unix systems: REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \ diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 95dc38e..acd6aa1 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -80,7 +80,12 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif - +#ifdef TCL_KIT + printf("Running Kit Mode\n"); + /* This voodoo ensures that Tcl_Main does not eat the first argument */ + Tcl_FindExecutable(argv[0]); + Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL); +#endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -108,8 +113,10 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { +#ifdef TCL_KIT Tcl_Zvfs_Boot(interp); - +#endif + if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } -- cgit v0.12 From 295272b73c55a78fda55d5fa34edaa20fcc7f14c Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 4 Sep 2014 01:23:45 +0000 Subject: Removed some debugging code of mine... --- unix/tclAppInit.c | 1 - 1 file changed, 1 deletion(-) diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index acd6aa1..55e0452 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -81,7 +81,6 @@ main( TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif #ifdef TCL_KIT - printf("Running Kit Mode\n"); /* This voodoo ensures that Tcl_Main does not eat the first argument */ Tcl_FindExecutable(argv[0]); Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL); -- cgit v0.12 From a813938befa49293741ca51da80f5bb0eb24ae36 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 4 Sep 2014 01:27:55 +0000 Subject: Removed a typo --- unix/Makefile.in | 1 - 1 file changed, 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 8f77687..9310753 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -666,7 +666,6 @@ ${TCLKIT_EXE}: ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} PWD=`pwd` - cp -f ${TCL_EXE} ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} cd ${prefix}/lib ; zip -rAq ${PWD}/${TCLKIT_EXE} tcl8 tcl8.6 -- cgit v0.12 From 3bd1370dbc61266dbec306b5333d22c4c11d81e0 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 6 Sep 2014 00:58:23 +0000 Subject: New build process for Tcl kits in Unix (Windows port to follow...) Rather than force a "make install" to build the vfs, the tclkit now performs it's own "install" to a subdirectory (using destdir) to collect the files it needs for its vfs. tclkits no longer link to the tcl library. Instead, all of the obj files that are used to assemble the lib are instead packed into the executable. Thus, "make tclkit" produces the tclkit. That's it. No dlls. No tclsh. Makes no other mark on the file system save the bare essentials it needs. It uses the same variables in the makefile as the tcl libraries, so as they are updated so too is tclkit. Zlib files are *always* build for tclkits. Tclkits can never rely on the presence of zlib on the systems in which they will be installed. --- generic/tcl.decls | 2 +- generic/tclDecls.h | 6 ++-- generic/tclZipVfs.c | 37 ++++++++++++++++++----- unix/Makefile.in | 33 +++++++++++++------- unix/tclKitInit.c | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 143 insertions(+), 21 deletions(-) create mode 100644 unix/tclKitInit.c diff --git a/generic/tcl.decls b/generic/tcl.decls index 5b0220e..c24898e 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2328,7 +2328,7 @@ declare 630 { # ZipVfs declare 631 { - int Tcl_Zvfs_Boot(Tcl_Interp *interp) +int Tcl_Zvfs_Boot(Tcl_Interp *interp,const char *vfsmountpoint,const char *initscript) } ############################################################################## diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 06b46f0..65d940d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1816,7 +1816,9 @@ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 631 */ -EXTERN int Tcl_Zvfs_Boot(Tcl_Interp *interp); +EXTERN int Tcl_Zvfs_Boot(Tcl_Interp *interp, + const char *vfsmountpoint, + const char *initscript); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2483,7 +2485,7 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ - int (*tcl_Zvfs_Boot) (Tcl_Interp *interp); /* 631 */ + int (*tcl_Zvfs_Boot) (Tcl_Interp *interp, const char *vfsmountpoint, const char *initscript); /* 631 */ } TclStubs; extern const TclStubs *tclStubsPtr; diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index ed2ddcc..dc96313 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1765,9 +1765,10 @@ Zvfs_doInit( /* ** Boot a shell, mount the executable's VFS, detect main.tcl */ -int Tcl_Zvfs_Boot(Tcl_Interp *interp) { - +int Tcl_Zvfs_Boot(Tcl_Interp *interp,const char *vfsmountpoint,const char *initscript) { CONST char *cp=Tcl_GetNameOfExecutable(); + char filepath[256]; + /* We have to initialize the virtual filesystem before calling ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find ** its startup script files. @@ -1775,11 +1776,23 @@ int Tcl_Zvfs_Boot(Tcl_Interp *interp) { if(Zvfs_doInit(interp, 0)) { return TCL_ERROR; } - if(!Tcl_Zvfs_Mount(interp, cp, "/zvfs")) { - Tcl_Obj *vfsinitscript=Tcl_NewStringObj("/zvfs/main.tcl",-1); - Tcl_Obj *vfstcllib=Tcl_NewStringObj("/zvfs/tcl8.6",-1); - Tcl_Obj *vfstklib=Tcl_NewStringObj("/zvfs/tk8.6",-1); - + if(!Tcl_Zvfs_Mount(interp, cp, vfsmountpoint)) { + Tcl_Obj *vfsinitscript; + Tcl_Obj *vfstcllib; + Tcl_Obj *vfstklib; + + + strcpy(filepath,vfsmountpoint); + strcat(filepath,"/"); + strcat(filepath,initscript); + vfsinitscript=Tcl_NewStringObj(filepath,-1); + strcpy(filepath,vfsmountpoint); + strcat(filepath,"/tcl8.6"); + vfstcllib=Tcl_NewStringObj(filepath,-1); + strcpy(filepath,vfsmountpoint); + strcat(filepath,"/tk8.6"); + vfstklib=Tcl_NewStringObj(filepath,-1); + Tcl_IncrRefCount(vfsinitscript); Tcl_IncrRefCount(vfstcllib); Tcl_IncrRefCount(vfstklib); @@ -1790,17 +1803,27 @@ int Tcl_Zvfs_Boot(Tcl_Interp *interp) { } else { Tcl_SetStartupScript(NULL,NULL); } + + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } else { + Tcl_SetStartupScript(NULL,NULL); + } if(Tcl_FSAccess(vfstcllib,F_OK)==0) { Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY); } if(Tcl_FSAccess(vfstklib,F_OK)==0) { Tcl_SetVar2(interp, "env", "TK_LIBRARY", Tcl_GetString(vfstklib), TCL_GLOBAL_ONLY); } + Tcl_DecrRefCount(vfsinitscript); Tcl_DecrRefCount(vfstcllib); + Tcl_DecrRefCount(vfstklib); } return TCL_OK; } + int Tcl_Zvfs_Init( diff --git a/unix/Makefile.in b/unix/Makefile.in index 9310753..30e7109 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -285,9 +285,6 @@ ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o -TCLKIT_OBJS = tclKitInit.o - - TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o @@ -363,6 +360,8 @@ ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ +TCLKIT_OBJS = tclKitInit.o + OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ TCL_DECLS = \ @@ -555,6 +554,7 @@ UNIX_HDRS = \ UNIX_SRCS = \ $(UNIX_DIR)/tclAppInit.c \ + $(UNIX_DIR)/tclKitInit.c \ $(UNIX_DIR)/tclUnixChan.c \ $(UNIX_DIR)/tclUnixEvent.c \ $(UNIX_DIR)/tclUnixFCmd.c \ @@ -612,6 +612,9 @@ ZLIB_SRCS = \ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ +PWD=`pwd` +VFS_INSTALL_DIR=${PWD}/tclkit.vfs/tcl8.6 + #-------------------------------------------------------------------------- # Start of rules #-------------------------------------------------------------------------- @@ -659,15 +662,21 @@ null.zip: touch .empty zip null.zip .empty -${TCLKIT_EXE}: ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip - $(CC) -c $(APP_CC_SWITCHES) \ - -DTCL_KIT $(UNIX_DIR)/tclAppInit.c -o tclKitInit.o - ${CC} ${CFLAGS} ${LDFLAGS} tclKitInit.o \ - @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ +# Rather than force an install, pack the files we need into a +# file system under our control +tclkit.vfs: + make install-libraries DESTDIR=tclkit.vfs + make install-tzdata DESTDIR=tclkit.vfs + make install-packages DESTDIR=tclkit.vfs + +# Assemble all of the tcl sources into a single executable +${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs + ${CC} ${CFLAGS} ${LDFLAGS} \ + ${TCLKIT_OBJS} ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} \ + ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} - PWD=`pwd` cat null.zip >> ${TCLKIT_EXE} - cd ${prefix}/lib ; zip -rAq ${PWD}/${TCLKIT_EXE} tcl8 tcl8.6 + cd tclkit.vfs${prefix}/lib ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status @@ -676,7 +685,9 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: clean-packages rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ - errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ + errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ + ${TCLKIT_EXE} + rm -rf tclkit.vfs null.zip cd dltest ; $(MAKE) clean distclean: distclean-packages clean diff --git a/unix/tclKitInit.c b/unix/tclKitInit.c new file mode 100644 index 0000000..96861de --- /dev/null +++ b/unix/tclKitInit.c @@ -0,0 +1,86 @@ +/* +** This file implements the main routine for a standalone Tcl/Tk shell. +*/ +#include +#include "tclInt.h" +#define TCLKIT_INIT "main.tcl" +#define TCLKIT_VFSMOUNT "/zvfs" + +#define TCL_LOCAL_APPINIT Tclkit_AppInit +MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); +MODULE_SCOPE int main(int, char **); + +/* +** This routine runs first. +*/ +int main(int argc, char **argv){ + Tcl_FindExecutable(argv[0]); + Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL); + Tcl_Main(argc,argv,&Tclkit_AppInit); + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * + * Tclkit_AppInit -- + * + * This procedure performs application-specific initialization. Most + * applications, especially those that incorporate additional packages, + * will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tclkit_AppInit( + Tcl_Interp *interp) /* Interpreter for application. */ +{ + Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT); + + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Call the init procedures for included packages. Each call should look + * like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. (Dynamically-loadable packages + * should have the same entry-point name.) + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if they + * weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application is + * run interactively. Typically the startup file is "~/.apprc" where "app" + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. + */ + +#ifdef DJGPP + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY); +#else + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY); +#endif + + return TCL_OK; +} \ No newline at end of file -- cgit v0.12 From 0008ed9ea4c5bf8c010649489a28c86839ebdf0c Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 6 Sep 2014 01:21:54 +0000 Subject: Preliminary checkin for Windows tclkit builds --- unix/tclAppInit.c | 14 +-- win/Makefile.in | 16 ++- win/tclAppInit.c | 9 +- win/tclKitInit.c | 324 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 339 insertions(+), 24 deletions(-) create mode 100644 win/tclKitInit.c diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 55e0452..9bbc88b 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -15,7 +15,7 @@ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" -#include "tclInt.h" + #ifdef TCL_TEST extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; @@ -80,11 +80,7 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif -#ifdef TCL_KIT - /* This voodoo ensures that Tcl_Main does not eat the first argument */ - Tcl_FindExecutable(argv[0]); - Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL); -#endif + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -112,10 +108,6 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { -#ifdef TCL_KIT - Tcl_Zvfs_Boot(interp); -#endif - if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } @@ -132,7 +124,7 @@ Tcl_AppInit( } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ - + /* * Call the init procedures for included packages. Each call should look * like this: diff --git a/win/Makefile.in b/win/Makefile.in index 3e44cff..e85cc16 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -433,13 +433,19 @@ null.zip: touch .empty zip -q null.zip .empty -$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip - $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) +# Rather than force an install, pack the files we need into a +# file system under our control +tclkit.vfs: + make install-libraries DESTDIR=tclkit.vfs + make install-tzdata DESTDIR=tclkit.vfs + make install-packages DESTDIR=tclkit.vfs + +$(TCLKIT): $(TCLKIT_OBJS) $(TCL_OBJS) $(TOMMATH_OBJS) $(ZLIB_OBJS) tclsh.$(RES) null.zip tclkit.vfs + $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_OBJS) $(TOMMATH_OBJS) $(ZLIB_OBJS) \ + $(LIBS) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ - PWD=`pwd` cat null.zip >> $(TCLKIT) - cd ${prefix}/lib ; zip -rAq ${PWD}/$(TCLKIT) tcl8 tcl8.6 + cd tclkit.vfs${prefix}/lib ; zip -rAq $(WIN_DIR)/$(TCLKIT) tcl8 tcl8.6 cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index c6b3b44..a6c1a67 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -123,11 +123,7 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif -#if defined TCL_KIT - /* This voodoo ensures that Tcl_Main does not eat the first argument */ - Tcl_FindExecutable(argv[0]); - Tcl_SetStartupScript(Tcl_NewStringObj("/zvfs/main.tcl",-1),NULL); -#endif + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -155,9 +151,6 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { -#if defined TCL_KIT - Tcl_Zvfs_Boot(interp); -#endif if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } diff --git a/win/tclKitInit.c b/win/tclKitInit.c new file mode 100644 index 0000000..69a298c --- /dev/null +++ b/win/tclKitInit.c @@ -0,0 +1,324 @@ +/* + * tclAppInit.c -- + * + * Provides a default version of the main program and TclKit_AppInit + * procedure for tclsh and other Tcl-based applications (without Tk). + * Note that this program must be built in Win32 console mode to work + * properly. + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tcl.h" +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN +#include +#include +#include + +extern Tcl_PackageInitProc Registry_Init; +extern Tcl_PackageInitProc Dde_Init; +extern Tcl_PackageInitProc Dde_SafeInit; + +#ifdef TCL_BROKEN_MAINARGS +int _CRT_glob = 0; +static void setargv(int *argcPtr, TCHAR ***argvPtr); +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * The following #if block allows you to change the AppInit function by using + * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The + * #if checks for that #define and uses TclKit_AppInit if it does not exist. + */ +#define TCLKIT_INIT "main.tcl" +#define TCLKIT_VFSMOUNT "/zvfs" +#ifndef TCL_LOCAL_APPINIT +#define TCL_LOCAL_APPINIT TclKit_AppInit +#endif +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); + +/* + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, etc., + * without needing to rewrite Tcl_Main() + */ + +#ifdef TCL_LOCAL_MAIN_HOOK +MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); +#endif + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tcl_Main never returns here, so this procedure never returns + * either. + * + * Side effects: + * Just about anything, since from here we call arbitrary Tcl code. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +int +main( + int argc, /* Number of command-line arguments. */ + char *dummy[]) /* Not used. */ +{ + TCHAR **argv; +#else +int +_tmain( + int argc, /* Number of command-line arguments. */ + TCHAR *argv[]) /* Values of command-line arguments. */ +{ +#endif + TCHAR *p; + + /* + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. + */ + + setlocale(LC_ALL, "C"); + +#ifdef TCL_BROKEN_MAINARGS + /* + * Get our args from the c-runtime. Ignore command line. + */ + + setargv(&argc, &argv); +#endif + + /* + * Forward slashes substituted for backslashes. + */ + + for (p = argv[0]; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + +#ifdef TCL_LOCAL_MAIN_HOOK + TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#endif + /* This voodoo ensures that Tcl_Main does not eat the first argument */ + Tcl_FindExecutable(argv[0]); + Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL); + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * TclKit_AppInit -- + * + * This procedure performs application-specific initialization. Most + * applications, especially those that incorporate additional packages, + * will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +TclKit_AppInit( + Tcl_Interp *interp) /* Interpreter for application. */ +{ + Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT); + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + if (Registry_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); + + if (Dde_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); + + /* + * Call the init procedures for included packages. Each call should look + * like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. (Dynamically-loadable packages + * should have the same entry-point name.) + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if they + * weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application is + * run interactively. Typically the startup file is "~/.apprc" where "app" + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. + */ + + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * setargv -- + * + * Parse the Windows command line string into argc/argv. Done here + * because we don't trust the builtin argument parser in crt0. Windows + * applications are responsible for breaking their command line into + * arguments. + * + * 2N backslashes + quote -> N backslashes + begin quoted string + * 2N + 1 backslashes + quote -> literal + * N backslashes + non-quote -> literal + * quote + quote in a quoted string -> single quote + * quote + quote not in quoted string -> empty string + * quote -> begin quoted string + * + * Results: + * Fills argcPtr with the number of arguments and argvPtr with the array + * of arguments. + * + * Side effects: + * Memory allocated. + * + *-------------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +static void +setargv( + int *argcPtr, /* Filled with number of argument strings. */ + TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ +{ + TCHAR *cmdLine, *p, *arg, *argSpace; + TCHAR **argv; + int argc, size, inquote, copy, slashes; + + cmdLine = GetCommandLine(); + + /* + * Precompute an overly pessimistic guess at the number of arguments in + * the command line by counting non-space spans. + */ + + size = 2; + for (p = cmdLine; *p != '\0'; p++) { + if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + size++; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + } + } + + /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + #undef Tcl_Alloc + #undef Tcl_DbCkalloc + + argSpace = ckalloc(size * sizeof(char *) + + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); + argv = (TCHAR **) argSpace; + argSpace += size * (sizeof(char *)/sizeof(TCHAR)); + size--; + + p = cmdLine; + for (argc = 0; argc < size; argc++) { + argv[argc] = arg = argSpace; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + + inquote = 0; + slashes = 0; + while (1) { + copy = 1; + while (*p == '\\') { + slashes++; + p++; + } + if (*p == '"') { + if ((slashes & 1) == 0) { + copy = 0; + if ((inquote) && (p[1] == '"')) { + p++; + copy = 1; + } else { + inquote = !inquote; + } + } + slashes >>= 1; + } + + while (slashes) { + *arg = '\\'; + arg++; + slashes--; + } + + if ((*p == '\0') || (!inquote && + ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ + break; + } + if (copy != 0) { + *arg = *p; + arg++; + } + p++; + } + *arg = '\0'; + argSpace = arg + 1; + } + argv[argc] = NULL; + + *argcPtr = argc; + *argvPtr = argv; +} +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ -- cgit v0.12 From 71e02d5298ef4a81b4aa0494ee1ba7d8f433391d Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 6 Sep 2014 11:41:26 +0000 Subject: Created a designated bootloader for Tclkits under windows On windows, tclkits build a private VFS instead of relying on make install Added a tool to build the tcl kit's VFS, as well as index the bundled packages --- library/http/http.tcl | 2 +- tools/mkVfs.tcl | 109 +++++++++ win/Makefile.in | 35 +-- win/tclKitInit.c | 649 +++++++++++++++++++++++++------------------------- 4 files changed, 454 insertions(+), 341 deletions(-) create mode 100644 tools/mkVfs.tcl diff --git a/library/http/http.tcl b/library/http/http.tcl index a6b2bfd..afa9458 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -12,7 +12,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.8 - +puts [list LOADED [info script]] namespace eval http { # Allow resourcing to not clobber existing data diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl new file mode 100644 index 0000000..c7bf17b --- /dev/null +++ b/tools/mkVfs.tcl @@ -0,0 +1,109 @@ +proc cat fname { + set fname [open $fname r] + set data [read $fname] + close $fname + return $data +} + +proc pkgIndexDir {root fout d1} { + + puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \ + [file tail $d1]] + set idx [string length $root] + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + pkgIndexDir $root $fout $f + } elseif {[file tail $f] eq "pkgIndex.tcl"} { + puts $fout "set dir \$HERE[string range $d1 $idx end]" + puts $fout [cat $f] + } + } +} + +### +# Script to build the VFS file system +### +proc copyDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ + [file tail $d2]] + + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +if {[llength $argv] < 3} { + puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" + exit 1 +} +set TCL_SCRIPT_DIR [lindex $argv 0] +set TCLSRC_ROOT [lindex $argv 1] +set PLATFORM [lindex $argv 2] + +puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" +copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} + +if {$PLATFORM == "windows"} { + set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] + puts "DDE DLL $ddedll" + if {$ddedll != {}} { + file copy $ddedll ${TCL_SCRIPT_DIR}/dde + } + set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] + puts "REG DLL $ddedll" + if {$regdll != {}} { + file copy $regdll ${TCL_SCRIPT_DIR}/reg + } +} else { + # Remove the dde and reg package paths + file delete -force ${TCL_SCRIPT_DIR}/dde + file delete -force ${TCL_SCRIPT_DIR}/reg +} + +# For the following packages, cat their pkgIndex files to tclIndex +file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0 +set fout [open ${TCL_SCRIPT_DIR}/tclIndex a] +puts $fout {# +# MANIFEST OF INCLUDED PACKAGES +# +set HERE $dir +} +pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} +close $fout +exit 0 +puts $fout { +# Save Tcl the trouble of hunting for these packages +} +set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] +puts "DDE DLL $ddedll" +if {$ddedll != {}} { + puts $fout [cat ${TCL_SCRIPT_DIR}/dde/pkgIndex.tcl] +} +set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] +puts "REG DLL $ddedll" +if {$regdll != {}} { + puts $fout [cat ${TCL_SCRIPT_DIR}/reg/pkgIndex.tcl] +} +close $fout +file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 1 diff --git a/win/Makefile.in b/win/Makefile.in index e85cc16..ec824cc 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -103,6 +103,10 @@ COMPAT_DIR = $(TOP_DIR)/compat PKGS_DIR = $(TOP_DIR)/pkgs ZLIB_DIR = $(COMPAT_DIR)/zlib +VFS_SCRIPT_INSTALL_DIR = $(WIN_DIR)/tclvfs.zip/tcl$(VERSION) +VFS_PKG_INSTALL_DIR = $(WIN_DIR)/tclvfs.zip/lib + + # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ @@ -392,9 +396,6 @@ STUB_OBJS = \ TCLSH_OBJS = tclAppInit.$(OBJEXT) -TCLKIT_OBJS = tclKitInit.$(OBJEXT) - - ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ @@ -410,6 +411,10 @@ ZLIB_OBJS = \ TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ +TCLKIT_OBJS = tclKitInit.$(OBJEXT) \ + ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} + + TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc packages @@ -435,17 +440,17 @@ null.zip: # Rather than force an install, pack the files we need into a # file system under our control -tclkit.vfs: - make install-libraries DESTDIR=tclkit.vfs - make install-tzdata DESTDIR=tclkit.vfs - make install-packages DESTDIR=tclkit.vfs - -$(TCLKIT): $(TCLKIT_OBJS) $(TCL_OBJS) $(TOMMATH_OBJS) $(ZLIB_OBJS) tclsh.$(RES) null.zip tclkit.vfs - $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_OBJS) $(TOMMATH_OBJS) $(ZLIB_OBJS) \ - $(LIBS) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) +tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) + @echo "Building VFS File system in tclkit.vfs" + @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ + "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows + +$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs + $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat null.zip >> $(TCLKIT) - cd tclkit.vfs${prefix}/lib ; zip -rAq $(WIN_DIR)/$(TCLKIT) tcl8 tcl8.6 + cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -510,9 +515,6 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) -tclKitInit.$(OBJEXT): tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_KIT @DEPARG@ $(CC_OBJNAME) - # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -762,8 +764,9 @@ cleanhelp: clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) + $(RM) $(TCLSH) $(CAT32) $(TCLKIT) null.zip $(RM) *.pch *.ilk *.pdb + $(RMDIR) tclkit.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ diff --git a/win/tclKitInit.c b/win/tclKitInit.c index 69a298c..9531ab5 100644 --- a/win/tclKitInit.c +++ b/win/tclKitInit.c @@ -1,324 +1,325 @@ -/* - * tclAppInit.c -- - * - * Provides a default version of the main program and TclKit_AppInit - * procedure for tclsh and other Tcl-based applications (without Tk). - * Note that this program must be built in Win32 console mode to work - * properly. - * - * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. - * Copyright (c) 1998-1999 Scriptics Corporation. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include "tcl.h" -#define WIN32_LEAN_AND_MEAN -#include -#undef WIN32_LEAN_AND_MEAN -#include -#include -#include - -extern Tcl_PackageInitProc Registry_Init; -extern Tcl_PackageInitProc Dde_Init; -extern Tcl_PackageInitProc Dde_SafeInit; - -#ifdef TCL_BROKEN_MAINARGS -int _CRT_glob = 0; -static void setargv(int *argcPtr, TCHAR ***argvPtr); -#endif /* TCL_BROKEN_MAINARGS */ - -/* - * The following #if block allows you to change the AppInit function by using - * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The - * #if checks for that #define and uses TclKit_AppInit if it does not exist. - */ -#define TCLKIT_INIT "main.tcl" -#define TCLKIT_VFSMOUNT "/zvfs" -#ifndef TCL_LOCAL_APPINIT -#define TCL_LOCAL_APPINIT TclKit_AppInit -#endif -#ifndef MODULE_SCOPE -# define MODULE_SCOPE extern -#endif -MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); - -/* - * The following #if block allows you to change how Tcl finds the startup - * script, prime the library or encoding paths, fiddle with the argv, etc., - * without needing to rewrite Tcl_Main() - */ - -#ifdef TCL_LOCAL_MAIN_HOOK -MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); -#endif - -/* - *---------------------------------------------------------------------- - * - * main -- - * - * This is the main program for the application. - * - * Results: - * None: Tcl_Main never returns here, so this procedure never returns - * either. - * - * Side effects: - * Just about anything, since from here we call arbitrary Tcl code. - * - *---------------------------------------------------------------------- - */ - -#ifdef TCL_BROKEN_MAINARGS -int -main( - int argc, /* Number of command-line arguments. */ - char *dummy[]) /* Not used. */ -{ - TCHAR **argv; -#else -int -_tmain( - int argc, /* Number of command-line arguments. */ - TCHAR *argv[]) /* Values of command-line arguments. */ -{ -#endif - TCHAR *p; - - /* - * Set up the default locale to be standard "C" locale so parsing is - * performed correctly. - */ - - setlocale(LC_ALL, "C"); - -#ifdef TCL_BROKEN_MAINARGS - /* - * Get our args from the c-runtime. Ignore command line. - */ - - setargv(&argc, &argv); -#endif - - /* - * Forward slashes substituted for backslashes. - */ - - for (p = argv[0]; *p != '\0'; p++) { - if (*p == '\\') { - *p = '/'; - } - } - -#ifdef TCL_LOCAL_MAIN_HOOK - TCL_LOCAL_MAIN_HOOK(&argc, &argv); -#endif - /* This voodoo ensures that Tcl_Main does not eat the first argument */ - Tcl_FindExecutable(argv[0]); - Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL); - Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); - return 0; /* Needed only to prevent compiler warning. */ -} - -/* - *---------------------------------------------------------------------- - * - * TclKit_AppInit -- - * - * This procedure performs application-specific initialization. Most - * applications, especially those that incorporate additional packages, - * will have their own version of this procedure. - * - * Results: - * Returns a standard Tcl completion code, and leaves an error message in - * the interp's result if an error occurs. - * - * Side effects: - * Depends on the startup script. - * - *---------------------------------------------------------------------- - */ - -int -TclKit_AppInit( - Tcl_Interp *interp) /* Interpreter for application. */ -{ - Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT); - if ((Tcl_Init)(interp) == TCL_ERROR) { - return TCL_ERROR; - } - - if (Registry_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); - - if (Dde_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); - - /* - * Call the init procedures for included packages. Each call should look - * like this: - * - * if (Mod_Init(interp) == TCL_ERROR) { - * return TCL_ERROR; - * } - * - * where "Mod" is the name of the module. (Dynamically-loadable packages - * should have the same entry-point name.) - */ - - /* - * Call Tcl_CreateCommand for application-specific commands, if they - * weren't already created by the init procedures called above. - */ - - /* - * Specify a user-specific startup file to invoke if the application is - * run interactively. Typically the startup file is "~/.apprc" where "app" - * is the name of the application. If this line is deleted then no - * user-specific startup file will be run under any conditions. - */ - - (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, - Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * setargv -- - * - * Parse the Windows command line string into argc/argv. Done here - * because we don't trust the builtin argument parser in crt0. Windows - * applications are responsible for breaking their command line into - * arguments. - * - * 2N backslashes + quote -> N backslashes + begin quoted string - * 2N + 1 backslashes + quote -> literal - * N backslashes + non-quote -> literal - * quote + quote in a quoted string -> single quote - * quote + quote not in quoted string -> empty string - * quote -> begin quoted string - * - * Results: - * Fills argcPtr with the number of arguments and argvPtr with the array - * of arguments. - * - * Side effects: - * Memory allocated. - * - *-------------------------------------------------------------------------- - */ - -#ifdef TCL_BROKEN_MAINARGS -static void -setargv( - int *argcPtr, /* Filled with number of argument strings. */ - TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ -{ - TCHAR *cmdLine, *p, *arg, *argSpace; - TCHAR **argv; - int argc, size, inquote, copy, slashes; - - cmdLine = GetCommandLine(); - - /* - * Precompute an overly pessimistic guess at the number of arguments in - * the command line by counting non-space spans. - */ - - size = 2; - for (p = cmdLine; *p != '\0'; p++) { - if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ - size++; - while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ - p++; - } - if (*p == '\0') { - break; - } - } - } - - /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ - #undef Tcl_Alloc - #undef Tcl_DbCkalloc - - argSpace = ckalloc(size * sizeof(char *) - + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); - argv = (TCHAR **) argSpace; - argSpace += size * (sizeof(char *)/sizeof(TCHAR)); - size--; - - p = cmdLine; - for (argc = 0; argc < size; argc++) { - argv[argc] = arg = argSpace; - while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ - p++; - } - if (*p == '\0') { - break; - } - - inquote = 0; - slashes = 0; - while (1) { - copy = 1; - while (*p == '\\') { - slashes++; - p++; - } - if (*p == '"') { - if ((slashes & 1) == 0) { - copy = 0; - if ((inquote) && (p[1] == '"')) { - p++; - copy = 1; - } else { - inquote = !inquote; - } - } - slashes >>= 1; - } - - while (slashes) { - *arg = '\\'; - arg++; - slashes--; - } - - if ((*p == '\0') || (!inquote && - ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ - break; - } - if (copy != 0) { - *arg = *p; - arg++; - } - p++; - } - *arg = '\0'; - argSpace = arg + 1; - } - argv[argc] = NULL; - - *argcPtr = argc; - *argvPtr = argv; -} -#endif /* TCL_BROKEN_MAINARGS */ - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ +/* + * tclAppInit.c -- + * + * Provides a default version of the main program and TclKit_AppInit + * procedure for tclsh and other Tcl-based applications (without Tk). + * Note that this program must be built in Win32 console mode to work + * properly. + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclWinInt.h" + +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN +#include +#include +#include + +extern Tcl_PackageInitProc Registry_Init; +extern Tcl_PackageInitProc Dde_Init; +extern Tcl_PackageInitProc Dde_SafeInit; + +#ifdef TCL_BROKEN_MAINARGS +int _CRT_glob = 0; +static void setargv(int *argcPtr, TCHAR ***argvPtr); +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * The following #if block allows you to change the AppInit function by using + * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The + * #if checks for that #define and uses TclKit_AppInit if it does not exist. + */ +#define TCLKIT_INIT "main.tcl" +#define TCLKIT_VFSMOUNT "/zvfs" +#ifndef TCL_LOCAL_APPINIT +#define TCL_LOCAL_APPINIT TclKit_AppInit +#endif +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); + +/* + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, etc., + * without needing to rewrite Tcl_Main() + */ + +#ifdef TCL_LOCAL_MAIN_HOOK +MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); +#endif + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tcl_Main never returns here, so this procedure never returns + * either. + * + * Side effects: + * Just about anything, since from here we call arbitrary Tcl code. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +int +main( + int argc, /* Number of command-line arguments. */ + char *dummy[]) /* Not used. */ +{ + TCHAR **argv; +#else +int +_tmain( + int argc, /* Number of command-line arguments. */ + TCHAR *argv[]) /* Values of command-line arguments. */ +{ +#endif + TCHAR *p; + + /* + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. + */ + + setlocale(LC_ALL, "C"); + +#ifdef TCL_BROKEN_MAINARGS + /* + * Get our args from the c-runtime. Ignore command line. + */ + + setargv(&argc, &argv); +#endif + + /* + * Forward slashes substituted for backslashes. + */ + + for (p = argv[0]; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + +#ifdef TCL_LOCAL_MAIN_HOOK + TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#endif + /* This voodoo ensures that Tcl_Main does not eat the first argument */ + Tcl_FindExecutable(argv[0]); + Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL); + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * TclKit_AppInit -- + * + * This procedure performs application-specific initialization. Most + * applications, especially those that incorporate additional packages, + * will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +TclKit_AppInit( + Tcl_Interp *interp) /* Interpreter for application. */ +{ + Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT); + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; + } + +// if (Registry_Init(interp) == TCL_ERROR) { +// return TCL_ERROR; +// } +// Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); +// +// if (Dde_Init(interp) == TCL_ERROR) { +// return TCL_ERROR; +// } +// Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); + + /* + * Call the init procedures for included packages. Each call should look + * like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. (Dynamically-loadable packages + * should have the same entry-point name.) + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if they + * weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application is + * run interactively. Typically the startup file is "~/.apprc" where "app" + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. + */ + + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * setargv -- + * + * Parse the Windows command line string into argc/argv. Done here + * because we don't trust the builtin argument parser in crt0. Windows + * applications are responsible for breaking their command line into + * arguments. + * + * 2N backslashes + quote -> N backslashes + begin quoted string + * 2N + 1 backslashes + quote -> literal + * N backslashes + non-quote -> literal + * quote + quote in a quoted string -> single quote + * quote + quote not in quoted string -> empty string + * quote -> begin quoted string + * + * Results: + * Fills argcPtr with the number of arguments and argvPtr with the array + * of arguments. + * + * Side effects: + * Memory allocated. + * + *-------------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +static void +setargv( + int *argcPtr, /* Filled with number of argument strings. */ + TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ +{ + TCHAR *cmdLine, *p, *arg, *argSpace; + TCHAR **argv; + int argc, size, inquote, copy, slashes; + + cmdLine = GetCommandLine(); + + /* + * Precompute an overly pessimistic guess at the number of arguments in + * the command line by counting non-space spans. + */ + + size = 2; + for (p = cmdLine; *p != '\0'; p++) { + if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + size++; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + } + } + + /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + #undef Tcl_Alloc + #undef Tcl_DbCkalloc + + argSpace = ckalloc(size * sizeof(char *) + + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); + argv = (TCHAR **) argSpace; + argSpace += size * (sizeof(char *)/sizeof(TCHAR)); + size--; + + p = cmdLine; + for (argc = 0; argc < size; argc++) { + argv[argc] = arg = argSpace; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + + inquote = 0; + slashes = 0; + while (1) { + copy = 1; + while (*p == '\\') { + slashes++; + p++; + } + if (*p == '"') { + if ((slashes & 1) == 0) { + copy = 0; + if ((inquote) && (p[1] == '"')) { + p++; + copy = 1; + } else { + inquote = !inquote; + } + } + slashes >>= 1; + } + + while (slashes) { + *arg = '\\'; + arg++; + slashes--; + } + + if ((*p == '\0') || (!inquote && + ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ + break; + } + if (copy != 0) { + *arg = *p; + arg++; + } + p++; + } + *arg = '\0'; + argSpace = arg + 1; + } + argv[argc] = NULL; + + *argcPtr = argc; + *argvPtr = argv; +} +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ -- cgit v0.12 From 4e331e27f8b8efdb66a423a5a35d7f522508777f Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Sep 2014 06:54:36 +0000 Subject: Added the tclkit binaries to install --- unix/Makefile.in | 4 +++- win/Makefile.in | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 30e7109..95a9bff 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -621,7 +621,7 @@ VFS_INSTALL_DIR=${PWD}/tclkit.vfs/tcl8.6 all: binaries libraries doc packages -binaries: ${LIB_FILE} ${TCL_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} ${TCLKIT_EXE} libraries: @@ -831,6 +831,8 @@ install-binaries: binaries @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" + @echo "Installing ${TCLKIT_EXE} as $(BIN_INSTALL_DIR)/tclkit$(VERSION)${EXE_SUFFIX}" + @$(INSTALL_PROGRAM) ${TCLKIT_EXE} "$(BIN_INSTALL_DIR)/tclkit$(VERSION)${EXE_SUFFIX}" @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/" diff --git a/win/Makefile.in b/win/Makefile.in index ec824cc..6fdbacf 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -421,7 +421,7 @@ all: binaries libraries doc packages tcltest: $(TCLSH) $(TEST_DLL_FILE) -binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) $(TCLKIT) libraries: @@ -599,7 +599,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \ + @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH) $(TCLKIT); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ -- cgit v0.12 From 9f12483ed2ebaafdba526e66348417fc76ab4692 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Sep 2014 07:55:45 +0000 Subject: Instead of statically compiling the Tclkit executable straight from .o files, generate a static library (libtclkit.a), and compile against that. --- unix/Makefile.in | 26 +- unix/configure | 20821 +++++++++++++++------------------------------------- unix/configure.in | 5 + unix/tcl.m4 | 10 + 4 files changed, 6086 insertions(+), 14776 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 95a9bff..7d9b82d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -168,6 +168,7 @@ INSTALL_DATA_DIR = ${INSTALL} -d -m 755 EXE_SUFFIX = @EXEEXT@ TCL_EXE = tclsh${EXE_SUFFIX} TCLKIT_EXE = tclkit${EXE_SUFFIX} +TCLKIT_LIB = tclkit${EXE_SUFFIX} TCLTEST_EXE = tcltest${EXE_SUFFIX} NATIVE_TCLSH = @TCLSH_PROG@ @@ -203,6 +204,9 @@ BUILD_DLTEST = @BUILD_DLTEST@ TCL_LIB_FILE = @TCL_LIB_FILE@ #TCL_LIB_FILE = libtcl.a +TCL_KIT_LIB_FILE = @TCL_KIT_LIB_FILE@ +#TCL_KIT_LIB_FILE = libtclkit.a + # Generic lib name used in rules that apply to tcl and tk LIB_FILE = ${TCL_LIB_FILE} @@ -640,6 +644,17 @@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} rm -f $@ @MAKE_STUB_LIB@ + +${TCL_KIT_LIB_FILE}: ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} + rm -f $@ + @MAKE_KIT_LIB@ + + #${SHLIB_LD} $@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} ; ${RANLIB} $@ + #${CC} ${CFLAGS} ${LDFLAGS} \ + # ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} \ + # ${CC_SEARCH_FLAGS} -o ${TCL_KIT_LIB_FILE} + + # Make target which outputs the list of the .o contained in the Tcl lib useful # to build a single big shared library containing Tcl and other extensions. # Used for the Tcl Plugin. -- dl @@ -668,11 +683,12 @@ tclkit.vfs: make install-libraries DESTDIR=tclkit.vfs make install-tzdata DESTDIR=tclkit.vfs make install-packages DESTDIR=tclkit.vfs - + # Assemble all of the tcl sources into a single executable -${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs +${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_KIT_LIB_FILE} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLKIT_OBJS} ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} \ + ${TCLKIT_OBJS} \ + @TCL_BUILD_LIB_SPEC@ ${TCL_KIT_LIB_FILE} \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} @@ -842,6 +858,10 @@ install-binaries: binaries echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi + @if test "$(TCL_KIT_LIB_FILE)" != "" ; then \ + echo "Installing $(TCL_KIT_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ + @INSTALL_KIT_LIB@ ; \ + fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig diff --git a/unix/configure b/unix/configure index a82c692..2740498 100755 --- a/unix/configure +++ b/unix/configure @@ -1,81 +1,459 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59 for tcl 8.6. +# Generated by GNU Autoconf 2.69 for tcl 8.6. +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# # -# Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. -## --------------------- ## -## M4sh Initialization. ## -## --------------------- ## +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## -# Be Bourne compatible -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' -elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then - set -o posix + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac fi -DUALCASE=1; export DUALCASE # for MKS sh -# Support unset when possible. -if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - as_unset=unset -else - as_unset=false + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' fi +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS -# Work around bugs in pre-3.0 UWIN ksh. -$as_unset ENV MAIL MAILPATH + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." else - $as_unset $as_var + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." fi -done + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error -# Required to use basename. -if expr a : '\(a\)' >/dev/null 2>&1; then +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi -if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi -# Name of the executable. -as_me=`$as_basename "$0" || +as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)$' \| \ - . : '\(.\)' 2>/dev/null || -echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } - /^X\/\(\/\/\)$/{ s//\1/; q; } - /^X\/\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` -# PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -83,146 +461,91 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh -fi - - - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" || { - # Find who we are. Look in the path if we contain no path at all - # relative or not. - case $0 in - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break -done - - ;; - esac - # We did not find ourselves, most probably we were run as `sh COMMAND' - # in which case we are not to be found in the path. - if test "x$as_myself" = x; then - as_myself=$0 - fi - if test ! -f "$as_myself"; then - { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 - { (exit 1); exit 1; }; } - fi - case $CONFIG_SHELL in - '') - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for as_base in sh bash ksh sh5; do - case $as_dir in - /*) - if ("$as_dir/$as_base" -c ' - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then - $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } - $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } - CONFIG_SHELL=$as_dir/$as_base - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$0" ${1+"$@"} - fi;; - esac - done -done -;; - esac - # Create $as_me.lineno as a copy of $as_myself, but with $LINENO - # uniformly replaced by the line number. The first 'sed' inserts a - # line-number line before each line; the second 'sed' does the real - # work. The second script uses 'N' to pair each line-number line - # with the numbered line, and appends trailing '-' during - # substitution so that $LINENO is not a special case at line end. - # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the - # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) - sed '=' <$as_myself | + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno N - s,$,-, - : loop - s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop - s,-$,, - s,^['$as_cr_digits']*\n,, + s/-\n.*// ' >$as_me.lineno && - chmod +x $as_me.lineno || - { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 - { (exit 1); exit 1; }; } + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensible to this). - . ./$as_me.lineno + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" # Exit status is that of the last command. exit } - -case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in - *c*,-n*) ECHO_N= ECHO_C=' -' ECHO_T=' ' ;; - *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; - *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; esac -if expr a : '\(a\)' >/dev/null 2>&1; then - as_expr=expr +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file else - as_expr=false + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null fi - -rm -f conf$$ conf$$.exe conf$$.file -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - # We could just check for DJGPP; but this test a) works b) is more generic - # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). - if test -f conf$$.exe; then - # Don't use ln at all; we don't have any links - as_ln_s='cp -p' - else +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' fi -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln else - as_ln_s='cp -p' + as_ln_s='cp -pR' fi -rm -f conf$$ conf$$.exe conf$$.file +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then - as_mkdir_p=: + as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi -as_executable_p="test -f" +as_test_x='test -x' +as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -231,38 +554,25 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" -# IFS -# We need space, tab and new line, in precisely that order. -as_nl=' -' -IFS=" $as_nl" - -# CDPATH. -$as_unset CDPATH - +test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. -# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` -exec 6>&1 - # # Initializations. # ac_default_prefix=/usr/local +ac_clean_files= ac_config_libobj_dir=. +LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= -SHELL=${CONFIG_SHELL-/bin/sh} - -# Maximum number of lines to put in a shell here document. -# This variable seems obsolete. It should probably be removed, and -# only ac_max_sed_lines should be used. -: ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='tcl' @@ -270,50 +580,215 @@ PACKAGE_TARNAME='tcl' PACKAGE_VERSION='8.6' PACKAGE_STRING='tcl 8.6' PACKAGE_BUGREPORT='' +PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ #include -#if HAVE_SYS_TYPES_H +#ifdef HAVE_SYS_TYPES_H # include #endif -#if HAVE_SYS_STAT_H +#ifdef HAVE_SYS_STAT_H # include #endif -#if STDC_HEADERS +#ifdef STDC_HEADERS # include # include #else -# if HAVE_STDLIB_H +# ifdef HAVE_STDLIB_H # include # endif #endif -#if HAVE_STRING_H -# if !STDC_HEADERS && HAVE_MEMORY_H +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H # include # endif # include #endif -#if HAVE_STRINGS_H +#ifdef HAVE_STRINGS_H # include #endif -#if HAVE_INTTYPES_H +#ifdef HAVE_INTTYPES_H # include -#else -# if HAVE_STDINT_H -# include -# endif #endif -#if HAVE_UNISTD_H +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H # include #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' +ac_subst_vars='DLTEST_SUFFIX +DLTEST_LD +EXTRA_TCLSH_LIBS +EXTRA_BUILD_HTML +EXTRA_INSTALL_BINARIES +EXTRA_INSTALL +EXTRA_APP_CC_SWITCHES +EXTRA_CC_SWITCHES +PACKAGE_DIR +HTML_DIR +PRIVATE_INCLUDE_DIR +TCL_LIBRARY +TCL_MODULE_PATH +TCL_PACKAGE_PATH +BUILD_DLTEST +MAKEFILE_SHELL +DTRACE_OBJ +DTRACE_HDR +DTRACE_SRC +INSTALL_TZDATA +TCL_HAS_LONGLONG +TCL_UNSHARED_LIB_SUFFIX +TCL_SHARED_LIB_SUFFIX +TCL_LIB_VERSIONS_OK +TCL_BUILD_LIB_SPEC +LD_LIBRARY_PATH_VAR +TCL_SHARED_BUILD +CFG_TCL_UNSHARED_LIB_SUFFIX +CFG_TCL_SHARED_LIB_SUFFIX +TCL_SRC_DIR +TCL_BUILD_STUB_LIB_PATH +TCL_BUILD_STUB_LIB_SPEC +TCL_INCLUDE_SPEC +TCL_KIT_LIB_FILE +TCL_STUB_LIB_PATH +TCL_STUB_LIB_SPEC +TCL_STUB_LIB_FLAG +TCL_STUB_LIB_FILE +TCL_LIB_SPEC +TCL_LIB_FLAG +TCL_LIB_FILE +PKG_CFG_ARGS +TCL_YEAR +TCL_PATCH_LEVEL +TCL_MINOR_VERSION +TCL_MAJOR_VERSION +TCL_VERSION +DTRACE +LDFLAGS_DEFAULT +CFLAGS_DEFAULT +INSTALL_KIT_LIB +INSTALL_STUB_LIB +DLL_INSTALL_DIR +INSTALL_LIB +MAKE_STUB_LIB +MAKE_KIT_LIB +MAKE_LIB +SHLIB_SUFFIX +SHLIB_CFLAGS +SHLIB_LD_LIBS +TK_SHLIB_LD_EXTRAS +TCL_SHLIB_LD_EXTRAS +SHLIB_LD +STLIB_LD +LD_SEARCH_FLAGS +CC_SEARCH_FLAGS +LDFLAGS_OPTIMIZE +LDFLAGS_DEBUG +CFLAGS_WARNING +CFLAGS_OPTIMIZE +CFLAGS_DEBUG +LDAIX_SRC +PLAT_SRCS +PLAT_OBJS +DL_OBJS +DL_LIBS +TCL_LIBS +LIBOBJS +AR +RANLIB +ZLIB_INCLUDE +ZLIB_SRCS +ZLIB_OBJS +TCLSH_PROG +TCL_THREADS +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +MAN_FLAGS +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_man_symlinks +enable_man_compression +enable_man_suffix +enable_threads +with_encoding +enable_shared +enable_64bit +enable_64bit_vis +enable_rpath +enable_corefoundation +enable_load +enable_symbols +enable_langinfo +enable_dll_unloading +with_tzdata +enable_dtrace +enable_framework +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + # Initialize some variables set by options. ac_init_help= ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null @@ -336,34 +811,49 @@ x_libraries=NONE # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' -datadir='${prefix}/share' +datarootdir='${prefix}/share' +datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' -libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' -infodir='${prefix}/info' -mandir='${prefix}/man' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' ac_prev= +ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then - eval "$ac_prev=\$ac_option" + eval $ac_prev=\$ac_option ac_prev= continue fi - ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac # Accept the important Cygnus configure options, so we can diagnose typos. - case $ac_option in + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; @@ -385,33 +875,59 @@ do --config-cache | -C) cache_file=config.cache ;; - -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ - | --da=*) + -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + -disable-* | --disable-*) - ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid feature name: $ac_feature" >&2 - { (exit 1); exit 1; }; } - ac_feature=`echo $ac_feature | sed 's/-/_/g'` - eval "enable_$ac_feature=no" ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; -enable-* | --enable-*) - ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid feature name: $ac_feature" >&2 - { (exit 1); exit 1; }; } - ac_feature=`echo $ac_feature | sed 's/-/_/g'` - case $ac_option in - *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; - *) ac_optarg=yes ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; esac - eval "enable_$ac_feature='$ac_optarg'" ;; + eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -438,6 +954,12 @@ do -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; @@ -462,13 +984,16 @@ do | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst \ - | --locals | --local | --loca | --loc | --lo) + | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* \ - | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) @@ -533,6 +1058,16 @@ do | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; @@ -583,26 +1118,36 @@ do ac_init_version=: ;; -with-* | --with-*) - ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid package name: $ac_package" >&2 - { (exit 1); exit 1; }; } - ac_package=`echo $ac_package| sed 's/-/_/g'` - case $ac_option in - *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; - *) ac_optarg=yes ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; esac - eval "with_$ac_package='$ac_optarg'" ;; + eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) - ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid package name: $ac_package" >&2 - { (exit 1); exit 1; }; } - ac_package=`echo $ac_package | sed 's/-/_/g'` - eval "with_$ac_package=no" ;; + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. @@ -622,27 +1167,26 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) { echo "$as_me: error: unrecognized option: $ac_option -Try \`$0 --help' for more information." >&2 - { (exit 1); exit 1; }; } + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. - expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && - { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 - { (exit 1); exit 1; }; } - ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` - eval "$ac_envvar='$ac_optarg'" + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. - echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac @@ -650,31 +1194,36 @@ done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - { echo "$as_me: error: missing argument to $ac_option" >&2 - { (exit 1); exit 1; }; } + as_fn_error $? "missing argument to $ac_option" fi -# Be sure to have absolute paths. -for ac_var in exec_prefix prefix -do - eval ac_val=$`echo $ac_var` - case $ac_val in - [\\/$]* | ?:[\\/]* | NONE | '' ) ;; - *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 - { (exit 1); exit 1; }; };; +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac -done +fi -# Be sure to have absolute paths. -for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ - localstatedir libdir includedir oldincludedir infodir mandir +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir do - eval ac_val=$`echo $ac_var` + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. case $ac_val in - [\\/$]* | ?:[\\/]* ) ;; - *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 - { (exit 1); exit 1; }; };; + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' @@ -688,8 +1237,6 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe - echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. - If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -701,74 +1248,72 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes - # Try the directory containing this script, then its parent. - ac_confdir=`(dirname "$0") 2>/dev/null || -$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$0" : 'X\(//\)[^/]' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$0" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` srcdir=$ac_confdir - if test ! -r $srcdir/$ac_unique_file; then + if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi -if test ! -r $srcdir/$ac_unique_file; then - if test "$ac_srcdir_defaulted" = yes; then - { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 - { (exit 1); exit 1; }; } - else - { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 - { (exit 1); exit 1; }; } - fi -fi -(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || - { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 - { (exit 1); exit 1; }; } -srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` -ac_env_build_alias_set=${build_alias+set} -ac_env_build_alias_value=$build_alias -ac_cv_env_build_alias_set=${build_alias+set} -ac_cv_env_build_alias_value=$build_alias -ac_env_host_alias_set=${host_alias+set} -ac_env_host_alias_value=$host_alias -ac_cv_env_host_alias_set=${host_alias+set} -ac_cv_env_host_alias_value=$host_alias -ac_env_target_alias_set=${target_alias+set} -ac_env_target_alias_value=$target_alias -ac_cv_env_target_alias_set=${target_alias+set} -ac_cv_env_target_alias_value=$target_alias -ac_env_CC_set=${CC+set} -ac_env_CC_value=$CC -ac_cv_env_CC_set=${CC+set} -ac_cv_env_CC_value=$CC -ac_env_CFLAGS_set=${CFLAGS+set} -ac_env_CFLAGS_value=$CFLAGS -ac_cv_env_CFLAGS_set=${CFLAGS+set} -ac_cv_env_CFLAGS_value=$CFLAGS -ac_env_LDFLAGS_set=${LDFLAGS+set} -ac_env_LDFLAGS_value=$LDFLAGS -ac_cv_env_LDFLAGS_set=${LDFLAGS+set} -ac_cv_env_LDFLAGS_value=$LDFLAGS -ac_env_CPPFLAGS_set=${CPPFLAGS+set} -ac_env_CPPFLAGS_value=$CPPFLAGS -ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} -ac_cv_env_CPPFLAGS_value=$CPPFLAGS -ac_env_CPP_set=${CPP+set} -ac_env_CPP_value=$CPP -ac_cv_env_CPP_set=${CPP+set} -ac_cv_env_CPP_value=$CPP +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done # # Report the --help message. @@ -791,20 +1336,17 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking...' messages + -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] -_ACEOF - - cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] + [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] + [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify @@ -814,18 +1356,25 @@ for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --datadir=DIR read-only architecture-independent data [PREFIX/share] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --infodir=DIR info documentation [PREFIX/info] - --mandir=DIR man documentation [PREFIX/man] + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/tcl] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF @@ -839,6 +1388,7 @@ if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-man-symlinks use symlinks for the manpages (default: off) @@ -876,162 +1426,595 @@ Some influential environment variables: CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory - CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have - headers in a nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. +Report bugs to the package provider. _ACEOF +ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. - ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d $ac_dir || continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue ac_builddir=. -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix case $srcdir in - .) # No --srcdir option. We are building in place. + .) # We are building in place. ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; -esac - -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; -esac - - cd $ac_dir - # Check for guested configure; otherwise get Cygnus style configure. - if test -f $ac_srcdir/configure.gnu; then - echo - $SHELL $ac_srcdir/configure.gnu --help=recursive - elif test -f $ac_srcdir/configure; then - echo - $SHELL $ac_srcdir/configure --help=recursive - elif test -f $ac_srcdir/configure.ac || - test -f $ac_srcdir/configure.in; then - echo - $ac_configure --help +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive else - echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi - cd $ac_popdir + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } done fi -test -n "$ac_init_help" && exit 0 +test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.6 -generated by GNU Autoconf 2.59 +generated by GNU Autoconf 2.69 -Copyright (C) 2003 Free Software Foundation, Inc. +Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF - exit 0 + exit fi -exec 5>config.log -cat >&5 <<_ACEOF -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by tcl $as_me 8.6, which was -generated by GNU Autoconf 2.59. Invocation command line was - $ $0 $@ +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## -_ACEOF +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () { -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` +} # ac_fn_c_try_compile -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -hostinfo = `(hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -_ASUNAME + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - echo "PATH: $as_dir" -done +} # ac_fn_c_try_cpp -} >&5 +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func + +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES +# ------------------------------------------- +# Tests whether TYPE exists after having included INCLUDES, setting cache +# variable VAR accordingly. +ac_fn_c_check_type () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_type + +# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES +# ---------------------------------------------------- +# Tries to find if the field MEMBER exists in type AGGR, after including +# INCLUDES, setting cache variable VAR accordingly. +ac_fn_c_check_member () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 +$as_echo_n "checking for $2.$3... " >&6; } +if eval \${$4+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +int +main () +{ +static $2 ac_aggr; +if (ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$4=yes" +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +int +main () +{ +static $2 ac_aggr; +if (sizeof ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$4=yes" +else + eval "$4=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$4 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_member +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by tcl $as_me 8.6, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 cat >&5 <<_ACEOF @@ -1051,7 +2034,6 @@ _ACEOF ac_configure_args= ac_configure_args0= ac_configure_args1= -ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do @@ -1062,13 +2044,13 @@ do -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) - ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in - 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) - ac_configure_args1="$ac_configure_args1 '$ac_arg'" + as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else @@ -1084,104 +2066,115 @@ do -* ) ac_must_keep_next=true ;; esac fi - ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" - # Get rid of the leading space. - ac_sep=" " + as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done -$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } -$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. -# WARNING: Be sure not to use single quotes in there, as some shells, -# such as our DU 5.0 friend, will then `close' the trap. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo - cat <<\_ASBOX -## ---------------- ## + $as_echo "## ---------------- ## ## Cache variables. ## -## ---------------- ## -_ASBOX +## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, -{ +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done (set) 2>&1 | - case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in - *ac_space=\ *) + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) sed -n \ - "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" - ;; + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( *) - sed -n \ - "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; - esac; -} + esac | + sort +) echo - cat <<\_ASBOX -## ----------------- ## + $as_echo "## ----------------- ## ## Output variables. ## -## ----------------- ## -_ASBOX +## ----------------- ##" echo for ac_var in $ac_subst_vars do - eval ac_val=$`echo $ac_var` - echo "$ac_var='"'"'$ac_val'"'"'" + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then - cat <<\_ASBOX -## ------------- ## -## Output files. ## -## ------------- ## -_ASBOX + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" echo for ac_var in $ac_subst_files do - eval ac_val=$`echo $ac_var` - echo "$ac_var='"'"'$ac_val'"'"'" + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then - cat <<\_ASBOX -## ----------- ## + $as_echo "## ----------- ## ## confdefs.h. ## -## ----------- ## -_ASBOX +## ----------- ##" echo - sed "/^$/d" confdefs.h | sort + cat confdefs.h echo fi test "$ac_signal" != 0 && - echo "$as_me: caught signal $ac_signal" - echo "$as_me: exit $exit_status" + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" } >&5 - rm -f core *.core && - rm -rf conftest* confdefs* conf$$* $ac_clean_files && + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status - ' 0 +' 0 for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo >confdefs.h +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. @@ -1189,112 +2182,137 @@ cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF - cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + # Let the site file select an alternate cache file if it wants to. -# Prefer explicitly selected file to automatically selected ones. -if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" - fi +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site fi -for ac_site_file in $CONFIG_SITE; do - if test -r "$ac_site_file"; then - { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 -echo "$as_me: loading site script $ac_site_file" >&6;} +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then - # Some versions of bash will fail to source /dev/null (special - # files actually), so we avoid doing that. - if test -f "$cache_file"; then - { echo "$as_me:$LINENO: loading cache $cache_file" >&5 -echo "$as_me: loading cache $cache_file" >&6;} + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in - [\\/]* | ?:[\\/]* ) . $cache_file;; - *) . ./$cache_file;; + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; esac fi else - { echo "$as_me:$LINENO: creating cache $cache_file" >&5 -echo "$as_me: creating cache $cache_file" >&6;} + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false -for ac_var in `(set) 2>&1 | - sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do +for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set - eval ac_old_val="\$ac_cv_env_${ac_var}_value" - eval ac_new_val="\$ac_env_${ac_var}_value" + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) - { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 -echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then - { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 -echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 -echo "$as_me: former value: $ac_old_val" >&2;} - { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 -echo "$as_me: current value: $ac_new_val" >&2;} - ac_cache_corrupted=: + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) - ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. - *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then - { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 -echo "$as_me: error: changes in the environment can compromise the build" >&2;} - { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 -echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} - { (exit 1); exit 1; }; } + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' @@ -1307,31 +2325,6 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu - - - - - - - - - - - - - - - - - - - - - - - - - TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 @@ -1382,62 +2375,60 @@ TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ - echo "$as_me:$LINENO: checking whether to use symlinks for manpages" >&5 -echo $ECHO_N "checking whether to use symlinks for manpages... $ECHO_C" >&6 - # Check whether --enable-man-symlinks or --disable-man-symlinks was given. -if test "${enable_man_symlinks+set}" = set; then - enableval="$enable_man_symlinks" - test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use symlinks for manpages" >&5 +$as_echo_n "checking whether to use symlinks for manpages... " >&6; } + # Check whether --enable-man-symlinks was given. +if test "${enable_man_symlinks+set}" = set; then : + enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" else enableval="no" -fi; - echo "$as_me:$LINENO: result: $enableval" >&5 -echo "${ECHO_T}$enableval" >&6 - - echo "$as_me:$LINENO: checking whether to compress the manpages" >&5 -echo $ECHO_N "checking whether to compress the manpages... $ECHO_C" >&6 - # Check whether --enable-man-compression or --disable-man-compression was given. -if test "${enable_man_compression+set}" = set; then - enableval="$enable_man_compression" - case $enableval in - yes) { { echo "$as_me:$LINENO: error: missing argument to --enable-man-compression" >&5 -echo "$as_me: error: missing argument to --enable-man-compression" >&2;} - { (exit 1); exit 1; }; };; +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 +$as_echo "$enableval" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to compress the manpages" >&5 +$as_echo_n "checking whether to compress the manpages... " >&6; } + # Check whether --enable-man-compression was given. +if test "${enable_man_compression+set}" = set; then : + enableval=$enable_man_compression; case $enableval in + yes) as_fn_error $? "missing argument to --enable-man-compression" "$LINENO" 5;; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac else enableval="no" -fi; - echo "$as_me:$LINENO: result: $enableval" >&5 -echo "${ECHO_T}$enableval" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 +$as_echo "$enableval" >&6; } if test "$enableval" != "no"; then - echo "$as_me:$LINENO: checking for compressed file suffix" >&5 -echo $ECHO_N "checking for compressed file suffix... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for compressed file suffix" >&5 +$as_echo_n "checking for compressed file suffix... " >&6; } touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" - echo "$as_me:$LINENO: result: $Z" >&5 -echo "${ECHO_T}$Z" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $Z" >&5 +$as_echo "$Z" >&6; } fi - echo "$as_me:$LINENO: checking whether to add a package name suffix for the manpages" >&5 -echo $ECHO_N "checking whether to add a package name suffix for the manpages... $ECHO_C" >&6 - # Check whether --enable-man-suffix or --disable-man-suffix was given. -if test "${enable_man_suffix+set}" = set; then - enableval="$enable_man_suffix" - case $enableval in + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to add a package name suffix for the manpages" >&5 +$as_echo_n "checking whether to add a package name suffix for the manpages... " >&6; } + # Check whether --enable-man-suffix was given. +if test "${enable_man_suffix+set}" = set; then : + enableval=$enable_man_suffix; case $enableval in yes) enableval="tcl" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac else enableval="no" -fi; - echo "$as_me:$LINENO: result: $enableval" >&5 -echo "${ECHO_T}$enableval" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 +$as_echo "$enableval" >&6; } @@ -1460,10 +2451,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1473,35 +2464,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -1511,39 +2504,50 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - CC=$ac_ct_CC + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1553,77 +2557,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + + fi fi -if test -z "$ac_cv_prog_CC"; then - ac_ct_CC=$CC +if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_CC="cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done -done - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6 -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 -fi - - CC=$ac_ct_CC -else - CC="$ac_cv_prog_CC" -fi - -fi -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1634,18 +2598,19 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. @@ -1663,24 +2628,25 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then - for ac_prog in cl + for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1690,39 +2656,41 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$as_me:$LINENO: result: $CC" >&5 -echo "${ECHO_T}$CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC - for ac_prog in cl + for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -1732,66 +2700,78 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 -echo "${ECHO_T}$ac_ct_CC" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + test -n "$ac_ct_CC" && break done - CC=$ac_ct_CC + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi fi fi -test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH -See \`config.log' for more details." >&5 -echo "$as_me: error: no acceptable C compiler found in \$PATH -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. -echo "$as_me:$LINENO:" \ - "checking for C compiler version" >&5 -ac_compiler=`set X $ac_compile; echo $2` -{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 - (eval $ac_compiler --version &5) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } -{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 - (eval $ac_compiler -v &5) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } -{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 - (eval $ac_compiler -V &5) 2>&5 +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -1803,112 +2783,108 @@ main () } _ACEOF ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.exe b.out" +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. -echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 -echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 -ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` -if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 - (eval $ac_link_default) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; then - # Find the output, starting from the most likely. This scheme is -# not robust to junk in `.', hence go to wildcards (a.*) only as a last -# resort. - -# Be careful to initialize this variable, since it used to be cached. -# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. -ac_cv_exeext= -# b.out is created by i960 compilers. -for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) - ;; - conftest.$ac_ext ) - # This is the source file. + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - # FIXME: I believe we export ac_cv_exeext for Libtool, - # but it would be cool to find out if it's true. Does anybody - # maintain Libtool? --akim. - export ac_cv_exeext + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. break;; * ) break;; esac done +test "$ac_cv_exeext" = no && ac_cv_exeext= + else - echo "$as_me: failed program was:" >&5 + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { echo "$as_me:$LINENO: error: C compiler cannot create executables -See \`config.log' for more details." >&5 -echo "$as_me: error: C compiler cannot create executables -See \`config.log' for more details." >&2;} - { (exit 77); exit 77; }; } +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } fi - +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } ac_exeext=$ac_cv_exeext -echo "$as_me:$LINENO: result: $ac_file" >&5 -echo "${ECHO_T}$ac_file" >&6 - -# Check the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -echo "$as_me:$LINENO: checking whether the C compiler works" >&5 -echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 -# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 -# If not cross compiling, check that we can run a simple program. -if test "$cross_compiling" != yes; then - if { ac_try='./$ac_file' - { (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 - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { echo "$as_me:$LINENO: error: cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details." >&5 -echo "$as_me: error: cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } - fi - fi -fi -echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 -rm -f a.out a.exe conftest$ac_cv_exeext b.out +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save -# Check the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 -echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 -echo "$as_me:$LINENO: result: $cross_compiling" >&5 -echo "${ECHO_T}$cross_compiling" >&6 - -echo "$as_me:$LINENO: checking for suffix of executables" >&5 -echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; then + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with @@ -1916,38 +2892,90 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - export ac_cv_exeext break;; * ) break;; esac done else - { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details." >&5 -echo "$as_me: error: cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } fi - -rm -f conftest$ac_cv_exeext -echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 -echo "${ECHO_T}$ac_cv_exeext" >&6 +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT -echo "$as_me:$LINENO: checking for suffix of object files" >&5 -echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 -if test "${ac_cv_objext+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -1959,45 +2987,46 @@ main () } _ACEOF rm -f conftest.o conftest.obj -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; then - for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else - echo "$as_me: failed program was:" >&5 + $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile -See \`config.log' for more details." >&5 -echo "$as_me: error: cannot compute suffix of object files: cannot compile -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } fi - rm -f conftest.$ac_cv_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 -echo "${ECHO_T}$ac_cv_objext" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT -echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 -echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 -if test "${ac_cv_c_compiler_gnu+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -2011,55 +3040,34 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_compiler_gnu=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_compiler_gnu=no + ac_compiler_gnu=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi -echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 -echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 -GCC=`test $ac_compiler_gnu = yes && echo yes` +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS -CFLAGS="-g" -echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 -echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 -if test "${ac_cv_prog_cc_g+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 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -2070,39 +3078,49 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_g=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ -ac_cv_prog_cc_g=no + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag fi -echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 -echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then @@ -2118,23 +3136,18 @@ else CFLAGS= fi fi -echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 -echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 -if test "${ac_cv_prog_cc_stdc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 else - ac_cv_prog_cc_stdc=no + ac_cv_prog_cc_c89=no ac_save_CC=$CC -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include -#include -#include +struct stat; /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); @@ -2157,12 +3170,17 @@ static char *f (char * (*g) (char **, int), char **p, ...) /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std1 is added to get + as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std1. */ + that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; @@ -2177,205 +3195,37 @@ return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; return 0; } _ACEOF -# Don't try gcc -ansi; that turns off useful extensions and -# breaks some systems' header files. -# AIX -qlanglvl=ansi -# Ultrix and OSF/1 -std1 -# HP-UX 10.20 and later -Ae -# HP-UX older versions -Aa -D_HPUX_SOURCE -# SVR4 -Xc -D__EXTENSIONS__ -for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" - rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_prog_cc_stdc=$ac_arg -break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg fi -rm -f conftest.err conftest.$ac_objext +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break done -rm -f conftest.$ac_ext conftest.$ac_objext +rm -f conftest.$ac_ext CC=$ac_save_CC fi - -case "x$ac_cv_prog_cc_stdc" in - x|xno) - echo "$as_me:$LINENO: result: none needed" >&5 -echo "${ECHO_T}none needed" >&6 ;; +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; *) - echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 -echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 - CC="$CC $ac_cv_prog_cc_stdc" ;; + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; esac - -# Some people use a C++ compiler to compile C. Since we use `exit', -# in C++ we need to declare it. In case someone uses the same compiler -# for both compiling C and C++ we need to have the C++ compiler decide -# the declaration of exit, since it's the most demanding environment. -cat >conftest.$ac_ext <<_ACEOF -#ifndef __cplusplus - choke me -#endif -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - for ac_declaration in \ - '' \ - 'extern "C" void std::exit (int) throw (); using std::exit;' \ - 'extern "C" void std::exit (int); using std::exit;' \ - 'extern "C" void exit (int) throw ();' \ - 'extern "C" void exit (int);' \ - 'void exit (int);' -do - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_declaration -#include -int -main () -{ -exit (42); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - : -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -continue -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_declaration -int -main () -{ -exit (42); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if test "x$ac_cv_prog_cc_c89" != xno; then : fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -done -rm -f conftest* -if test -n "$ac_declaration"; then - echo '#ifdef __cplusplus' >>confdefs.h - echo $ac_declaration >>confdefs.h - echo '#endif' >>confdefs.h -fi - -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -2383,18 +3233,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -echo "$as_me:$LINENO: checking for inline" >&5 -echo $ECHO_N "checking for inline... $ECHO_C" >&6 -if test "${ac_cv_c_inline+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } +if ${ac_cv_c_inline+:} false; then : + $as_echo_n "(cached) " >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; @@ -2403,41 +3249,16 @@ $ac_kw foo_t foo () {return 0; } #endif _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_c_inline=$ac_kw; break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_inline=$ac_kw fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$ac_cv_c_inline" != no && break done fi -echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 -echo "${ECHO_T}$ac_cv_c_inline" >&6 - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 +$as_echo "$ac_cv_c_inline" >&6; } case $ac_cv_c_inline in inline | yes) ;; @@ -2469,15 +3290,15 @@ ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu -echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 -echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" @@ -2491,11 +3312,7 @@ do # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __STDC__ # include @@ -2504,78 +3321,34 @@ cat >>conftest.$ac_ext <<_ACEOF #endif Syntax error _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - : -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if ac_fn_c_try_cpp "$LINENO"; then : +else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext - # OK, works on sane cases. Now check whether non-existent headers + # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then +if ac_fn_c_try_cpp "$LINENO"; then : # Broken: success on invalid input. continue else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - # Passes both tests. ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext -if $ac_preproc_ok; then +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : break fi @@ -2587,8 +3360,8 @@ fi else ac_cv_prog_CPP=$CPP fi -echo "$as_me:$LINENO: result: $CPP" >&5 -echo "${ECHO_T}$CPP" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do @@ -2598,11 +3371,7 @@ do # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __STDC__ # include @@ -2611,85 +3380,40 @@ cat >>conftest.$ac_ext <<_ACEOF #endif Syntax error _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - : -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if ac_fn_c_try_cpp "$LINENO"; then : +else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext - # OK, works on sane cases. Now check whether non-existent headers + # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then +if ac_fn_c_try_cpp "$LINENO"; then : # Broken: success on invalid input. continue else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - # Passes both tests. ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext -if $ac_preproc_ok; then - : +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + else - { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." >&5 -echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." >&2;} - { (exit 1); exit 1; }; } + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -2699,31 +3423,142 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -echo "$as_me:$LINENO: checking for egrep" >&5 -echo $ECHO_N "checking for egrep... $ECHO_C" >&6 -if test "${ac_cv_prog_egrep+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 else - if echo a | (grep -E '(a|b)') >/dev/null 2>&1 - then ac_cv_prog_egrep='grep -E' - else ac_cv_prog_egrep='egrep' + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + fi -echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 -echo "${ECHO_T}$ac_cv_prog_egrep" >&6 - EGREP=$ac_cv_prog_egrep +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" -echo "$as_me:$LINENO: checking for ANSI C header files" >&5 -echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 -if test "${ac_cv_header_stdc+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include @@ -2738,51 +3573,23 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_header_stdc=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_header_stdc=no + ac_cv_header_stdc=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then - : + $EGREP "memchr" >/dev/null 2>&1; then : + else ac_cv_header_stdc=no fi @@ -2792,18 +3599,14 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then - : + $EGREP "free" >/dev/null 2>&1; then : + else ac_cv_header_stdc=no fi @@ -2813,16 +3616,13 @@ fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then + if test "$cross_compiling" = yes; then : : else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include +#include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) @@ -2842,109 +3642,39 @@ main () for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) - exit(2); - exit (0); + return 2; + return 0; } _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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 - : -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if ac_fn_c_try_run "$LINENO"; then : -( exit $ac_status ) -ac_cv_header_stdc=no +else + ac_cv_header_stdc=no fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi + fi fi -echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 -echo "${ECHO_T}$ac_cv_header_stdc" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } if test $ac_cv_header_stdc = yes; then -cat >>confdefs.h <<\_ACEOF -#define STDC_HEADERS 1 -_ACEOF +$as_echo "#define STDC_HEADERS 1" >>confdefs.h fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. - - - - - - - - - for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+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. */ -$ac_includes_default - -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - eval "$as_ac_Header=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_Header=no" -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -if test `eval echo '${'$as_ac_Header'}'` = yes; then +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -2953,17 +3683,13 @@ done - echo "$as_me:$LINENO: checking dirent.h" >&5 -echo $ECHO_N "checking dirent.h... $ECHO_C" >&6 -if test "${tcl_cv_dirent_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5 +$as_echo_n "checking dirent.h... " >&6; } +if ${tcl_cv_dirent_h+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include @@ -2993,1817 +3719,489 @@ closedir(d); 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_dirent_h=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_dirent_h=no + tcl_cv_dirent_h=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_dirent_h" >&5 -echo "${ECHO_T}$tcl_cv_dirent_h" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5 +$as_echo "$tcl_cv_dirent_h" >&6; } if test $tcl_cv_dirent_h = no; then -cat >>confdefs.h <<\_ACEOF -#define NO_DIRENT_H 1 -_ACEOF +$as_echo "#define NO_DIRENT_H 1" >>confdefs.h fi - if test "${ac_cv_header_float_h+set}" = set; then - echo "$as_me:$LINENO: checking for float.h" >&5 -echo $ECHO_N "checking for float.h... $ECHO_C" >&6 -if test "${ac_cv_header_float_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 -echo "${ECHO_T}$ac_cv_header_float_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking float.h usability" >&5 -echo $ECHO_N "checking float.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes + ac_fn_c_check_header_mongrel "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default" +if test "x$ac_cv_header_float_h" = xyes; then : + else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 +$as_echo "#define NO_FLOAT_H 1" >>confdefs.h -# Is the header present? -echo "$as_me:$LINENO: checking float.h presence" >&5 -echo $ECHO_N "checking float.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: float.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: float.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: float.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: float.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: float.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: float.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: float.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: float.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: float.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: float.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for float.h" >&5 -echo $ECHO_N "checking for float.h... $ECHO_C" >&6 -if test "${ac_cv_header_float_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_float_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 -echo "${ECHO_T}$ac_cv_header_float_h" >&6 + ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default" +if test "x$ac_cv_header_values_h" = xyes; then : -fi -if test $ac_cv_header_float_h = yes; then - : else -cat >>confdefs.h <<\_ACEOF -#define NO_FLOAT_H 1 -_ACEOF +$as_echo "#define NO_VALUES_H 1" >>confdefs.h fi - if test "${ac_cv_header_values_h+set}" = set; then - echo "$as_me:$LINENO: checking for values.h" >&5 -echo $ECHO_N "checking for values.h... $ECHO_C" >&6 -if test "${ac_cv_header_values_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 -echo "${ECHO_T}$ac_cv_header_values_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking values.h usability" >&5 -echo $ECHO_N "checking values.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + ac_fn_c_check_header_mongrel "$LINENO" "limits.h" "ac_cv_header_limits_h" "$ac_includes_default" +if test "x$ac_cv_header_limits_h" = xyes; then : -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 +$as_echo "#define HAVE_LIMITS_H 1" >>confdefs.h -# Is the header present? -echo "$as_me:$LINENO: checking values.h presence" >&5 -echo $ECHO_N "checking values.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - ac_header_preproc=no +$as_echo "#define NO_LIMITS_H 1" >>confdefs.h + fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: values.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: values.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: values.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: values.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: values.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: values.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: values.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: values.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: values.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: values.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for values.h" >&5 -echo $ECHO_N "checking for values.h... $ECHO_C" >&6 -if test "${ac_cv_header_values_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + + ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" +if test "x$ac_cv_header_stdlib_h" = xyes; then : + tcl_ok=1 else - ac_cv_header_values_h=$ac_header_preproc + tcl_ok=0 fi -echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 -echo "${ECHO_T}$ac_cv_header_values_h" >&6 -fi -if test $ac_cv_header_values_h = yes; then - : -else -cat >>confdefs.h <<\_ACEOF -#define NO_VALUES_H 1 + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + _ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtol" >/dev/null 2>&1; then : +else + tcl_ok=0 fi +rm -f conftest* - - if test "${ac_cv_header_limits_h+set}" = set; then - echo "$as_me:$LINENO: checking for limits.h" >&5 -echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 -if test "${ac_cv_header_limits_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 -echo "${ECHO_T}$ac_cv_header_limits_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking limits.h usability" >&5 -echo $ECHO_N "checking limits.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -$ac_includes_default -#include +#include + _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtoul" >/dev/null 2>&1; then : -ac_header_compiler=no +else + tcl_ok=0 fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 +rm -f conftest* -# Is the header present? -echo "$as_me:$LINENO: checking limits.h presence" >&5 -echo $ECHO_N "checking limits.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include +#include + _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtod" >/dev/null 2>&1; then : + else - ac_cpp_err=yes + tcl_ok=0 fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +rm -f conftest* - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 + if test $tcl_ok = 0; then -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: limits.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: limits.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: limits.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: limits.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: limits.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: limits.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: limits.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for limits.h" >&5 -echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 -if test "${ac_cv_header_limits_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +$as_echo "#define NO_STDLIB_H 1" >>confdefs.h + + fi + ac_fn_c_check_header_mongrel "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default" +if test "x$ac_cv_header_string_h" = xyes; then : + tcl_ok=1 else - ac_cv_header_limits_h=$ac_header_preproc + tcl_ok=0 fi -echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 -echo "${ECHO_T}$ac_cv_header_limits_h" >&6 -fi -if test $ac_cv_header_limits_h = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_LIMITS_H 1 + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + _ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strstr" >/dev/null 2>&1; then : else + tcl_ok=0 +fi +rm -f conftest* + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include -cat >>confdefs.h <<\_ACEOF -#define NO_LIMITS_H 1 _ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strerror" >/dev/null 2>&1; then : +else + tcl_ok=0 fi +rm -f conftest* - if test "${ac_cv_header_stdlib_h+set}" = set; then - echo "$as_me:$LINENO: checking for stdlib.h" >&5 -echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 -if test "${ac_cv_header_stdlib_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 -echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking stdlib.h usability" >&5 -echo $ECHO_N "checking stdlib.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + # See also memmove check below for a place where NO_STRING_H can be + # set and why. -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 + if test $tcl_ok = 0; then -# Is the header present? -echo "$as_me:$LINENO: checking stdlib.h presence" >&5 -echo $ECHO_N "checking stdlib.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +$as_echo "#define NO_STRING_H 1" >>confdefs.h - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 + fi -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: stdlib.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: stdlib.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: stdlib.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: stdlib.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: stdlib.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: stdlib.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: stdlib.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: stdlib.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: stdlib.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: stdlib.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for stdlib.h" >&5 -echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 -if test "${ac_cv_header_stdlib_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_stdlib_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 -echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 + ac_fn_c_check_header_mongrel "$LINENO" "sys/wait.h" "ac_cv_header_sys_wait_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_wait_h" = xyes; then : -fi -if test $ac_cv_header_stdlib_h = yes; then - tcl_ok=1 else - tcl_ok=0 + +$as_echo "#define NO_SYS_WAIT_H 1" >>confdefs.h + fi - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include + ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" +if test "x$ac_cv_header_dlfcn_h" = xyes; then : -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtol" >/dev/null 2>&1; then - : else - tcl_ok=0 -fi -rm -f conftest* - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include +$as_echo "#define NO_DLFCN_H 1" >>confdefs.h -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtoul" >/dev/null 2>&1; then - : -else - tcl_ok=0 fi -rm -f conftest* - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include + + # OS/390 lacks sys/param.h (and doesn't need it, by chance). + for ac_header in sys/param.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/param.h" "ac_cv_header_sys_param_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_param_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_PARAM_H 1 _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtod" >/dev/null 2>&1; then - : -else - tcl_ok=0 + fi -rm -f conftest* - if test $tcl_ok = 0; then +done -cat >>confdefs.h <<\_ACEOF -#define NO_STDLIB_H 1 -_ACEOF - fi - if test "${ac_cv_header_string_h+set}" = set; then - echo "$as_me:$LINENO: checking for string.h" >&5 -echo $ECHO_N "checking for string.h... $ECHO_C" >&6 -if test "${ac_cv_header_string_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 -echo "${ECHO_T}$ac_cv_header_string_h" >&6 + +#-------------------------------------------------------------------- +# Determines the correct executable file extension (.exe) +#-------------------------------------------------------------------- + + + +#------------------------------------------------------------------------ +# If we're using GCC, see if the compiler understands -pipe. If so, use it. +# It makes compiling go faster. (This is only a performance feature.) +#------------------------------------------------------------------------ + +if test -z "$no_pipe" && test -n "$GCC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5 +$as_echo_n "checking if the compiler understands -pipe... " >&6; } +if ${tcl_cv_cc_pipe+:} false; then : + $as_echo_n "(cached) " >&6 else - # Is the header compilable? -echo "$as_me:$LINENO: checking string.h usability" >&5 -echo $ECHO_N "checking string.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 +int +main () +{ -# Is the header present? -echo "$as_me:$LINENO: checking string.h presence" >&5 -echo $ECHO_N "checking string.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include + ; + return 0; +} _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_cc_pipe=yes else - ac_cpp_err=yes + tcl_cv_cc_pipe=no fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS=$hold_cflags fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: string.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: string.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: string.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: string.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: string.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: string.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: string.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: string.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: string.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: string.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for string.h" >&5 -echo $ECHO_N "checking for string.h... $ECHO_C" >&6 -if test "${ac_cv_header_string_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_string_h=$ac_header_preproc +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5 +$as_echo "$tcl_cv_cc_pipe" >&6; } + if test $tcl_cv_cc_pipe = yes; then + CFLAGS="$CFLAGS -pipe" + fi fi -echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 -echo "${ECHO_T}$ac_cv_header_string_h" >&6 -fi -if test $ac_cv_header_string_h = yes; then - tcl_ok=1 +#------------------------------------------------------------------------ +# Threads support +#------------------------------------------------------------------------ + + + # Check whether --enable-threads was given. +if test "${enable_threads+set}" = set; then : + enableval=$enable_threads; tcl_ok=$enableval else - tcl_ok=0 + tcl_ok=yes fi - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include + if test "${TCL_THREADS}" = 1; then + tcl_threaded_core=1; + fi -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strstr" >/dev/null 2>&1; then - : -else - tcl_ok=0 -fi -rm -f conftest* + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + TCL_THREADS=1 + # USE_THREAD_ALLOC tells us to try the special thread-based + # allocator that significantly reduces lock contention - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include +$as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strerror" >/dev/null 2>&1; then - : -else - tcl_ok=0 -fi -rm -f conftest* +$as_echo "#define _REENTRANT 1" >>confdefs.h - # See also memmove check below for a place where NO_STRING_H can be - # set and why. + if test "`uname -s`" = "SunOS" ; then - if test $tcl_ok = 0; then +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define NO_STRING_H 1 -_ACEOF + fi - fi +$as_echo "#define _THREAD_SAFE 1" >>confdefs.h - if test "${ac_cv_header_sys_wait_h+set}" = set; then - echo "$as_me:$LINENO: checking for sys/wait.h" >&5 -echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 -if test "${ac_cv_header_sys_wait_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 -echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5 +$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; } +if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 else - # Is the header compilable? -echo "$as_me:$LINENO: checking sys/wait.h usability" >&5 -echo $ECHO_N "checking sys/wait.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking sys/wait.h presence" >&5 -echo $ECHO_N "checking sys/wait.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread_pthread_mutex_init=yes else - ac_cpp_err=yes + ac_cv_lib_pthread_pthread_mutex_init=no fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: sys/wait.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: sys/wait.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: sys/wait.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/wait.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: sys/wait.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/wait.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: sys/wait.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for sys/wait.h" >&5 -echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 -if test "${ac_cv_header_sys_wait_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then : + tcl_ok=yes else - ac_cv_header_sys_wait_h=$ac_header_preproc + tcl_ok=no fi -echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 -echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 -fi -if test $ac_cv_header_sys_wait_h = yes; then - : + if test "$tcl_ok" = "no"; then + # Check a little harder for __pthread_mutex_init in the same + # library, as some systems hide it there until pthread.h is + # defined. We could alternatively do an AC_TRY_COMPILE with + # pthread.h, but that will work with libpthread really doesn't + # exist, like AIX 4.2. [Bug: 4359] + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5 +$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; } +if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ -cat >>confdefs.h <<\_ACEOF -#define NO_SYS_WAIT_H 1 +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char __pthread_mutex_init (); +int +main () +{ +return __pthread_mutex_init (); + ; + return 0; +} _ACEOF - -fi - - - if test "${ac_cv_header_dlfcn_h+set}" = set; then - echo "$as_me:$LINENO: checking for dlfcn.h" >&5 -echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 -if test "${ac_cv_header_dlfcn_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 -echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking dlfcn.h usability" >&5 -echo $ECHO_N "checking dlfcn.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking dlfcn.h presence" >&5 -echo $ECHO_N "checking dlfcn.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: dlfcn.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: dlfcn.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: dlfcn.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: dlfcn.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: dlfcn.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: dlfcn.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: dlfcn.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for dlfcn.h" >&5 -echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 -if test "${ac_cv_header_dlfcn_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_dlfcn_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 -echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 - -fi -if test $ac_cv_header_dlfcn_h = yes; then - : -else - -cat >>confdefs.h <<\_ACEOF -#define NO_DLFCN_H 1 -_ACEOF - -fi - - - - # OS/390 lacks sys/param.h (and doesn't need it, by chance). - -for ac_header in sys/param.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread___pthread_mutex_init=yes else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - + ac_cv_lib_pthread___pthread_mutex_init=no fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi - -done - - - -#-------------------------------------------------------------------- -# Determines the correct executable file extension (.exe) -#-------------------------------------------------------------------- - - - -#------------------------------------------------------------------------ -# If we're using GCC, see if the compiler understands -pipe. If so, use it. -# It makes compiling go faster. (This is only a performance feature.) -#------------------------------------------------------------------------ - -if test -z "$no_pipe" && test -n "$GCC"; then - echo "$as_me:$LINENO: checking if the compiler understands -pipe" >&5 -echo $ECHO_N "checking if the compiler understands -pipe... $ECHO_C" >&6 -if test "${tcl_cv_cc_pipe+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_cc_pipe=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then : + tcl_ok=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_pipe=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS=$hold_cflags -fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_pipe" >&5 -echo "${ECHO_T}$tcl_cv_cc_pipe" >&6 - if test $tcl_cv_cc_pipe = yes; then - CFLAGS="$CFLAGS -pipe" - fi + tcl_ok=no fi -#------------------------------------------------------------------------ -# Threads support -#------------------------------------------------------------------------ - - - # Check whether --enable-threads or --disable-threads was given. -if test "${enable_threads+set}" = set; then - enableval="$enable_threads" - tcl_ok=$enableval -else - tcl_ok=yes -fi; - - if test "${TCL_THREADS}" = 1; then - tcl_threaded_core=1; - fi - - if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then - TCL_THREADS=1 - # USE_THREAD_ALLOC tells us to try the special thread-based - # allocator that significantly reduces lock contention - -cat >>confdefs.h <<\_ACEOF -#define USE_THREAD_ALLOC 1 -_ACEOF - - -cat >>confdefs.h <<\_ACEOF -#define _REENTRANT 1 -_ACEOF - - if test "`uname -s`" = "SunOS" ; then - -cat >>confdefs.h <<\_ACEOF -#define _POSIX_PTHREAD_SEMANTICS 1 -_ACEOF - fi -cat >>confdefs.h <<\_ACEOF -#define _THREAD_SAFE 1 -_ACEOF - - echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthread" >&5 -echo $ECHO_N "checking for pthread_mutex_init in -lpthread... $ECHO_C" >&6 -if test "${ac_cv_lib_pthread_pthread_mutex_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthread" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5 +$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; } +if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthread $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +LIBS="-lpthreads $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { -pthread_mutex_init (); +return pthread_mutex_init (); ; 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 - ac_cv_lib_pthread_pthread_mutex_init=yes +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthreads_pthread_mutex_init=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_pthread_pthread_mutex_init=no + ac_cv_lib_pthreads_pthread_mutex_init=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 -echo "${ECHO_T}$ac_cv_lib_pthread_pthread_mutex_init" >&6 -if test $ac_cv_lib_pthread_pthread_mutex_init = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then : tcl_ok=yes else tcl_ok=no fi - if test "$tcl_ok" = "no"; then - # Check a little harder for __pthread_mutex_init in the same - # library, as some systems hide it there until pthread.h is - # defined. We could alternatively do an AC_TRY_COMPILE with - # pthread.h, but that will work with libpthread really doesn't - # exist, like AIX 4.2. [Bug: 4359] - echo "$as_me:$LINENO: checking for __pthread_mutex_init in -lpthread" >&5 -echo $ECHO_N "checking for __pthread_mutex_init in -lpthread... $ECHO_C" >&6 -if test "${ac_cv_lib_pthread___pthread_mutex_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthreads" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5 +$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; } +if ${ac_cv_lib_c_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthread $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +LIBS="-lc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char __pthread_mutex_init (); +char pthread_mutex_init (); int main () { -__pthread_mutex_init (); +return pthread_mutex_init (); ; 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 - ac_cv_lib_pthread___pthread_mutex_init=yes +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_pthread_mutex_init=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_pthread___pthread_mutex_init=no + ac_cv_lib_c_pthread_mutex_init=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 -echo "${ECHO_T}$ac_cv_lib_pthread___pthread_mutex_init" >&6 -if test $ac_cv_lib_pthread___pthread_mutex_init = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then : tcl_ok=yes else tcl_ok=no fi - fi - - if test "$tcl_ok" = "yes"; then - # The space is needed - THREADS_LIBS=" -lpthread" - else - echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5 -echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6 -if test "${ac_cv_lib_pthreads_pthread_mutex_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if test "$tcl_ok" = "no"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5 +$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; } +if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthreads $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +LIBS="-lc_r $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { -pthread_mutex_init (); +return pthread_mutex_init (); ; 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 - ac_cv_lib_pthreads_pthread_mutex_init=yes +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_r_pthread_mutex_init=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_pthreads_pthread_mutex_init=no + ac_cv_lib_c_r_pthread_mutex_init=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 -echo "${ECHO_T}$ac_cv_lib_pthreads_pthread_mutex_init" >&6 -if test $ac_cv_lib_pthreads_pthread_mutex_init = yes; then - tcl_ok=yes -else - tcl_ok=no -fi - - if test "$tcl_ok" = "yes"; then - # The space is needed - THREADS_LIBS=" -lpthreads" - else - echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc" >&5 -echo $ECHO_N "checking for pthread_mutex_init in -lc... $ECHO_C" >&6 -if test "${ac_cv_lib_c_pthread_mutex_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lc $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char pthread_mutex_init (); -int -main () -{ -pthread_mutex_init (); - ; - 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 - ac_cv_lib_c_pthread_mutex_init=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_c_pthread_mutex_init=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -echo "$as_me:$LINENO: result: $ac_cv_lib_c_pthread_mutex_init" >&5 -echo "${ECHO_T}$ac_cv_lib_c_pthread_mutex_init" >&6 -if test $ac_cv_lib_c_pthread_mutex_init = yes; then - tcl_ok=yes -else - tcl_ok=no -fi - - if test "$tcl_ok" = "no"; then - echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc_r" >&5 -echo $ECHO_N "checking for pthread_mutex_init in -lc_r... $ECHO_C" >&6 -if test "${ac_cv_lib_c_r_pthread_mutex_init+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lc_r $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char pthread_mutex_init (); -int -main () -{ -pthread_mutex_init (); - ; - 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 - ac_cv_lib_c_r_pthread_mutex_init=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_c_r_pthread_mutex_init=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -echo "$as_me:$LINENO: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 -echo "${ECHO_T}$ac_cv_lib_c_r_pthread_mutex_init" >&6 -if test $ac_cv_lib_c_r_pthread_mutex_init = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then : tcl_ok=yes else tcl_ok=no @@ -4814,8 +4212,8 @@ fi THREADS_LIBS=" -pthread" else TCL_THREADS=0 - { echo "$as_me:$LINENO: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 -echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 +$as_echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} fi fi fi @@ -4826,104 +4224,13 @@ echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you m ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" - - -for ac_func in pthread_attr_setstacksize pthread_atfork -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; - ; - 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 - eval "$as_ac_var=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then + for ac_func in pthread_attr_setstacksize pthread_atfork +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi @@ -4934,24 +4241,22 @@ done TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output - echo "$as_me:$LINENO: checking for building with threads" >&5 -echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5 +$as_echo_n "checking for building with threads... " >&6; } if test "${TCL_THREADS}" = 1; then -cat >>confdefs.h <<\_ACEOF -#define TCL_THREADS 1 -_ACEOF +$as_echo "#define TCL_THREADS 1" >>confdefs.h if test "${tcl_threaded_core}" = 1; then - echo "$as_me:$LINENO: result: yes (threaded core)" >&5 -echo "${ECHO_T}yes (threaded core)" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (threaded core)" >&5 +$as_echo "yes (threaded core)" >&6; } else - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } fi else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi @@ -4963,11 +4268,11 @@ echo "${ECHO_T}no" >&6 -# Check whether --with-encoding or --without-encoding was given. -if test "${with_encoding+set}" = set; then - withval="$with_encoding" - with_tcencoding=${withval} -fi; +# Check whether --with-encoding was given. +if test "${with_encoding+set}" = set; then : + withval=$with_encoding; with_tcencoding=${withval} +fi + if test x"${with_tcencoding}" != x ; then @@ -4977,9 +4282,7 @@ _ACEOF else -cat >>confdefs.h <<\_ACEOF -#define TCL_CFGVAL_ENCODING "iso8859-1" -_ACEOF +$as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h fi @@ -4996,161 +4299,44 @@ _ACEOF # right (and it must appear before "-lm"). #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking for sin" >&5 -echo $ECHO_N "checking for sin... $ECHO_C" >&6 -if test "${ac_cv_func_sin+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. */ -/* Define sin to an innocuous variant, in case declares sin. - For example, HP-UX 11i declares gettimeofday. */ -#define sin innocuous_sin - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char sin (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef sin - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char sin (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_sin) || defined (__stub___sin) -choke me -#else -char (*f) () = sin; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != sin; - ; - 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 - ac_cv_func_sin=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_sin=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_sin" >&5 -echo "${ECHO_T}$ac_cv_func_sin" >&6 -if test $ac_cv_func_sin = yes; then + ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin" +if test "x$ac_cv_func_sin" = xyes; then : MATH_LIBS="" else MATH_LIBS="-lm" fi - echo "$as_me:$LINENO: checking for main in -lieee" >&5 -echo $ECHO_N "checking for main in -lieee... $ECHO_C" >&6 -if test "${ac_cv_lib_ieee_main+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lieee" >&5 +$as_echo_n "checking for main in -lieee... " >&6; } +if ${ac_cv_lib_ieee_main+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lieee $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { -main (); +return main (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_ieee_main=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_ieee_main=no + ac_cv_lib_ieee_main=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_ieee_main" >&5 -echo "${ECHO_T}$ac_cv_lib_ieee_main" >&6 -if test $ac_cv_lib_ieee_main = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ieee_main" >&5 +$as_echo "$ac_cv_lib_ieee_main" >&6; } +if test "x$ac_cv_lib_ieee_main" = xyes; then : MATH_LIBS="-lieee $MATH_LIBS" fi @@ -5160,211 +4346,45 @@ fi # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking for main in -linet" >&5 -echo $ECHO_N "checking for main in -linet... $ECHO_C" >&6 -if test "${ac_cv_lib_inet_main+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5 +$as_echo_n "checking for main in -linet... " >&6; } +if ${ac_cv_lib_inet_main+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { -main (); +return main (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_inet_main=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_inet_main=no + ac_cv_lib_inet_main=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_inet_main" >&5 -echo "${ECHO_T}$ac_cv_lib_inet_main" >&6 -if test $ac_cv_lib_inet_main = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5 +$as_echo "$ac_cv_lib_inet_main" >&6; } +if test "x$ac_cv_lib_inet_main" = xyes; then : LIBS="$LIBS -linet" fi - if test "${ac_cv_header_net_errno_h+set}" = set; then - echo "$as_me:$LINENO: checking for net/errno.h" >&5 -echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 -if test "${ac_cv_header_net_errno_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 -echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking net/errno.h usability" >&5 -echo $ECHO_N "checking net/errno.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking net/errno.h presence" >&5 -echo $ECHO_N "checking net/errno.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: net/errno.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: net/errno.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: net/errno.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: net/errno.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: net/errno.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: net/errno.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: net/errno.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: net/errno.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: net/errno.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: net/errno.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for net/errno.h" >&5 -echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 -if test "${ac_cv_header_net_errno_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_net_errno_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 -echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 - -fi -if test $ac_cv_header_net_errno_h = yes; then + ac_fn_c_check_header_mongrel "$LINENO" "net/errno.h" "ac_cv_header_net_errno_h" "$ac_includes_default" +if test "x$ac_cv_header_net_errno_h" = xyes; then : -cat >>confdefs.h <<\_ACEOF -#define HAVE_NET_ERRNO_H 1 -_ACEOF +$as_echo "#define HAVE_NET_ERRNO_H 1" >>confdefs.h fi @@ -5389,264 +4409,58 @@ fi #-------------------------------------------------------------------- tcl_checkBoth=0 - echo "$as_me:$LINENO: checking for connect" >&5 -echo $ECHO_N "checking for connect... $ECHO_C" >&6 -if test "${ac_cv_func_connect+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" +if test "x$ac_cv_func_connect" = xyes; then : + tcl_checkSocket=0 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define connect to an innocuous variant, in case declares connect. - For example, HP-UX 11i declares gettimeofday. */ -#define connect innocuous_connect - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char connect (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ + tcl_checkSocket=1 +fi -#ifdef __STDC__ -# include -#else -# include -#endif + if test "$tcl_checkSocket" = 1; then + ac_fn_c_check_func "$LINENO" "setsockopt" "ac_cv_func_setsockopt" +if test "x$ac_cv_func_setsockopt" = xyes; then : -#undef connect +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5 +$as_echo_n "checking for setsockopt in -lsocket... " >&6; } +if ${ac_cv_lib_socket_setsockopt+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ -char connect (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_connect) || defined (__stub___connect) -choke me -#else -char (*f) () = connect; -#endif #ifdef __cplusplus -} +extern "C" #endif - +char setsockopt (); int main () { -return f != connect; +return setsockopt (); ; 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 - ac_cv_func_connect=yes +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_socket_setsockopt=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_connect=no + ac_cv_lib_socket_setsockopt=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5 -echo "${ECHO_T}$ac_cv_func_connect" >&6 -if test $ac_cv_func_connect = yes; then - tcl_checkSocket=0 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5 +$as_echo "$ac_cv_lib_socket_setsockopt" >&6; } +if test "x$ac_cv_lib_socket_setsockopt" = xyes; then : + LIBS="$LIBS -lsocket" else - tcl_checkSocket=1 -fi - - if test "$tcl_checkSocket" = 1; then - echo "$as_me:$LINENO: checking for setsockopt" >&5 -echo $ECHO_N "checking for setsockopt... $ECHO_C" >&6 -if test "${ac_cv_func_setsockopt+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. */ -/* Define setsockopt to an innocuous variant, in case declares setsockopt. - For example, HP-UX 11i declares gettimeofday. */ -#define setsockopt innocuous_setsockopt - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char setsockopt (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef setsockopt - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char setsockopt (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_setsockopt) || defined (__stub___setsockopt) -choke me -#else -char (*f) () = setsockopt; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != setsockopt; - ; - 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 - ac_cv_func_setsockopt=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_setsockopt=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_setsockopt" >&5 -echo "${ECHO_T}$ac_cv_func_setsockopt" >&6 -if test $ac_cv_func_setsockopt = yes; then - : -else - echo "$as_me:$LINENO: checking for setsockopt in -lsocket" >&5 -echo $ECHO_N "checking for setsockopt in -lsocket... $ECHO_C" >&6 -if test "${ac_cv_lib_socket_setsockopt+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lsocket $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char setsockopt (); -int -main () -{ -setsockopt (); - ; - 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 - ac_cv_lib_socket_setsockopt=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_socket_setsockopt=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -echo "$as_me:$LINENO: result: $ac_cv_lib_socket_setsockopt" >&5 -echo "${ECHO_T}$ac_cv_lib_socket_setsockopt" >&6 -if test $ac_cv_lib_socket_setsockopt = yes; then - LIBS="$LIBS -lsocket" -else - tcl_checkBoth=1 + tcl_checkBoth=1 fi fi @@ -5655,261 +4469,55 @@ fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" - echo "$as_me:$LINENO: checking for accept" >&5 -echo $ECHO_N "checking for accept... $ECHO_C" >&6 -if test "${ac_cv_func_accept+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. */ -/* Define accept to an innocuous variant, in case declares accept. - For example, HP-UX 11i declares gettimeofday. */ -#define accept innocuous_accept - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char accept (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef accept - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char accept (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_accept) || defined (__stub___accept) -choke me -#else -char (*f) () = accept; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != accept; - ; - 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 - ac_cv_func_accept=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_accept=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_accept" >&5 -echo "${ECHO_T}$ac_cv_func_accept" >&6 -if test $ac_cv_func_accept = yes; then + ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept" +if test "x$ac_cv_func_accept" = xyes; then : tcl_checkNsl=0 else LIBS=$tk_oldLibs fi fi - echo "$as_me:$LINENO: checking for gethostbyname" >&5 -echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6 -if test "${ac_cv_func_gethostbyname+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. */ -/* Define gethostbyname to an innocuous variant, in case declares gethostbyname. - For example, HP-UX 11i declares gettimeofday. */ -#define gethostbyname innocuous_gethostbyname - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char gethostbyname (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef gethostbyname - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char gethostbyname (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) -choke me -#else -char (*f) () = gethostbyname; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != gethostbyname; - ; - 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 - ac_cv_func_gethostbyname=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" +if test "x$ac_cv_func_gethostbyname" = xyes; then : -ac_cv_func_gethostbyname=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5 -echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6 -if test $ac_cv_func_gethostbyname = yes; then - : else - echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5 -echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6 -if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 +$as_echo_n "checking for gethostbyname in -lnsl... " >&6; } +if ${ac_cv_lib_nsl_gethostbyname+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char gethostbyname (); int main () { -gethostbyname (); +return gethostbyname (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_nsl_gethostbyname=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_nsl_gethostbyname=no + ac_cv_lib_nsl_gethostbyname=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5 -echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6 -if test $ac_cv_lib_nsl_gethostbyname = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 +$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; } +if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then : LIBS="$LIBS -lnsl" fi @@ -5921,15 +4529,15 @@ fi LIBS="$LIBS$THREADS_LIBS" - echo "$as_me:$LINENO: checking how to build libraries" >&5 -echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 - # Check whether --enable-shared or --disable-shared was given. -if test "${enable_shared+set}" = set; then - enableval="$enable_shared" - tcl_ok=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 +$as_echo_n "checking how to build libraries... " >&6; } + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; tcl_ok=$enableval else tcl_ok=yes -fi; +fi + if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -5939,17 +4547,15 @@ fi; fi if test "$tcl_ok" = "yes" ; then - echo "$as_me:$LINENO: result: shared" >&5 -echo "${ECHO_T}shared" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5 +$as_echo "shared" >&6; } SHARED_BUILD=1 else - echo "$as_me:$LINENO: result: static" >&5 -echo "${ECHO_T}static" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5 +$as_echo "static" >&6; } SHARED_BUILD=0 -cat >>confdefs.h <<\_ACEOF -#define STATIC_BUILD 1 -_ACEOF +$as_echo "#define STATIC_BUILD 1" >>confdefs.h fi @@ -5961,10 +4567,10 @@ _ACEOF #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking for tclsh" >&5 -echo $ECHO_N "checking for tclsh... $ECHO_C" >&6 - if test "${ac_cv_path_tclsh+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 +$as_echo_n "checking for tclsh... " >&6; } + if ${ac_cv_path_tclsh+:} false; then : + $as_echo_n "(cached) " >&6 else search_path=`echo ${PATH} | sed -e 's/:/ /g'` @@ -5985,13 +4591,13 @@ fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" - echo "$as_me:$LINENO: result: $TCLSH_PROG" >&5 -echo "${ECHO_T}$TCLSH_PROG" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 +$as_echo "$TCLSH_PROG" >&6; } else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" - echo "$as_me:$LINENO: result: No tclsh found on PATH" >&5 -echo "${ECHO_T}No tclsh found on PATH" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 +$as_echo "No tclsh found on PATH" >&6; } fi @@ -6004,351 +4610,89 @@ fi #------------------------------------------------------------------------ zlib_ok=yes -if test "${ac_cv_header_zlib_h+set}" = set; then - echo "$as_me:$LINENO: checking for zlib.h" >&5 -echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 -if test "${ac_cv_header_zlib_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 -echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking zlib.h usability" >&5 -echo $ECHO_N "checking zlib.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +ac_fn_c_check_header_mongrel "$LINENO" "zlib.h" "ac_cv_header_zlib_h" "$ac_includes_default" +if test "x$ac_cv_header_zlib_h" = xyes; then : -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 + ac_fn_c_check_type "$LINENO" "gz_header" "ac_cv_type_gz_header" "#include +" +if test "x$ac_cv_type_gz_header" = xyes; then : -# Is the header present? -echo "$as_me:$LINENO: checking zlib.h presence" >&5 -echo $ECHO_N "checking zlib.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi else - ac_cpp_err=yes + zlib_ok=no fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes + else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - ac_header_preproc=no + zlib_ok=no fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: zlib.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: zlib.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: zlib.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: zlib.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: zlib.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: zlib.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: zlib.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: zlib.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: zlib.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: zlib.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for zlib.h" >&5 -echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 -if test "${ac_cv_header_zlib_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_zlib_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 -echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 -fi -if test $ac_cv_header_zlib_h = yes; then +if test $zlib_ok = yes; then : - echo "$as_me:$LINENO: checking for gz_header" >&5 -echo $ECHO_N "checking for gz_header... $ECHO_C" >&6 -if test "${ac_cv_type_gz_header+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing deflateSetHeader" >&5 +$as_echo_n "checking for library containing deflateSetHeader... " >&6; } +if ${ac_cv_search_deflateSetHeader+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char deflateSetHeader (); int main () { -if ((gz_header *) 0) - return 0; -if (sizeof (gz_header)) - return 0; +return deflateSetHeader (); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_gz_header=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_gz_header=no +for ac_lib in '' z; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_deflateSetHeader=$ac_res fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_deflateSetHeader+:} false; then : + break fi -echo "$as_me:$LINENO: result: $ac_cv_type_gz_header" >&5 -echo "${ECHO_T}$ac_cv_type_gz_header" >&6 -if test $ac_cv_type_gz_header = yes; then - : +done +if ${ac_cv_search_deflateSetHeader+:} false; then : + else - zlib_ok=no + ac_cv_search_deflateSetHeader=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_deflateSetHeader" >&5 +$as_echo "$ac_cv_search_deflateSetHeader" >&6; } +ac_res=$ac_cv_search_deflateSetHeader +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" else - zlib_ok=no + zlib_ok=no + fi +fi +if test $zlib_ok = no; then : -if test $zlib_ok = yes; then - - echo "$as_me:$LINENO: checking for library containing deflateSetHeader" >&5 -echo $ECHO_N "checking for library containing deflateSetHeader... $ECHO_C" >&6 -if test "${ac_cv_search_deflateSetHeader+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_func_search_save_LIBS=$LIBS -ac_cv_search_deflateSetHeader=no -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char deflateSetHeader (); -int -main () -{ -deflateSetHeader (); - ; - 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 - ac_cv_search_deflateSetHeader="none required" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -if test "$ac_cv_search_deflateSetHeader" = no; then - for ac_lib in z; do - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char deflateSetHeader (); -int -main () -{ -deflateSetHeader (); - ; - 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 - ac_cv_search_deflateSetHeader="-l$ac_lib" -break -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - done -fi -LIBS=$ac_func_search_save_LIBS -fi -echo "$as_me:$LINENO: result: $ac_cv_search_deflateSetHeader" >&5 -echo "${ECHO_T}$ac_cv_search_deflateSetHeader" >&6 -if test "$ac_cv_search_deflateSetHeader" != no; then - test "$ac_cv_search_deflateSetHeader" = "none required" || LIBS="$ac_cv_search_deflateSetHeader $LIBS" - -else - - zlib_ok=no - -fi - -fi - -if test $zlib_ok = no; then - - ZLIB_OBJS=\${ZLIB_OBJS} + ZLIB_OBJS=\${ZLIB_OBJS} ZLIB_SRCS=\${ZLIB_SRCS} @@ -6357,10 +4701,7 @@ if test $zlib_ok = no; then fi - -cat >>confdefs.h <<\_ACEOF -#define HAVE_ZLIB 1 -_ACEOF +$as_echo "#define HAVE_ZLIB 1" >>confdefs.h #-------------------------------------------------------------------- @@ -6372,10 +4713,10 @@ _ACEOF if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -6385,35 +4726,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then - echo "$as_me:$LINENO: result: $RANLIB" >&5 -echo "${ECHO_T}$RANLIB" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. @@ -6423,28 +4766,38 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS - test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then - echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 -echo "${ECHO_T}$ac_ct_RANLIB" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - RANLIB=$ac_ct_RANLIB + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi else RANLIB="$ac_cv_prog_RANLIB" fi @@ -6453,52 +4806,47 @@ fi # Step 0.a: Enable 64 bit support? - echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 -echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 - # Check whether --enable-64bit or --disable-64bit was given. -if test "${enable_64bit+set}" = set; then - enableval="$enable_64bit" - do64bit=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 +$as_echo_n "checking if 64bit support is requested... " >&6; } + # Check whether --enable-64bit was given. +if test "${enable_64bit+set}" = set; then : + enableval=$enable_64bit; do64bit=$enableval else do64bit=no -fi; - echo "$as_me:$LINENO: result: $do64bit" >&5 -echo "${ECHO_T}$do64bit" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 +$as_echo "$do64bit" >&6; } # Step 0.b: Enable Solaris 64 bit VIS support? - echo "$as_me:$LINENO: checking if 64bit Sparc VIS support is requested" >&5 -echo $ECHO_N "checking if 64bit Sparc VIS support is requested... $ECHO_C" >&6 - # Check whether --enable-64bit-vis or --disable-64bit-vis was given. -if test "${enable_64bit_vis+set}" = set; then - enableval="$enable_64bit_vis" - do64bitVIS=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5 +$as_echo_n "checking if 64bit Sparc VIS support is requested... " >&6; } + # Check whether --enable-64bit-vis was given. +if test "${enable_64bit_vis+set}" = set; then : + enableval=$enable_64bit_vis; do64bitVIS=$enableval else do64bitVIS=no -fi; - echo "$as_me:$LINENO: result: $do64bitVIS" >&5 -echo "${ECHO_T}$do64bitVIS" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5 +$as_echo "$do64bitVIS" >&6; } # Force 64bit on with VIS - if test "$do64bitVIS" = "yes"; then + if test "$do64bitVIS" = "yes"; then : do64bit=yes fi - # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. - echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5 -echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6 -if test "${tcl_cv_cc_visibility_hidden+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5 +$as_echo_n "checking if compiler supports visibility \"hidden\"... " >&6; } +if ${tcl_cv_cc_visibility_hidden+:} false; then : + $as_echo_n "(cached) " >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ extern __attribute__((__visibility__("hidden"))) void f(void); @@ -6511,79 +4859,50 @@ f(); 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_cc_visibility_hidden=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_visibility_hidden=no + tcl_cv_cc_visibility_hidden=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 -echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 - if test $tcl_cv_cc_visibility_hidden = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5 +$as_echo "$tcl_cv_cc_visibility_hidden" >&6; } + if test $tcl_cv_cc_visibility_hidden = yes; then : -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE extern __attribute__((__visibility__("hidden"))) -_ACEOF +$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define HAVE_HIDDEN 1 -_ACEOF +$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h fi - # Step 0.d: Disable -rpath support? - echo "$as_me:$LINENO: checking if rpath support is requested" >&5 -echo $ECHO_N "checking if rpath support is requested... $ECHO_C" >&6 - # Check whether --enable-rpath or --disable-rpath was given. -if test "${enable_rpath+set}" = set; then - enableval="$enable_rpath" - doRpath=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5 +$as_echo_n "checking if rpath support is requested... " >&6; } + # Check whether --enable-rpath was given. +if test "${enable_rpath+set}" = set; then : + enableval=$enable_rpath; doRpath=$enableval else doRpath=yes -fi; - echo "$as_me:$LINENO: result: $doRpath" >&5 -echo "${ECHO_T}$doRpath" >&6 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5 +$as_echo "$doRpath" >&6; } # Step 1: set the variable "system" to hold the name and version number # for the system. - echo "$as_me:$LINENO: checking system version" >&5 -echo $ECHO_N "checking system version... $ECHO_C" >&6 -if test "${tcl_cv_sys_version+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 +$as_echo_n "checking system version... " >&6; } +if ${tcl_cv_sys_version+:} false; then : + $as_echo_n "(cached) " >&6 else if test -f /usr/lib/NextStep/software_version; then @@ -6591,8 +4910,8 @@ else else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then - { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 -echo "$as_me: WARNING: can't find uname command" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 +$as_echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird @@ -6608,79 +4927,51 @@ echo "$as_me: WARNING: can't find uname command" >&2;} fi fi -echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 -echo "${ECHO_T}$tcl_cv_sys_version" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 +$as_echo "$tcl_cv_sys_version" >&6; } system=$tcl_cv_sys_version # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. - echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 -echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 -if test "${ac_cv_lib_dl_dlopen+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char dlopen (); int main () { -dlopen (); +return dlopen (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_dl_dlopen=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_dl_dlopen=no + ac_cv_lib_dl_dlopen=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 -echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 -if test $ac_cv_lib_dl_dlopen = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : have_dl=yes else have_dl=no @@ -6706,7 +4997,7 @@ fi ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g - if test "$GCC" = yes; then + if test "$GCC" = yes; then : CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall" @@ -6717,14 +5008,13 @@ else CFLAGS_WARNING="" fi - if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_AR+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. @@ -6734,35 +5024,37 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then - echo "$as_me:$LINENO: result: $AR" >&5 -echo "${ECHO_T}$AR" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_ac_ct_AR+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. @@ -6772,27 +5064,38 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then - echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 -echo "${ECHO_T}$ac_ct_AR" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi - AR=$ac_ct_AR + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi else AR="$ac_cv_prog_AR" fi @@ -6802,13 +5105,12 @@ fi PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" - if test x"${SHLIB_VERSION}" = x; then + if test x"${SHLIB_VERSION}" = x; then : SHLIB_VERSION="1.0" fi - case $system in AIX-*) - if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then + if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then : # AIX requires the _r compiler when gcc isn't being used case "${CC}" in @@ -6820,11 +5122,10 @@ fi CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` ;; esac - echo "$as_me:$LINENO: result: Using $CC for compiling with threads" >&5 -echo "${ECHO_T}Using $CC for compiling with threads" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5 +$as_echo "Using $CC for compiling with threads" >&6; } fi - LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" @@ -6837,12 +5138,12 @@ fi LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = yes; then + if test "$do64bit" = yes; then : - if test "$GCC" = yes; then + if test "$GCC" = yes; then : - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 -echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} else @@ -6855,17 +5156,15 @@ else fi - fi - - if test "`uname -m`" = ia64; then + if test "`uname -m`" = ia64; then : # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" - if test "$GCC" = yes; then + if test "$GCC" = yes; then : CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' @@ -6874,12 +5173,11 @@ else CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi - LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else - if test "$GCC" = yes; then + if test "$GCC" = yes; then : SHLIB_LD='${CC} -shared -Wl,-bexpall' @@ -6889,14 +5187,12 @@ else LDFLAGS="$LDFLAGS -brtl" fi - SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi - ;; BeOS*) SHLIB_CFLAGS="-fPIC" @@ -6910,71 +5206,43 @@ fi # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- - echo "$as_me:$LINENO: checking for inet_ntoa in -lbind" >&5 -echo $ECHO_N "checking for inet_ntoa in -lbind... $ECHO_C" >&6 -if test "${ac_cv_lib_bind_inet_ntoa+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5 +$as_echo_n "checking for inet_ntoa in -lbind... " >&6; } +if ${ac_cv_lib_bind_inet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { -inet_ntoa (); +return inet_ntoa (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_bind_inet_ntoa=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_bind_inet_ntoa=no + ac_cv_lib_bind_inet_ntoa=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_bind_inet_ntoa" >&5 -echo "${ECHO_T}$ac_cv_lib_bind_inet_ntoa" >&6 -if test $ac_cv_lib_bind_inet_ntoa = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5 +$as_echo "$ac_cv_lib_bind_inet_ntoa" >&6; } +if test "x$ac_cv_lib_bind_inet_ntoa" = xyes; then : LIBS="$LIBS -lbind -lsocket" fi @@ -7011,16 +5279,12 @@ fi TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" - echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 -echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 -if test "${ac_cv_cygwin+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5 +$as_echo_n "checking for Cygwin version of gcc... " >&6; } +if ${ac_cv_cygwin+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __CYGWIN__ @@ -7035,49 +5299,21 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_cygwin=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_cygwin=yes + ac_cv_cygwin=yes fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5 -echo "${ECHO_T}$ac_cv_cygwin" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5 +$as_echo "$ac_cv_cygwin" >&6; } if test "$ac_cv_cygwin" = "no"; then - { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5 -echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5 fi if test "x${TCL_THREADS}" = "x0"; then - { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5 -echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "CYGWIN compile is only supported with --enable-threads" "$LINENO" 5 fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then @@ -7107,71 +5343,43 @@ echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2 SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" - echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5 -echo $ECHO_N "checking for inet_ntoa in -lnetwork... $ECHO_C" >&6 -if test "${ac_cv_lib_network_inet_ntoa+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5 +$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; } +if ${ac_cv_lib_network_inet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { -inet_ntoa (); +return inet_ntoa (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_network_inet_ntoa=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_network_inet_ntoa=no + ac_cv_lib_network_inet_ntoa=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_network_inet_ntoa" >&5 -echo "${ECHO_T}$ac_cv_lib_network_inet_ntoa" >&6 -if test $ac_cv_lib_network_inet_ntoa = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5 +$as_echo "$ac_cv_lib_network_inet_ntoa" >&6; } +if test "x$ac_cv_lib_network_inet_ntoa" = xyes; then : LIBS="$LIBS -lnetwork" fi @@ -7179,18 +5387,14 @@ fi HP-UX-*.11.*) # Use updated header definitions where possible -cat >>confdefs.h <<\_ACEOF -#define _XOPEN_SOURCE_EXTENDED 1 -_ACEOF +$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define _XOPEN_SOURCE 1 -_ACEOF +$as_echo "#define _XOPEN_SOURCE 1" >>confdefs.h LIBS="$LIBS -lxnet" # Use the XOPEN network library - if test "`uname -m`" = ia64; then + if test "`uname -m`" = ia64; then : SHLIB_SUFFIX=".so" @@ -7199,78 +5403,49 @@ else SHLIB_SUFFIX=".sl" fi - - echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 -echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 -if test "${ac_cv_lib_dld_shl_load+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char shl_load (); int main () { -shl_load (); +return shl_load (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_dld_shl_load=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_dld_shl_load=no + ac_cv_lib_dld_shl_load=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 -echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 -if test $ac_cv_lib_dld_shl_load = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : tcl_ok=yes else tcl_ok=no fi - if test "$tcl_ok" = yes; then + if test "$tcl_ok" = yes; then : SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" @@ -7282,8 +5457,7 @@ fi LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi - - if test "$GCC" = yes; then + if test "$GCC" = yes; then : SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} @@ -7294,30 +5468,28 @@ else fi - # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = "yes"; then + if test "$do64bit" = "yes"; then : - if test "$GCC" = yes; then + if test "$GCC" = yes; then : case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 -echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} ;; esac @@ -7329,82 +5501,52 @@ else fi - -fi - ;; +fi ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" - echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 -echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 -if test "${ac_cv_lib_dld_shl_load+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char shl_load (); int main () { -shl_load (); +return shl_load (); ; 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 +if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_dld_shl_load=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_dld_shl_load=no + ac_cv_lib_dld_shl_load=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 -echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 -if test $ac_cv_lib_dld_shl_load = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : tcl_ok=yes else tcl_ok=no fi - if test "$tcl_ok" = yes; then + if test "$tcl_ok" = yes; then : SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" @@ -7416,28 +5558,24 @@ fi LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" -fi - ;; +fi ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - case $LIBOBJS in - "mkstemp.$ac_objext" | \ - *" mkstemp.$ac_objext" | \ - "mkstemp.$ac_objext "* | \ + case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" + ;; esac - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi - ;; IRIX-6.*) SHLIB_CFLAGS="" @@ -7445,21 +5583,18 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - case $LIBOBJS in - "mkstemp.$ac_objext" | \ - *" mkstemp.$ac_objext" | \ - "mkstemp.$ac_objext "* | \ + case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" + ;; esac - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi - - if test "$GCC" = yes; then + if test "$GCC" = yes; then : CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" @@ -7478,7 +5613,6 @@ else LDFLAGS="$LDFLAGS -n32" fi - ;; IRIX64-6.*) SHLIB_CFLAGS="" @@ -7486,29 +5620,26 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - case $LIBOBJS in - "mkstemp.$ac_objext" | \ - *" mkstemp.$ac_objext" | \ - "mkstemp.$ac_objext "* | \ + case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" + ;; esac - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi - # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = yes; then + if test "$do64bit" = yes; then : - if test "$GCC" = yes; then + if test "$GCC" = yes; then : - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported by gcc" >&5 -echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else @@ -7519,9 +5650,7 @@ else fi - fi - ;; Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" @@ -7537,31 +5666,25 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - if test "`uname -m`" = "alpha"; then + if test "`uname -m`" = "alpha"; then : CFLAGS="$CFLAGS -mieee" fi + if test $do64bit = yes; then : - if test $do64bit = yes; then - - echo "$as_me:$LINENO: checking if compiler accepts -m64 flag" >&5 -echo $ECHO_N "checking if compiler accepts -m64 flag... $ECHO_C" >&6 -if test "${tcl_cv_cc_m64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5 +$as_echo_n "checking if compiler accepts -m64 flag... " >&6; } +if ${tcl_cv_cc_m64+:} false; then : + $as_echo_n "(cached) " >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -7572,62 +5695,35 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_cc_m64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_m64=no + tcl_cv_cc_m64=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_m64" >&5 -echo "${ECHO_T}$tcl_cv_cc_m64" >&6 - if test $tcl_cv_cc_m64 = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5 +$as_echo "$tcl_cv_cc_m64" >&6; } + if test $tcl_cv_cc_m64 = yes; then : CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi - fi - # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. - if test x"${USE_COMPAT}" != x; then + if test x"${USE_COMPAT}" != x; then : CFLAGS="$CFLAGS -fno-inline" fi - ;; Lynx*) SHLIB_CFLAGS="-fPIC" @@ -7637,12 +5733,11 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" @@ -7681,11 +5776,10 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" @@ -7702,7 +5796,7 @@ fi CFLAGS_OPTIMIZE="-O2" ;; esac - if test "${TCL_THREADS}" = "1"; then + if test "${TCL_THREADS}" = "1"; then : # On OpenBSD: Compile with -pthread # Don't link with -lpthread @@ -7710,7 +5804,6 @@ fi CFLAGS="$CFLAGS -pthread" fi - # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots @@ -7723,13 +5816,12 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - if test "${TCL_THREADS}" = "1"; then + if test "${TCL_THREADS}" = "1"; then : # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` @@ -7737,7 +5829,6 @@ fi LDFLAGS="$LDFLAGS -pthread" fi - ;; FreeBSD-*) # This configuration from FreeBSD Ports. @@ -7748,20 +5839,18 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - - if test "${TCL_THREADS}" = "1"; then + if test "${TCL_THREADS}" = "1"; then : # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi - case $system in FreeBSD-3.*) # Version numbers are dot-stripped by system policy. @@ -7784,23 +5873,19 @@ fi CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" - if test $do64bit = yes; then + if test $do64bit = yes; then : case `arch` in ppc) - echo "$as_me:$LINENO: checking if compiler accepts -arch ppc64 flag" >&5 -echo $ECHO_N "checking if compiler accepts -arch ppc64 flag... $ECHO_C" >&6 -if test "${tcl_cv_cc_arch_ppc64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5 +$as_echo_n "checking if compiler accepts -arch ppc64 flag... " >&6; } +if ${tcl_cv_cc_arch_ppc64+:} false; then : + $as_echo_n "(cached) " >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -7811,62 +5896,33 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_cc_arch_ppc64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_arch_ppc64=no + tcl_cv_cc_arch_ppc64=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_ppc64" >&5 -echo "${ECHO_T}$tcl_cv_cc_arch_ppc64" >&6 - if test $tcl_cv_cc_arch_ppc64 = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 +$as_echo "$tcl_cv_cc_arch_ppc64" >&6; } + if test $tcl_cv_cc_arch_ppc64 = yes; then : CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes -fi -;; +fi;; i386) - echo "$as_me:$LINENO: checking if compiler accepts -arch x86_64 flag" >&5 -echo $ECHO_N "checking if compiler accepts -arch x86_64 flag... $ECHO_C" >&6 -if test "${tcl_cv_cc_arch_x86_64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5 +$as_echo_n "checking if compiler accepts -arch x86_64 flag... " >&6; } +if ${tcl_cv_cc_arch_x86_64+:} false; then : + $as_echo_n "(cached) " >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -7877,79 +5933,48 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_cc_arch_x86_64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_arch_x86_64=no + tcl_cv_cc_arch_x86_64=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_x86_64" >&5 -echo "${ECHO_T}$tcl_cv_cc_arch_x86_64" >&6 - if test $tcl_cv_cc_arch_x86_64 = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5 +$as_echo "$tcl_cv_cc_arch_x86_64" >&6; } + if test $tcl_cv_cc_arch_x86_64 = yes; then : CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes -fi -;; +fi;; *) - { echo "$as_me:$LINENO: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 -echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 +$as_echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac else # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ - && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then + && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then : fat_32_64=yes fi - fi - SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' - echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5 -echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6 -if test "${tcl_cv_ld_single_module+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 +$as_echo_n "checking if ld accepts -single_module flag... " >&6; } +if ${tcl_cv_ld_single_module+:} false; then : + $as_echo_n "(cached) " >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -7960,71 +5985,41 @@ int i; 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_ld_single_module=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_ld_single_module=no + tcl_cv_ld_single_module=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi -echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5 -echo "${ECHO_T}$tcl_cv_ld_single_module" >&6 - if test $tcl_cv_ld_single_module = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5 +$as_echo "$tcl_cv_ld_single_module" >&6; } + if test $tcl_cv_ld_single_module = yes; then : SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi - SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" # Don't use -prebind when building for Mac OS X 10.4 or later only: if test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int($2)}'`" -lt 4 -a \ - "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then + "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then : LDFLAGS="$LDFLAGS -prebind" fi - LDFLAGS="$LDFLAGS -headerpad_max_install_names" - echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5 -echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6 -if test "${tcl_cv_ld_search_paths_first+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5 +$as_echo_n "checking if ld accepts -search_paths_first flag... " >&6; } +if ${tcl_cv_ld_search_paths_first+:} false; then : + $as_echo_n "(cached) " >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -8035,88 +6030,58 @@ int i; 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_ld_search_paths_first=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_ld_search_paths_first=no + tcl_cv_ld_search_paths_first=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi -echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5 -echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 - if test $tcl_cv_ld_search_paths_first = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5 +$as_echo "$tcl_cv_ld_search_paths_first" >&6; } + if test $tcl_cv_ld_search_paths_first = yes; then : LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi + if test "$tcl_cv_cc_visibility_hidden" != yes; then : - if test "$tcl_cv_cc_visibility_hidden" != yes; then - -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE __private_extern__ -_ACEOF +$as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h fi - CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" -cat >>confdefs.h <<\_ACEOF -#define MAC_OSX_TCL 1 -_ACEOF +$as_echo "#define MAC_OSX_TCL 1" >>confdefs.h PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' - echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5 -echo $ECHO_N "checking whether to use CoreFoundation... $ECHO_C" >&6 - # Check whether --enable-corefoundation or --disable-corefoundation was given. -if test "${enable_corefoundation+set}" = set; then - enableval="$enable_corefoundation" - tcl_corefoundation=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5 +$as_echo_n "checking whether to use CoreFoundation... " >&6; } + # Check whether --enable-corefoundation was given. +if test "${enable_corefoundation+set}" = set; then : + enableval=$enable_corefoundation; tcl_corefoundation=$enableval else tcl_corefoundation=yes -fi; - echo "$as_me:$LINENO: result: $tcl_corefoundation" >&5 -echo "${ECHO_T}$tcl_corefoundation" >&6 - if test $tcl_corefoundation = yes; then +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5 +$as_echo "$tcl_corefoundation" >&6; } + if test $tcl_corefoundation = yes; then : - echo "$as_me:$LINENO: checking for CoreFoundation.framework" >&5 -echo $ECHO_N "checking for CoreFoundation.framework... $ECHO_C" >&6 -if test "${tcl_cv_lib_corefoundation+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CoreFoundation.framework" >&5 +$as_echo_n "checking for CoreFoundation.framework... " >&6; } +if ${tcl_cv_lib_corefoundation+:} false; then : + $as_echo_n "(cached) " >&6 else hold_libs=$LIBS - if test "$fat_32_64" = yes; then + if test "$fat_32_64" = yes; then : for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit @@ -8126,13 +6091,8 @@ else eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi - LIBS="$LIBS -framework CoreFoundation" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -8143,77 +6103,45 @@ CFBundleRef b = CFBundleGetMainBundle(); 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_lib_corefoundation=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_lib_corefoundation=no + tcl_cv_lib_corefoundation=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test "$fat_32_64" = yes; then +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "$fat_32_64" = yes; then : for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi - LIBS=$hold_libs fi -echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation" >&5 -echo "${ECHO_T}$tcl_cv_lib_corefoundation" >&6 - if test $tcl_cv_lib_corefoundation = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5 +$as_echo "$tcl_cv_lib_corefoundation" >&6; } + if test $tcl_cv_lib_corefoundation = yes; then : LIBS="$LIBS -framework CoreFoundation" -cat >>confdefs.h <<\_ACEOF -#define HAVE_COREFOUNDATION 1 -_ACEOF +$as_echo "#define HAVE_COREFOUNDATION 1" >>confdefs.h else tcl_corefoundation=no fi + if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then : - if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then - - echo "$as_me:$LINENO: checking for 64-bit CoreFoundation" >&5 -echo $ECHO_N "checking for 64-bit CoreFoundation... $ECHO_C" >&6 -if test "${tcl_cv_lib_corefoundation_64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit CoreFoundation" >&5 +$as_echo_n "checking for 64-bit CoreFoundation... " >&6; } +if ${tcl_cv_lib_corefoundation_64+:} false; then : + $as_echo_n "(cached) " >&6 else for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -8224,60 +6152,31 @@ CFBundleRef b = CFBundleGetMainBundle(); 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_lib_corefoundation_64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_lib_corefoundation_64=no + tcl_cv_lib_corefoundation_64=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi -echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation_64" >&5 -echo "${ECHO_T}$tcl_cv_lib_corefoundation_64" >&6 - if test $tcl_cv_lib_corefoundation_64 = no; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5 +$as_echo "$tcl_cv_lib_corefoundation_64" >&6; } + if test $tcl_cv_lib_corefoundation_64 = no; then : -cat >>confdefs.h <<\_ACEOF -#define NO_COREFOUNDATION_64 1 -_ACEOF +$as_echo "#define NO_COREFOUNDATION_64 1" >>confdefs.h LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" fi - fi - fi - ;; NEXTSTEP-*) SHLIB_CFLAGS="" @@ -8293,9 +6192,7 @@ fi SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy -cat >>confdefs.h <<\_ACEOF -#define _OE_SOCKETS 1 -_ACEOF +$as_echo "#define _OE_SOCKETS 1" >>confdefs.h ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) @@ -8313,14 +6210,13 @@ _ACEOF OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" - if test "$SHARED_BUILD" = 1; then + if test "$SHARED_BUILD" = 1; then : SHLIB_LD="ld -shared" else SHLIB_LD="ld -non_shared" fi - SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -8331,7 +6227,7 @@ fi OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" - if test "$SHARED_BUILD" = 1; then + if test "$SHARED_BUILD" = 1; then : SHLIB_LD='ld -shared -expect_unresolved "*"' @@ -8340,30 +6236,27 @@ else SHLIB_LD='ld -non_shared -expect_unresolved "*"' fi - SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - if test $doRpath = yes; then + if test $doRpath = yes; then : CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi - - if test "$GCC" = yes; then + if test "$GCC" = yes; then : CFLAGS="$CFLAGS -mieee" else CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi - # see pthread_intro(3) for pthread support on osf1, k.furukawa - if test "${TCL_THREADS}" = 1; then + if test "${TCL_THREADS}" = 1; then : CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` - if test "$GCC" = yes; then + if test "$GCC" = yes; then : LIBS="$LIBS -lpthread -lmach -lexc" @@ -8374,9 +6267,7 @@ else fi - fi - ;; QNX-6*) # QNX RTP @@ -8395,7 +6286,7 @@ fi # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. - if test "$GCC" = yes; then + if test "$GCC" = yes; then : SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" @@ -8406,7 +6297,6 @@ else LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi - SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" @@ -8451,21 +6341,17 @@ fi # won't define thread-safe library routines. -cat >>confdefs.h <<\_ACEOF -#define _REENTRANT 1 -_ACEOF +$as_echo "#define _REENTRANT 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define _POSIX_PTHREAD_SEMANTICS 1 -_ACEOF +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" - if test "$GCC" = yes; then + if test "$GCC" = yes; then : SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' @@ -8478,37 +6364,32 @@ else LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi - ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. -cat >>confdefs.h <<\_ACEOF -#define _REENTRANT 1 -_ACEOF +$as_echo "#define _REENTRANT 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define _POSIX_PTHREAD_SEMANTICS 1 -_ACEOF +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = yes; then + if test "$do64bit" = yes; then : arch=`isainfo` - if test "$arch" = "sparcv9 sparc"; then + if test "$arch" = "sparcv9 sparc"; then : - if test "$GCC" = yes; then + if test "$GCC" = yes; then : - if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then + if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then : - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 -echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} else @@ -8519,11 +6400,10 @@ else fi - else do64bit_ok=yes - if test "$do64bitVIS" = yes; then + if test "$do64bitVIS" = yes; then : CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" @@ -8534,17 +6414,15 @@ else LDFLAGS_ARCH="-xarch=v9" fi - # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi - else - if test "$arch" = "amd64 i386"; then + if test "$arch" = "amd64 i386"; then : - if test "$GCC" = yes; then + if test "$GCC" = yes; then : case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) @@ -8552,8 +6430,8 @@ else CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 -echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac else @@ -8570,169 +6448,32 @@ else fi - else - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported for $arch" >&5 -echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} fi - fi - fi - #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- - if test "$GCC" = yes; then + if test "$GCC" = yes; then : use_sunmath=no else arch=`isainfo` - echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 -echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 - if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -lsunmath for fp rounding control" >&5 +$as_echo_n "checking whether to use -lsunmath for fp rounding control... " >&6; } + if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then : - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } MATH_LIBS="-lsunmath $MATH_LIBS" - if test "${ac_cv_header_sunmath_h+set}" = set; then - echo "$as_me:$LINENO: checking for sunmath.h" >&5 -echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 -if test "${ac_cv_header_sunmath_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 -echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking sunmath.h usability" >&5 -echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking sunmath.h presence" >&5 -echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for sunmath.h" >&5 -echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 -if test "${ac_cv_header_sunmath_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_sunmath_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 -echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 + ac_fn_c_check_header_mongrel "$LINENO" "sunmath.h" "ac_cv_header_sunmath_h" "$ac_includes_default" +if test "x$ac_cv_header_sunmath_h" = xyes; then : fi @@ -8741,26 +6482,24 @@ fi else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } use_sunmath=no fi - fi - SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" - if test "$GCC" = yes; then + if test "$GCC" = yes; then : SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - if test "$do64bit_ok" = yes; then + if test "$do64bit_ok" = yes; then : - if test "$arch" = "sparcv9 sparc"; then + if test "$arch" = "sparcv9 sparc"; then : # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. @@ -8771,26 +6510,22 @@ fi #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" else - if test "$arch" = "amd64 i386"; then + if test "$arch" = "amd64 i386"; then : SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" fi - fi - fi - else - if test "$use_sunmath" = yes; then + if test "$use_sunmath" = yes; then : textmode=textoff else textmode=text fi - case $system in SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; @@ -8801,7 +6536,6 @@ fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' fi - ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" @@ -8812,19 +6546,15 @@ fi DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. - echo "$as_me:$LINENO: checking for ld accepts -Bexport flag" >&5 -echo $ECHO_N "checking for ld accepts -Bexport flag... $ECHO_C" >&6 -if test "${tcl_cv_ld_Bexport+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5 +$as_echo_n "checking for ld accepts -Bexport flag... " >&6; } +if ${tcl_cv_ld_Bexport+:} false; then : + $as_echo_n "(cached) " >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -8835,93 +6565,63 @@ int i; 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_ld_Bexport=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_ld_Bexport=no + tcl_cv_ld_Bexport=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi -echo "$as_me:$LINENO: result: $tcl_cv_ld_Bexport" >&5 -echo "${ECHO_T}$tcl_cv_ld_Bexport" >&6 - if test $tcl_cv_ld_Bexport = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 +$as_echo "$tcl_cv_ld_Bexport" >&6; } + if test $tcl_cv_ld_Bexport = yes; then : LDFLAGS="$LDFLAGS -Wl,-Bexport" fi - CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac - if test "$do64bit" = yes -a "$do64bit_ok" = no; then + if test "$do64bit" = yes -a "$do64bit_ok" = no; then : - { echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 -echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 +$as_echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} fi + if test "$do64bit" = yes -a "$do64bit_ok" = yes; then : - if test "$do64bit" = yes -a "$do64bit_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define TCL_CFG_DO64BIT 1 -_ACEOF +$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h fi - # Step 4: disable dynamic loading if requested via a command-line switch. - # Check whether --enable-load or --disable-load was given. -if test "${enable_load+set}" = set; then - enableval="$enable_load" - tcl_ok=$enableval + # Check whether --enable-load was given. +if test "${enable_load+set}" = set; then : + enableval=$enable_load; tcl_ok=$enableval else tcl_ok=yes -fi; - if test "$tcl_ok" = no; then - DL_OBJS="" fi + if test "$tcl_ok" = no; then : + DL_OBJS="" +fi - if test "x$DL_OBJS" != x; then + if test "x$DL_OBJS" != x; then : BUILD_DLTEST="\$(DLTEST_TARGETS)" else - { echo "$as_me:$LINENO: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 -echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 +$as_echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" @@ -8933,14 +6633,13 @@ echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libr BUILD_DLTEST="" fi - LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. - if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then + if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then : case $system in AIX-*) ;; @@ -8954,35 +6653,29 @@ fi esac fi - - if test "$tcl_cv_cc_visibility_hidden" != yes; then + if test "$tcl_cv_cc_visibility_hidden" != yes; then : -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE extern -_ACEOF +$as_echo "#define MODULE_SCOPE extern" >>confdefs.h fi - - if test "$SHARED_LIB_SUFFIX" = ""; then + if test "$SHARED_LIB_SUFFIX" = ""; then : SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' fi - - if test "$UNSHARED_LIB_SUFFIX" = ""; then + if test "$UNSHARED_LIB_SUFFIX" = ""; then : UNSHARED_LIB_SUFFIX='${VERSION}.a' fi - DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" - if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then + 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}' - if test "${SHLIB_SUFFIX}" = ".dll"; then + if test "${SHLIB_SUFFIX}" = ".dll"; then : INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" @@ -8993,12 +6686,11 @@ else fi - else LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} - if test "$RANLIB" = ""; then + if test "$RANLIB" = ""; then : MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' @@ -9010,12 +6702,22 @@ else fi - fi + if test "$RANLIB" = ""; then : + + MAKE_KIT_LIB='$(STLIB_LD) $@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS}' + INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)"' + +else + + MAKE_KIT_LIB='${STLIB_LD} $@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} ; ${RANLIB} $@' + INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(TCL_KIT_LIB_FILE))' + +fi # Stub lib does not depend on shared/static configuration - if test "$RANLIB" = ""; then + if test "$RANLIB" = ""; then : MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' @@ -9027,31 +6729,25 @@ else fi - # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. - if test "x${TCL_LIBS}" = x; then + if test "x${TCL_LIBS}" = x; then : TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}" fi - # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. - echo "$as_me:$LINENO: checking for cast to union support" >&5 -echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 -if test "${tcl_cv_cast_to_union+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 +$as_echo_n "checking for cast to union support... " >&6; } +if ${tcl_cv_cast_to_union+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -9065,45 +6761,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_cast_to_union=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cast_to_union=no + tcl_cv_cast_to_union=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 -echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 +$as_echo "$tcl_cv_cast_to_union" >&6; } if test "$tcl_cv_cast_to_union" = "yes"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_CAST_TO_UNION 1 -_ACEOF +$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi @@ -9149,38 +6819,36 @@ _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. -if test "${enable_symbols+set}" = set; then - enableval="$enable_symbols" - tcl_ok=$enableval + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 +$as_echo_n "checking for build with symbols... " >&6; } + # Check whether --enable-symbols was given. +if test "${enable_symbols+set}" = set; then : + enableval=$enable_symbols; tcl_ok=$enableval else tcl_ok=no -fi; +fi + # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. DBGX="" if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' -cat >>confdefs.h <<\_ACEOF -#define NDEBUG 1 -_ACEOF +$as_echo "#define NDEBUG 1" >>confdefs.h - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } -cat >>confdefs.h <<\_ACEOF -#define TCL_CFG_OPTIMIZED 1 -_ACEOF +$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 -echo "${ECHO_T}yes (standard debugging)" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 +$as_echo "yes (standard debugging)" >&6; } fi fi @@ -9188,45 +6856,35 @@ echo "${ECHO_T}yes (standard debugging)" >&6 if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then -cat >>confdefs.h <<\_ACEOF -#define TCL_MEM_DEBUG 1 -_ACEOF +$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then -cat >>confdefs.h <<\_ACEOF -#define TCL_COMPILE_DEBUG 1 -_ACEOF +$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define TCL_COMPILE_STATS 1 -_ACEOF +$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then - echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 -echo "${ECHO_T}enabled symbols mem compile debugging" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5 +$as_echo "enabled symbols mem compile debugging" >&6; } else - echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 -echo "${ECHO_T}enabled $tcl_ok debugging" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 +$as_echo "enabled $tcl_ok debugging" >&6; } fi fi -cat >>confdefs.h <<\_ACEOF -#define TCL_TOMMATH 1 -_ACEOF +$as_echo "#define TCL_TOMMATH 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define MP_PREC 4 -_ACEOF +$as_echo "#define MP_PREC 4" >>confdefs.h #-------------------------------------------------------------------- @@ -9234,18 +6892,14 @@ _ACEOF #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking for required early compiler flags" >&5 -echo $ECHO_N "checking for required early compiler flags... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5 +$as_echo_n "checking for required early compiler flags... " >&6; } tcl_flags="" - if test "${tcl_cv_flag__isoc99_source+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if ${tcl_cv_flag__isoc99_source+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -9256,38 +6910,10 @@ char *p = (char *)strtoll; char *q = (char *)strtoull; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_flag__isoc99_source=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include @@ -9299,58 +6925,28 @@ char *p = (char *)strtoll; char *q = (char *)strtoull; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_flag__isoc99_source=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_flag__isoc99_source=no + tcl_cv_flag__isoc99_source=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then -cat >>confdefs.h <<\_ACEOF -#define _ISOC99_SOURCE 1 -_ACEOF +$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h tcl_flags="$tcl_flags _ISOC99_SOURCE" fi - if test "${tcl_cv_flag__largefile64_source+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if ${tcl_cv_flag__largefile64_source+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -9361,38 +6957,10 @@ struct stat64 buf; int i = stat64("/", &buf); return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_flag__largefile64_source=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include @@ -9404,58 +6972,28 @@ struct stat64 buf; int i = stat64("/", &buf); return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_flag__largefile64_source=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_flag__largefile64_source=no + tcl_cv_flag__largefile64_source=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then -cat >>confdefs.h <<\_ACEOF -#define _LARGEFILE64_SOURCE 1 -_ACEOF +$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi - if test "${tcl_cv_flag__largefile_source64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if ${tcl_cv_flag__largefile_source64+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -9466,38 +7004,10 @@ char *p = (char *)open64; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_flag__largefile_source64=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _LARGEFILE_SOURCE64 1 #include @@ -9509,72 +7019,42 @@ char *p = (char *)open64; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_flag__largefile_source64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_flag__largefile_source64=no + tcl_cv_flag__largefile_source64=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then -cat >>confdefs.h <<\_ACEOF -#define _LARGEFILE_SOURCE64 1 -_ACEOF +$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h tcl_flags="$tcl_flags _LARGEFILE_SOURCE64" fi if test "x${tcl_flags}" = "x" ; then - echo "$as_me:$LINENO: result: none" >&5 -echo "${ECHO_T}none" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } else - echo "$as_me:$LINENO: result: ${tcl_flags}" >&5 -echo "${ECHO_T}${tcl_flags}" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5 +$as_echo "${tcl_flags}" >&6; } fi - echo "$as_me:$LINENO: checking for 64-bit integer type" >&5 -echo $ECHO_N "checking for 64-bit integer type... $ECHO_C" >&6 - if test "${tcl_cv_type_64bit+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5 +$as_echo_n "checking for 64-bit integer type... " >&6; } + if ${tcl_cv_type_64bit+:} false; then : + $as_echo_n "(cached) " >&6 else tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -9585,44 +7065,16 @@ __int64 value = (__int64) 0; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_type_64bit=__int64 else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_type_64bit="long long" + tcl_type_64bit="long long" fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -9635,66 +7087,35 @@ switch (0) { return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_type_64bit=${tcl_type_64bit} -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then -cat >>confdefs.h <<\_ACEOF -#define TCL_WIDE_INT_IS_LONG 1 -_ACEOF +$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h - echo "$as_me:$LINENO: result: using long" >&5 -echo "${ECHO_T}using long" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5 +$as_echo "using long" >&6; } else cat >>confdefs.h <<_ACEOF #define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} _ACEOF - echo "$as_me:$LINENO: result: ${tcl_cv_type_64bit}" >&5 -echo "${ECHO_T}${tcl_cv_type_64bit}" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5 +$as_echo "${tcl_cv_type_64bit}" >&6; } # Now check for auxiliary declarations - echo "$as_me:$LINENO: checking for struct dirent64" >&5 -echo $ECHO_N "checking for struct dirent64... $ECHO_C" >&6 -if test "${tcl_cv_struct_dirent64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 +$as_echo_n "checking for struct dirent64... " >&6; } +if ${tcl_cv_struct_dirent64+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include @@ -9706,58 +7127,28 @@ struct dirent64 p; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_struct_dirent64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_struct_dirent64=no + tcl_cv_struct_dirent64=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_struct_dirent64" >&5 -echo "${ECHO_T}$tcl_cv_struct_dirent64" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 +$as_echo "$tcl_cv_struct_dirent64" >&6; } if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_STRUCT_DIRENT64 1 -_ACEOF +$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h fi - echo "$as_me:$LINENO: checking for struct stat64" >&5 -echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6 -if test "${tcl_cv_struct_stat64+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 +$as_echo_n "checking for struct stat64... " >&6; } +if ${tcl_cv_struct_stat64+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -9769,161 +7160,40 @@ struct stat64 p; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_struct_stat64=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_struct_stat64=no + tcl_cv_struct_stat64=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_struct_stat64" >&5 -echo "${ECHO_T}$tcl_cv_struct_stat64" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5 +$as_echo "$tcl_cv_struct_stat64" >&6; } if test "x${tcl_cv_struct_stat64}" = "xyes" ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_STRUCT_STAT64 1 -_ACEOF +$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h fi - - -for ac_func in open64 lseek64 -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; - ; - 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 - eval "$as_ac_var=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then + for ac_func in open64 lseek64 +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done - echo "$as_me:$LINENO: checking for off64_t" >&5 -echo $ECHO_N "checking for off64_t... $ECHO_C" >&6 - if test "${tcl_cv_type_off64_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5 +$as_echo_n "checking for off64_t... " >&6; } + if ${tcl_cv_type_off64_t+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -9935,51 +7205,25 @@ off64_t offset; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_type_off64_t=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_type_off64_t=no + tcl_cv_type_off64_t=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_TYPE_OFF64_T 1 -_ACEOF +$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi fi @@ -9989,235 +7233,229 @@ echo "${ECHO_T}no" >&6 # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- -echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 -echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 -if test "${ac_cv_c_bigendian+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } +if ${ac_cv_c_bigendian+:} false; then : + $as_echo_n "(cached) " >&6 else - # See if sys/param.h defines the BYTE_ORDER macro. -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + ac_cv_c_bigendian=unknown + # See if we're dealing with a universal compiler. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __APPLE_CC__ + not a universal capable compiler + #endif + typedef int dummy; + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + # Check for potential -arch flags. It is not universal unless + # there are at least two -arch flags with different values. + ac_arch= + ac_prev= + for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do + if test -n "$ac_prev"; then + case $ac_word in + i?86 | x86_64 | ppc | ppc64) + if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then + ac_arch=$ac_word + else + ac_cv_c_bigendian=universal + break + fi + ;; + esac + ac_prev= + elif test "x$ac_word" = "x-arch"; then + ac_prev=arch + fi + done +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test $ac_cv_c_bigendian = unknown; then + # See if sys/param.h defines the BYTE_ORDER macro. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include -#include + #include int main () { -#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN - bogus endian macros -#endif +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ + && LITTLE_ENDIAN) + bogus endian macros + #endif ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : # It does; now see whether it defined to BIG_ENDIAN or not. -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include -#include + #include int main () { #if BYTE_ORDER != BIG_ENDIAN - not big endian -#endif + not big endian + #endif ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_c_bigendian=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_c_bigendian=no + ac_cv_c_bigendian=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -# It does not; compile a test program. -if test "$cross_compiling" = yes; then - # try to guess the endianness by grepping values into an object file - ac_cv_c_bigendian=unknown - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; -short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; -void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } -short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; -short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; -void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } +#include + int main () { - _ascii (); _ebcdic (); +#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) + bogus endian macros + #endif + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to _BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +#ifndef _BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no fi -if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then - if test "$ac_cv_c_bigendian" = unknown; then - ac_cv_c_bigendian=no - else - # finding both strings is unlikely to happen, but who knows? - ac_cv_c_bigendian=unknown - fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # Compile a test program. + if test "$cross_compiling" = yes; then : + # Try to guess by grepping values from an object file. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +short int ascii_mm[] = + { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; + short int ascii_ii[] = + { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; + int use_ascii (int i) { + return ascii_mm[i] + ascii_ii[i]; + } + short int ebcdic_ii[] = + { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; + short int ebcdic_mm[] = + { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; + int use_ebcdic (int i) { + return ebcdic_mm[i] + ebcdic_ii[i]; + } + extern int foo; +int +main () +{ +return use_ascii (foo) == use_ebcdic (foo); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + ac_cv_c_bigendian=yes + fi + if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi + fi fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ +$ac_includes_default int main () { - /* Are we little or big endian? From Harbison&Steele. */ - union - { - long l; - char c[sizeof (long)]; - } u; - u.l = 1; - exit (u.c[sizeof (long) - 1] == 1); + + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; + + ; + return 0; } _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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 +if ac_fn_c_try_run "$LINENO"; then : ac_cv_c_bigendian=no else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -ac_cv_c_bigendian=yes -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + ac_cv_c_bigendian=yes fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + + fi fi -echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 -echo "${ECHO_T}$ac_cv_c_bigendian" >&6 -case $ac_cv_c_bigendian in - yes) +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } + case $ac_cv_c_bigendian in #( + yes) + $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h +;; #( + no) + ;; #( + universal) -cat >>confdefs.h <<\_ACEOF -#define WORDS_BIGENDIAN 1 -_ACEOF - ;; - no) - ;; - *) - { { echo "$as_me:$LINENO: error: unknown endianness -presetting ac_cv_c_bigendian=no (or yes) will help" >&5 -echo "$as_me: error: unknown endianness -presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} - { (exit 1); exit 1; }; } ;; -esac +$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h + + ;; #( + *) + as_fn_error $? "unknown endianness + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + esac #-------------------------------------------------------------------- @@ -10226,110 +7464,17 @@ esac #-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. - for ac_func in getcwd -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; - ; - 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 - eval "$as_ac_var=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then +do : + ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd" +if test "x$ac_cv_func_getcwd" = xyes; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define HAVE_GETCWD 1 _ACEOF else -cat >>confdefs.h <<\_ACEOF -#define USEGETWD 1 -_ACEOF +$as_echo "#define USEGETWD 1" >>confdefs.h fi done @@ -10337,7726 +7482,2343 @@ done # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really # define USEGETWD even if the posix getcwd exists. Add a test ? +ac_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp" +if test "x$ac_cv_func_mkstemp" = xyes; then : + $as_echo "#define HAVE_MKSTEMP 1" >>confdefs.h +else + case " $LIBOBJS " in + *" mkstemp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" + ;; +esac +fi +ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir" +if test "x$ac_cv_func_opendir" = xyes; then : + $as_echo "#define HAVE_OPENDIR 1" >>confdefs.h -for ac_func in mkstemp opendir strtol waitpid -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif +else + case " $LIBOBJS " in + *" opendir.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS opendir.$ac_objext" + ;; +esac -#undef $ac_func +fi -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif +ac_fn_c_check_func "$LINENO" "strtol" "ac_cv_func_strtol" +if test "x$ac_cv_func_strtol" = xyes; then : + $as_echo "#define HAVE_STRTOL 1" >>confdefs.h -int -main () -{ -return f != $ac_func; - ; - 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 - eval "$as_ac_var=yes" else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + case " $LIBOBJS " in + *" strtol.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strtol.$ac_objext" + ;; +esac -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF + +ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid" +if test "x$ac_cv_func_waitpid" = xyes; then : + $as_echo "#define HAVE_WAITPID 1" >>confdefs.h else - case $LIBOBJS in - "$ac_func.$ac_objext" | \ - *" $ac_func.$ac_objext" | \ - "$ac_func.$ac_objext "* | \ - *" $ac_func.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS $ac_func.$ac_objext" ;; + case " $LIBOBJS " in + *" waitpid.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS waitpid.$ac_objext" + ;; esac fi -done -echo "$as_me:$LINENO: checking for strerror" >&5 -echo $ECHO_N "checking for strerror... $ECHO_C" >&6 -if test "${ac_cv_func_strerror+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. */ -/* Define strerror to an innocuous variant, in case declares strerror. - For example, HP-UX 11i declares gettimeofday. */ -#define strerror innocuous_strerror +ac_fn_c_check_func "$LINENO" "strerror" "ac_cv_func_strerror" +if test "x$ac_cv_func_strerror" = xyes; then : -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strerror (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ +else -#ifdef __STDC__ -# include -#else -# include -#endif +$as_echo "#define NO_STRERROR 1" >>confdefs.h -#undef strerror +fi -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strerror (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strerror) || defined (__stub___strerror) -choke me -#else -char (*f) () = strerror; -#endif -#ifdef __cplusplus -} -#endif +ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" +if test "x$ac_cv_func_getwd" = xyes; then : -int -main () -{ -return f != strerror; - ; - 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 - ac_cv_func_strerror=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_cv_func_strerror=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +$as_echo "#define NO_GETWD 1" >>confdefs.h + fi -echo "$as_me:$LINENO: result: $ac_cv_func_strerror" >&5 -echo "${ECHO_T}$ac_cv_func_strerror" >&6 -if test $ac_cv_func_strerror = yes; then - : + +ac_fn_c_check_func "$LINENO" "wait3" "ac_cv_func_wait3" +if test "x$ac_cv_func_wait3" = xyes; then : + else -cat >>confdefs.h <<\_ACEOF -#define NO_STRERROR 1 -_ACEOF +$as_echo "#define NO_WAIT3 1" >>confdefs.h fi -echo "$as_me:$LINENO: checking for getwd" >&5 -echo $ECHO_N "checking for getwd... $ECHO_C" >&6 -if test "${ac_cv_func_getwd+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname" +if test "x$ac_cv_func_uname" = xyes; then : + else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define getwd to an innocuous variant, in case declares getwd. - For example, HP-UX 11i declares gettimeofday. */ -#define getwd innocuous_getwd -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char getwd (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ +$as_echo "#define NO_UNAME 1" >>confdefs.h -#ifdef __STDC__ -# include -#else -# include -#endif +fi -#undef getwd -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char getwd (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_getwd) || defined (__stub___getwd) -choke me -#else -char (*f) () = getwd; -#endif -#ifdef __cplusplus -} -#endif +if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ + test "`uname -r | awk -F. '{print $1}'`" -lt 7; then + # prior to Darwin 7, realpath is not threadsafe, so don't + # use it when threads are enabled, c.f. bug # 711232 + ac_cv_func_realpath=no +fi +ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath" +if test "x$ac_cv_func_realpath" = xyes; then : -int -main () -{ -return f != getwd; - ; - 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 - ac_cv_func_getwd=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_cv_func_getwd=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +$as_echo "#define NO_REALPATH 1" >>confdefs.h + fi -echo "$as_me:$LINENO: result: $ac_cv_func_getwd" >&5 -echo "${ECHO_T}$ac_cv_func_getwd" >&6 -if test $ac_cv_func_getwd = yes; then - : -else -cat >>confdefs.h <<\_ACEOF -#define NO_GETWD 1 + + + NEED_FAKE_RFC2553=0 + for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF +else + NEED_FAKE_RFC2553=1 fi +done + + ac_fn_c_check_type "$LINENO" "struct addrinfo" "ac_cv_type_struct_addrinfo" " +#include +#include +#include +#include + +" +if test "x$ac_cv_type_struct_addrinfo" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_ADDRINFO 1 +_ACEOF + -echo "$as_me:$LINENO: checking for wait3" >&5 -echo $ECHO_N "checking for wait3... $ECHO_C" >&6 -if test "${ac_cv_func_wait3+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + NEED_FAKE_RFC2553=1 +fi +ac_fn_c_check_type "$LINENO" "struct in6_addr" "ac_cv_type_struct_in6_addr" " +#include +#include +#include +#include + +" +if test "x$ac_cv_type_struct_in6_addr" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_IN6_ADDR 1 _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define wait3 to an innocuous variant, in case declares wait3. - For example, HP-UX 11i declares gettimeofday. */ -#define wait3 innocuous_wait3 -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char wait3 (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ -#ifdef __STDC__ -# include -#else -# include -#endif +else + NEED_FAKE_RFC2553=1 +fi +ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" " +#include +#include +#include +#include -#undef wait3 +" +if test "x$ac_cv_type_struct_sockaddr_in6" = xyes; then : -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char wait3 (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_wait3) || defined (__stub___wait3) -choke me -#else -char (*f) () = wait3; -#endif -#ifdef __cplusplus -} -#endif +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_SOCKADDR_IN6 1 +_ACEOF -int -main () -{ -return f != wait3; - ; - return 0; -} + +else + NEED_FAKE_RFC2553=1 +fi +ac_fn_c_check_type "$LINENO" "struct sockaddr_storage" "ac_cv_type_struct_sockaddr_storage" " +#include +#include +#include +#include + +" +if test "x$ac_cv_type_struct_sockaddr_storage" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_SOCKADDR_STORAGE 1 _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 - ac_cv_func_wait3=yes + + else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + NEED_FAKE_RFC2553=1 +fi + +if test "x$NEED_FAKE_RFC2553" = "x1"; then + +$as_echo "#define NEED_FAKE_RFC2553 1" >>confdefs.h + + case " $LIBOBJS " in + *" fake-rfc2553.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" + ;; +esac + + ac_fn_c_check_func "$LINENO" "strlcpy" "ac_cv_func_strlcpy" +if test "x$ac_cv_func_strlcpy" = xyes; then : -ac_cv_func_wait3=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext + fi -echo "$as_me:$LINENO: result: $ac_cv_func_wait3" >&5 -echo "${ECHO_T}$ac_cv_func_wait3" >&6 -if test $ac_cv_func_wait3 = yes; then - : -else -cat >>confdefs.h <<\_ACEOF -#define NO_WAIT3 1 -_ACEOF -fi +#-------------------------------------------------------------------- +# Look for thread-safe variants of some library functions. +#-------------------------------------------------------------------- -echo "$as_me:$LINENO: checking for uname" >&5 -echo $ECHO_N "checking for uname... $ECHO_C" >&6 -if test "${ac_cv_func_uname+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +if test "${TCL_THREADS}" = 1; then + ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r" +if test "x$ac_cv_func_getpwuid_r" = xyes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5 +$as_echo_n "checking for getpwuid_r with 5 args... " >&6; } +if ${tcl_cv_api_getpwuid_r_5+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Define uname to an innocuous variant, in case declares uname. - For example, HP-UX 11i declares gettimeofday. */ -#define uname innocuous_uname -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char uname (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ + #include + #include -#ifdef __STDC__ -# include -#else -# include -#endif +int +main () +{ -#undef uname + uid_t uid; + struct passwd pw, *pwp; + char buf[512]; + int buflen = 512; -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char uname (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_uname) || defined (__stub___uname) -choke me -#else -char (*f) () = uname; -#endif -#ifdef __cplusplus + (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); + + ; + return 0; } -#endif +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getpwuid_r_5=yes +else + tcl_cv_api_getpwuid_r_5=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_5" >&5 +$as_echo "$tcl_cv_api_getpwuid_r_5" >&6; } + tcl_ok=$tcl_cv_api_getpwuid_r_5 + if test "$tcl_ok" = yes; then + +$as_echo "#define HAVE_GETPWUID_R_5 1" >>confdefs.h + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 4 args" >&5 +$as_echo_n "checking for getpwuid_r with 4 args... " >&6; } +if ${tcl_cv_api_getpwuid_r_4+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #include int main () { -return f != uname; + + uid_t uid; + struct passwd pw; + char buf[512]; + int buflen = 512; + + (void)getpwnam_r(uid, &pw, buf, buflen); + ; 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 - ac_cv_func_uname=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getpwuid_r_4=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_uname=no + tcl_cv_api_getpwuid_r_4=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_func_uname" >&5 -echo "${ECHO_T}$ac_cv_func_uname" >&6 -if test $ac_cv_func_uname = yes; then - : -else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_4" >&5 +$as_echo "$tcl_cv_api_getpwuid_r_4" >&6; } + tcl_ok=$tcl_cv_api_getpwuid_r_4 + if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define NO_UNAME 1 -_ACEOF +$as_echo "#define HAVE_GETPWUID_R_4 1" >>confdefs.h -fi + fi + fi + if test "$tcl_ok" = yes; then +$as_echo "#define HAVE_GETPWUID_R 1" >>confdefs.h + + fi -if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ - test "`uname -r | awk -F. '{print $1}'`" -lt 7; then - # prior to Darwin 7, realpath is not threadsafe, so don't - # use it when threads are enabled, c.f. bug # 711232 - ac_cv_func_realpath=no fi -echo "$as_me:$LINENO: checking for realpath" >&5 -echo $ECHO_N "checking for realpath... $ECHO_C" >&6 -if test "${ac_cv_func_realpath+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. */ -/* Define realpath to an innocuous variant, in case declares realpath. - For example, HP-UX 11i declares gettimeofday. */ -#define realpath innocuous_realpath -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char realpath (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ + ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r" +if test "x$ac_cv_func_getpwnam_r" = xyes; then : -#ifdef __STDC__ -# include -#else -# include -#endif + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5 +$as_echo_n "checking for getpwnam_r with 5 args... " >&6; } +if ${tcl_cv_api_getpwnam_r_5+:} false; then : + $as_echo_n "(cached) " >&6 +else -#undef realpath + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char realpath (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_realpath) || defined (__stub___realpath) -choke me -#else -char (*f) () = realpath; -#endif -#ifdef __cplusplus -} -#endif + #include + #include int main () { -return f != realpath; + + char *name; + struct passwd pw, *pwp; + char buf[512]; + int buflen = 512; + + (void) getpwnam_r(name, &pw, buf, buflen, &pwp); + ; 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 - ac_cv_func_realpath=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getpwnam_r_5=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_realpath=no + tcl_cv_api_getpwnam_r_5=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_func_realpath" >&5 -echo "${ECHO_T}$ac_cv_func_realpath" >&6 -if test $ac_cv_func_realpath = yes; then - : -else - -cat >>confdefs.h <<\_ACEOF -#define NO_REALPATH 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_5" >&5 +$as_echo "$tcl_cv_api_getpwnam_r_5" >&6; } + tcl_ok=$tcl_cv_api_getpwnam_r_5 + if test "$tcl_ok" = yes; then -fi +$as_echo "#define HAVE_GETPWNAM_R_5 1" >>confdefs.h + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 4 args" >&5 +$as_echo_n "checking for getpwnam_r with 4 args... " >&6; } +if ${tcl_cv_api_getpwnam_r_4+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ - NEED_FAKE_RFC2553=0 + #include + #include +int +main () +{ + char *name; + struct passwd pw; + char buf[512]; + int buflen = 512; + (void)getpwnam_r(name, &pw, buf, buflen); -for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; ; 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 - eval "$as_ac_var=yes" +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getpwnam_r_4=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" + tcl_cv_api_getpwnam_r_4=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_4" >&5 +$as_echo "$tcl_cv_api_getpwnam_r_4" >&6; } + tcl_ok=$tcl_cv_api_getpwnam_r_4 + if test "$tcl_ok" = yes; then + +$as_echo "#define HAVE_GETPWNAM_R_4 1" >>confdefs.h + + fi + fi + if test "$tcl_ok" = yes; then + +$as_echo "#define HAVE_GETPWNAM_R 1" >>confdefs.h + + fi -else - NEED_FAKE_RFC2553=1 fi -done - echo "$as_me:$LINENO: checking for struct addrinfo" >&5 -echo $ECHO_N "checking for struct addrinfo... $ECHO_C" >&6 -if test "${ac_cv_type_struct_addrinfo+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r" +if test "x$ac_cv_func_getgrgid_r" = xyes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5 +$as_echo_n "checking for getgrgid_r with 5 args... " >&6; } +if ${tcl_cv_api_getgrgid_r_5+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -#include -#include -#include + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + #include + #include int main () { -if ((struct addrinfo *) 0) - return 0; -if (sizeof (struct addrinfo)) - return 0; + + gid_t gid; + struct group gr, *grp; + char buf[512]; + int buflen = 512; + + (void) getgrgid_r(gid, &gr, buf, buflen, &grp); + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_struct_addrinfo=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getgrgid_r_5=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_struct_addrinfo=no + tcl_cv_api_getgrgid_r_5=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_type_struct_addrinfo" >&5 -echo "${ECHO_T}$ac_cv_type_struct_addrinfo" >&6 -if test $ac_cv_type_struct_addrinfo = yes; then - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_ADDRINFO 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_5" >&5 +$as_echo "$tcl_cv_api_getgrgid_r_5" >&6; } + tcl_ok=$tcl_cv_api_getgrgid_r_5 + if test "$tcl_ok" = yes; then +$as_echo "#define HAVE_GETGRGID_R_5 1" >>confdefs.h + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 4 args" >&5 +$as_echo_n "checking for getgrgid_r with 4 args... " >&6; } +if ${tcl_cv_api_getgrgid_r_4+:} false; then : + $as_echo_n "(cached) " >&6 else - NEED_FAKE_RFC2553=1 -fi -echo "$as_me:$LINENO: checking for struct in6_addr" >&5 -echo $ECHO_N "checking for struct in6_addr... $ECHO_C" >&6 -if test "${ac_cv_type_struct_in6_addr+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. */ -#include -#include -#include -#include + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + #include + #include int main () { -if ((struct in6_addr *) 0) - return 0; -if (sizeof (struct in6_addr)) - return 0; + + gid_t gid; + struct group gr; + char buf[512]; + int buflen = 512; + + (void)getgrgid_r(gid, &gr, buf, buflen); + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_struct_in6_addr=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getgrgid_r_4=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_struct_in6_addr=no + tcl_cv_api_getgrgid_r_4=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_type_struct_in6_addr" >&5 -echo "${ECHO_T}$ac_cv_type_struct_in6_addr" >&6 -if test $ac_cv_type_struct_in6_addr = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_4" >&5 +$as_echo "$tcl_cv_api_getgrgid_r_4" >&6; } + tcl_ok=$tcl_cv_api_getgrgid_r_4 + if test "$tcl_ok" = yes; then -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IN6_ADDR 1 -_ACEOF +$as_echo "#define HAVE_GETGRGID_R_4 1" >>confdefs.h + + fi + fi + if test "$tcl_ok" = yes; then +$as_echo "#define HAVE_GETGRGID_R 1" >>confdefs.h + + fi -else - NEED_FAKE_RFC2553=1 fi -echo "$as_me:$LINENO: checking for struct sockaddr_in6" >&5 -echo $ECHO_N "checking for struct sockaddr_in6... $ECHO_C" >&6 -if test "${ac_cv_type_struct_sockaddr_in6+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + + ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r" +if test "x$ac_cv_func_getgrnam_r" = xyes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5 +$as_echo_n "checking for getgrnam_r with 5 args... " >&6; } +if ${tcl_cv_api_getgrnam_r_5+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -#include -#include -#include + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + #include + #include int main () { -if ((struct sockaddr_in6 *) 0) - return 0; -if (sizeof (struct sockaddr_in6)) - return 0; + + char *name; + struct group gr, *grp; + char buf[512]; + int buflen = 512; + + (void) getgrnam_r(name, &gr, buf, buflen, &grp); + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_struct_sockaddr_in6=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getgrnam_r_5=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_struct_sockaddr_in6=no + tcl_cv_api_getgrnam_r_5=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_in6" >&5 -echo "${ECHO_T}$ac_cv_type_struct_sockaddr_in6" >&6 -if test $ac_cv_type_struct_sockaddr_in6 = yes; then - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_SOCKADDR_IN6 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_5" >&5 +$as_echo "$tcl_cv_api_getgrnam_r_5" >&6; } + tcl_ok=$tcl_cv_api_getgrnam_r_5 + if test "$tcl_ok" = yes; then +$as_echo "#define HAVE_GETGRNAM_R_5 1" >>confdefs.h + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 4 args" >&5 +$as_echo_n "checking for getgrnam_r with 4 args... " >&6; } +if ${tcl_cv_api_getgrnam_r_4+:} false; then : + $as_echo_n "(cached) " >&6 else - NEED_FAKE_RFC2553=1 -fi -echo "$as_me:$LINENO: checking for struct sockaddr_storage" >&5 -echo $ECHO_N "checking for struct sockaddr_storage... $ECHO_C" >&6 -if test "${ac_cv_type_struct_sockaddr_storage+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. */ -#include -#include -#include -#include + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + #include + #include int main () { -if ((struct sockaddr_storage *) 0) - return 0; -if (sizeof (struct sockaddr_storage)) - return 0; + + char *name; + struct group gr; + char buf[512]; + int buflen = 512; + + (void)getgrnam_r(name, &gr, buf, buflen); + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_struct_sockaddr_storage=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_getgrnam_r_4=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_struct_sockaddr_storage=no + tcl_cv_api_getgrnam_r_4=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_storage" >&5 -echo "${ECHO_T}$ac_cv_type_struct_sockaddr_storage" >&6 -if test $ac_cv_type_struct_sockaddr_storage = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_4" >&5 +$as_echo "$tcl_cv_api_getgrnam_r_4" >&6; } + tcl_ok=$tcl_cv_api_getgrnam_r_4 + if test "$tcl_ok" = yes; then -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_SOCKADDR_STORAGE 1 -_ACEOF +$as_echo "#define HAVE_GETGRNAM_R_4 1" >>confdefs.h + + fi + fi + if test "$tcl_ok" = yes; then +$as_echo "#define HAVE_GETGRNAM_R 1" >>confdefs.h + + fi -else - NEED_FAKE_RFC2553=1 fi -if test "x$NEED_FAKE_RFC2553" = "x1"; then + if test "`uname -s`" = "Darwin" && \ + test "`uname -r | awk -F. '{print $1}'`" -gt 5; then + # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX + # are actually MT-safe as they always return pointers + # from TSD instead of static storage. -cat >>confdefs.h <<\_ACEOF -#define NEED_FAKE_RFC2553 1 -_ACEOF +$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h - case $LIBOBJS in - "fake-rfc2553.$ac_objext" | \ - *" fake-rfc2553.$ac_objext" | \ - "fake-rfc2553.$ac_objext "* | \ - *" fake-rfc2553.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;; -esac - echo "$as_me:$LINENO: checking for strlcpy" >&5 -echo $ECHO_N "checking for strlcpy... $ECHO_C" >&6 -if test "${ac_cv_func_strlcpy+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. */ -/* Define strlcpy to an innocuous variant, in case declares strlcpy. - For example, HP-UX 11i declares gettimeofday. */ -#define strlcpy innocuous_strlcpy +$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strlcpy (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ -#ifdef __STDC__ -# include -#else -# include -#endif + elif test "`uname -s`" = "HP-UX" && \ + test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then + # Starting with HPUX 11.00 (we believe), gethostbyX + # are actually MT-safe as they always return pointers + # from TSD instead of static storage. -#undef strlcpy +$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strlcpy (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strlcpy) || defined (__stub___strlcpy) -choke me -#else -char (*f) () = strlcpy; -#endif -#ifdef __cplusplus -} -#endif + +$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h + + + else + ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r" +if test "x$ac_cv_func_gethostbyname_r" = xyes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5 +$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; } +if ${tcl_cv_api_gethostbyname_r_6+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include int main () { -return f != strlcpy; - ; - 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 - ac_cv_func_strlcpy=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strlcpy=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strlcpy" >&5 -echo "${ECHO_T}$ac_cv_func_strlcpy" >&6 - -fi - - -#-------------------------------------------------------------------- -# Look for thread-safe variants of some library functions. -#-------------------------------------------------------------------- - -if test "${TCL_THREADS}" = 1; then - echo "$as_me:$LINENO: checking for getpwuid_r" >&5 -echo $ECHO_N "checking for getpwuid_r... $ECHO_C" >&6 -if test "${ac_cv_func_getpwuid_r+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. */ -/* Define getpwuid_r to an innocuous variant, in case declares getpwuid_r. - For example, HP-UX 11i declares gettimeofday. */ -#define getpwuid_r innocuous_getpwuid_r - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char getpwuid_r (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif -#undef getpwuid_r + char *name; + struct hostent *he, *res; + char buffer[2048]; + int buflen = 2048; + int h_errnop; -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char getpwuid_r (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_getpwuid_r) || defined (__stub___getpwuid_r) -choke me -#else -char (*f) () = getpwuid_r; -#endif -#ifdef __cplusplus -} -#endif + (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); -int -main () -{ -return f != getpwuid_r; ; 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 - ac_cv_func_getpwuid_r=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_gethostbyname_r_6=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_getpwuid_r=no + tcl_cv_api_gethostbyname_r_6=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_func_getpwuid_r" >&5 -echo "${ECHO_T}$ac_cv_func_getpwuid_r" >&6 -if test $ac_cv_func_getpwuid_r = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_6" >&5 +$as_echo "$tcl_cv_api_gethostbyname_r_6" >&6; } + tcl_ok=$tcl_cv_api_gethostbyname_r_6 + if test "$tcl_ok" = yes; then - echo "$as_me:$LINENO: checking for getpwuid_r with 5 args" >&5 -echo $ECHO_N "checking for getpwuid_r with 5 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getpwuid_r_5+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +$as_echo "#define HAVE_GETHOSTBYNAME_R_6 1" >>confdefs.h + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 5 args" >&5 +$as_echo_n "checking for gethostbyname_r with 5 args... " >&6; } +if ${tcl_cv_api_gethostbyname_r_5+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - #include - #include + #include int main () { - uid_t uid; - struct passwd pw, *pwp; - char buf[512]; - int buflen = 512; + char *name; + struct hostent *he; + char buffer[2048]; + int buflen = 2048; + int h_errnop; - (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); + (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getpwuid_r_5=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_gethostbyname_r_5=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getpwuid_r_5=no + tcl_cv_api_gethostbyname_r_5=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_5" >&5 -echo "${ECHO_T}$tcl_cv_api_getpwuid_r_5" >&6 - tcl_ok=$tcl_cv_api_getpwuid_r_5 - if test "$tcl_ok" = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_5" >&5 +$as_echo "$tcl_cv_api_gethostbyname_r_5" >&6; } + tcl_ok=$tcl_cv_api_gethostbyname_r_5 + if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETPWUID_R_5 1 -_ACEOF +$as_echo "#define HAVE_GETHOSTBYNAME_R_5 1" >>confdefs.h - else - echo "$as_me:$LINENO: checking for getpwuid_r with 4 args" >&5 -echo $ECHO_N "checking for getpwuid_r with 4 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getpwuid_r_4+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 3 args" >&5 +$as_echo_n "checking for gethostbyname_r with 3 args... " >&6; } +if ${tcl_cv_api_gethostbyname_r_3+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - #include - #include + #include int main () { - uid_t uid; - struct passwd pw; - char buf[512]; - int buflen = 512; + char *name; + struct hostent *he; + struct hostent_data data; - (void)getpwnam_r(uid, &pw, buf, buflen); + (void) gethostbyname_r(name, he, &data); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getpwuid_r_4=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_gethostbyname_r_3=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getpwuid_r_4=no + tcl_cv_api_gethostbyname_r_3=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_4" >&5 -echo "${ECHO_T}$tcl_cv_api_getpwuid_r_4" >&6 - tcl_ok=$tcl_cv_api_getpwuid_r_4 - if test "$tcl_ok" = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_3" >&5 +$as_echo "$tcl_cv_api_gethostbyname_r_3" >&6; } + tcl_ok=$tcl_cv_api_gethostbyname_r_3 + if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETPWUID_R_4 1 -_ACEOF +$as_echo "#define HAVE_GETHOSTBYNAME_R_3 1" >>confdefs.h + fi fi fi if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETPWUID_R 1 -_ACEOF +$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h fi fi - echo "$as_me:$LINENO: checking for getpwnam_r" >&5 -echo $ECHO_N "checking for getpwnam_r... $ECHO_C" >&6 -if test "${ac_cv_func_getpwnam_r+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. */ -/* Define getpwnam_r to an innocuous variant, in case declares getpwnam_r. - For example, HP-UX 11i declares gettimeofday. */ -#define getpwnam_r innocuous_getpwnam_r - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char getpwnam_r (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef getpwnam_r - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char getpwnam_r (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_getpwnam_r) || defined (__stub___getpwnam_r) -choke me -#else -char (*f) () = getpwnam_r; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != getpwnam_r; - ; - 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 - ac_cv_func_getpwnam_r=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_getpwnam_r=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_getpwnam_r" >&5 -echo "${ECHO_T}$ac_cv_func_getpwnam_r" >&6 -if test $ac_cv_func_getpwnam_r = yes; then + ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r" +if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then : - echo "$as_me:$LINENO: checking for getpwnam_r with 5 args" >&5 -echo $ECHO_N "checking for getpwnam_r with 5 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getpwnam_r_5+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5 +$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; } +if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - #include - #include + #include int main () { - char *name; - struct passwd pw, *pwp; - char buf[512]; - int buflen = 512; + char *addr; + int length; + int type; + struct hostent *result; + char buffer[2048]; + int buflen = 2048; + int h_errnop; - (void) getpwnam_r(name, &pw, buf, buflen, &pwp); + (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, + &h_errnop); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getpwnam_r_5=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_gethostbyaddr_r_7=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getpwnam_r_5=no + tcl_cv_api_gethostbyaddr_r_7=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_5" >&5 -echo "${ECHO_T}$tcl_cv_api_getpwnam_r_5" >&6 - tcl_ok=$tcl_cv_api_getpwnam_r_5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 +$as_echo "$tcl_cv_api_gethostbyaddr_r_7" >&6; } + tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETPWNAM_R_5 1 -_ACEOF +$as_echo "#define HAVE_GETHOSTBYADDR_R_7 1" >>confdefs.h else - echo "$as_me:$LINENO: checking for getpwnam_r with 4 args" >&5 -echo $ECHO_N "checking for getpwnam_r with 4 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getpwnam_r_4+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 8 args" >&5 +$as_echo_n "checking for gethostbyaddr_r with 8 args... " >&6; } +if ${tcl_cv_api_gethostbyaddr_r_8+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - #include - #include + #include int main () { - char *name; - struct passwd pw; - char buf[512]; - int buflen = 512; + char *addr; + int length; + int type; + struct hostent *result, *resultp; + char buffer[2048]; + int buflen = 2048; + int h_errnop; - (void)getpwnam_r(name, &pw, buf, buflen); + (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, + &resultp, &h_errnop); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getpwnam_r_4=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_api_gethostbyaddr_r_8=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getpwnam_r_4=no + tcl_cv_api_gethostbyaddr_r_8=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_4" >&5 -echo "${ECHO_T}$tcl_cv_api_getpwnam_r_4" >&6 - tcl_ok=$tcl_cv_api_getpwnam_r_4 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 +$as_echo "$tcl_cv_api_gethostbyaddr_r_8" >&6; } + tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETPWNAM_R_4 1 -_ACEOF +$as_echo "#define HAVE_GETHOSTBYADDR_R_8 1" >>confdefs.h fi fi if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETPWNAM_R 1 -_ACEOF +$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h fi fi - echo "$as_me:$LINENO: checking for getgrgid_r" >&5 -echo $ECHO_N "checking for getgrgid_r... $ECHO_C" >&6 -if test "${ac_cv_func_getgrgid_r+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + fi +fi + +#--------------------------------------------------------------------------- +# Check for serial port interface. +# +# termios.h is present on all POSIX systems. +# sys/ioctl.h is almost always present, though what it contains +# is system-specific. +# sys/modem.h is needed on HP-UX. +#--------------------------------------------------------------------------- + +for ac_header in termios.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default" +if test "x$ac_cv_header_termios_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TERMIOS_H 1 _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define getgrgid_r to an innocuous variant, in case declares getgrgid_r. - For example, HP-UX 11i declares gettimeofday. */ -#define getgrgid_r innocuous_getgrgid_r -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char getgrgid_r (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ +fi -#ifdef __STDC__ -# include -#else -# include -#endif +done -#undef getgrgid_r +for ac_header in sys/ioctl.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_ioctl_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_IOCTL_H 1 +_ACEOF -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char getgrgid_r (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_getgrgid_r) || defined (__stub___getgrgid_r) -choke me -#else -char (*f) () = getgrgid_r; -#endif -#ifdef __cplusplus -} -#endif +fi + +done + +for ac_header in sys/modem.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/modem.h" "ac_cv_header_sys_modem_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_modem_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_MODEM_H 1 +_ACEOF + +fi + +done + + +#-------------------------------------------------------------------- +# Include sys/select.h if it exists and if it supplies things +# that appear to be useful and aren't already in sys/types.h. +# This appears to be true only on the RS/6000 under AIX. Some +# systems like OSF/1 have a sys/select.h that's of no use, and +# other systems like SCO UNIX have a sys/select.h that's +# pernicious. If "fd_set" isn't defined anywhere then set a +# special flag. +#-------------------------------------------------------------------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_set in sys/types" >&5 +$as_echo_n "checking for fd_set in sys/types... " >&6; } +if ${tcl_cv_type_fd_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include int main () { -return f != getgrgid_r; +fd_set readMask, writeMask; ; 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 - ac_cv_func_getgrgid_r=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_type_fd_set=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_getgrgid_r=no + tcl_cv_type_fd_set=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_func_getgrgid_r" >&5 -echo "${ECHO_T}$ac_cv_func_getgrgid_r" >&6 -if test $ac_cv_func_getgrgid_r = yes; then - - echo "$as_me:$LINENO: checking for getgrgid_r with 5 args" >&5 -echo $ECHO_N "checking for getgrgid_r with 5 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getgrgid_r_5+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_fd_set" >&5 +$as_echo "$tcl_cv_type_fd_set" >&6; } +tcl_ok=$tcl_cv_type_fd_set +if test $tcl_ok = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_mask in sys/select" >&5 +$as_echo_n "checking for fd_mask in sys/select... " >&6; } +if ${tcl_cv_grep_fd_mask+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ +#include - #include - #include +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "fd_mask" >/dev/null 2>&1; then : + tcl_cv_grep_fd_mask=present +else + tcl_cv_grep_fd_mask=missing +fi +rm -f conftest* -int -main () -{ +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5 +$as_echo "$tcl_cv_grep_fd_mask" >&6; } + if test $tcl_cv_grep_fd_mask = present; then - gid_t gid; - struct group gr, *grp; - char buf[512]; - int buflen = 512; +$as_echo "#define HAVE_SYS_SELECT_H 1" >>confdefs.h - (void) getgrgid_r(gid, &gr, buf, buflen, &grp); + tcl_ok=yes + fi +fi +if test $tcl_ok = no; then - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getgrgid_r_5=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +$as_echo "#define NO_FD_SET 1" >>confdefs.h -tcl_cv_api_getgrgid_r_5=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_5" >&5 -echo "${ECHO_T}$tcl_cv_api_getgrgid_r_5" >&6 - tcl_ok=$tcl_cv_api_getgrgid_r_5 - if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETGRGID_R_5 1 -_ACEOF +#------------------------------------------------------------------------------ +# Find out all about time handling differences. +#------------------------------------------------------------------------------ - else - echo "$as_me:$LINENO: checking for getgrgid_r with 4 args" >&5 -echo $ECHO_N "checking for getgrgid_r with 4 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getgrgid_r_4+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + for ac_header in sys/time.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/time.h" "ac_cv_header_sys_time_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_time_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_TIME_H 1 _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - #include - #include +fi + +done + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 +$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } +if ${ac_cv_header_time+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include int main () { - - gid_t gid; - struct group gr; - char buf[512]; - int buflen = 512; - - (void)getgrgid_r(gid, &gr, buf, buflen); - +if ((struct tm *) 0) +return 0; ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getgrgid_r_4=yes +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_time=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getgrgid_r_4=no + ac_cv_header_time=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_4" >&5 -echo "${ECHO_T}$tcl_cv_api_getgrgid_r_4" >&6 - tcl_ok=$tcl_cv_api_getgrgid_r_4 - if test "$tcl_ok" = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5 +$as_echo "$ac_cv_header_time" >&6; } +if test $ac_cv_header_time = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETGRGID_R_4 1 -_ACEOF +$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h - fi - fi - if test "$tcl_ok" = yes; then +fi -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETGRGID_R 1 -_ACEOF - fi + for ac_func in gmtime_r localtime_r mktime +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF fi +done - echo "$as_me:$LINENO: checking for getgrnam_r" >&5 -echo $ECHO_N "checking for getgrnam_r... $ECHO_C" >&6 -if test "${ac_cv_func_getgrnam_r+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_tzadj in struct tm" >&5 +$as_echo_n "checking tm_tzadj in struct tm... " >&6; } +if ${tcl_cv_member_tm_tzadj+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define getgrnam_r to an innocuous variant, in case declares getgrnam_r. - For example, HP-UX 11i declares gettimeofday. */ -#define getgrnam_r innocuous_getgrnam_r -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char getgrnam_r (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +struct tm tm; tm.tm_tzadj; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_member_tm_tzadj=yes +else + tcl_cv_member_tm_tzadj=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_tzadj" >&5 +$as_echo "$tcl_cv_member_tm_tzadj" >&6; } + if test $tcl_cv_member_tm_tzadj = yes ; then -#ifdef __STDC__ -# include -#else -# include -#endif +$as_echo "#define HAVE_TM_TZADJ 1" >>confdefs.h -#undef getgrnam_r + fi -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char getgrnam_r (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_getgrnam_r) || defined (__stub___getgrnam_r) -choke me -#else -char (*f) () = getgrnam_r; -#endif -#ifdef __cplusplus -} -#endif + { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_gmtoff in struct tm" >&5 +$as_echo_n "checking tm_gmtoff in struct tm... " >&6; } +if ${tcl_cv_member_tm_gmtoff+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include int main () { -return f != getgrnam_r; +struct tm tm; tm.tm_gmtoff; ; 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 - ac_cv_func_getgrnam_r=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_member_tm_gmtoff=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_getgrnam_r=no + tcl_cv_member_tm_gmtoff=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_func_getgrnam_r" >&5 -echo "${ECHO_T}$ac_cv_func_getgrnam_r" >&6 -if test $ac_cv_func_getgrnam_r = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_gmtoff" >&5 +$as_echo "$tcl_cv_member_tm_gmtoff" >&6; } + if test $tcl_cv_member_tm_gmtoff = yes ; then - echo "$as_me:$LINENO: checking for getgrnam_r with 5 args" >&5 -echo $ECHO_N "checking for getgrnam_r with 5 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getgrnam_r_5+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else +$as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ + fi - #include - #include + # + # Its important to include time.h in this check, as some systems + # (like convex) have timezone functions, etc. + # + { $as_echo "$as_me:${as_lineno-$LINENO}: checking long timezone variable" >&5 +$as_echo_n "checking long timezone variable... " >&6; } +if ${tcl_cv_timezone_long+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include int main () { - - char *name; - struct group gr, *grp; - char buf[512]; - int buflen = 512; - - (void) getgrnam_r(name, &gr, buf, buflen, &grp); - +extern long timezone; + timezone += 1; + exit (0); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getgrnam_r_5=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_timezone_long=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getgrnam_r_5=no + tcl_cv_timezone_long=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_5" >&5 -echo "${ECHO_T}$tcl_cv_api_getgrnam_r_5" >&6 - tcl_ok=$tcl_cv_api_getgrnam_r_5 - if test "$tcl_ok" = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_long" >&5 +$as_echo "$tcl_cv_timezone_long" >&6; } + if test $tcl_cv_timezone_long = yes ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETGRNAM_R_5 1 -_ACEOF +$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h else - echo "$as_me:$LINENO: checking for getgrnam_r with 4 args" >&5 -echo $ECHO_N "checking for getgrnam_r with 4 args... $ECHO_C" >&6 -if test "${tcl_cv_api_getgrnam_r_4+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + # + # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. + # + { $as_echo "$as_me:${as_lineno-$LINENO}: checking time_t timezone variable" >&5 +$as_echo_n "checking time_t timezone variable... " >&6; } +if ${tcl_cv_timezone_time+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - - #include - #include - +#include int main () { - - char *name; - struct group gr; - char buf[512]; - int buflen = 512; - - (void)getgrnam_r(name, &gr, buf, buflen); - +extern time_t timezone; + timezone += 1; + exit (0); ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_getgrnam_r_4=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_timezone_time=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_getgrnam_r_4=no + tcl_cv_timezone_time=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_4" >&5 -echo "${ECHO_T}$tcl_cv_api_getgrnam_r_4" >&6 - tcl_ok=$tcl_cv_api_getgrnam_r_4 - if test "$tcl_ok" = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_time" >&5 +$as_echo "$tcl_cv_timezone_time" >&6; } + if test $tcl_cv_timezone_time = yes ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETGRNAM_R_4 1 -_ACEOF +$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h fi fi - if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETGRNAM_R 1 -_ACEOF - fi - -fi +#-------------------------------------------------------------------- +# Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But +# we might be able to use fstatfs instead. Some systems (OpenBSD?) also +# lack blkcnt_t. +#-------------------------------------------------------------------- - if test "`uname -s`" = "Darwin" && \ - test "`uname -r | awk -F. '{print $1}'`" -gt 5; then - # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX - # are actually MT-safe as they always return pointers - # from TSD instead of static storage. +if test "$ac_cv_cygwin" != "yes"; then + ac_fn_c_check_member "$LINENO" "struct stat" "st_blocks" "ac_cv_member_struct_stat_st_blocks" "$ac_includes_default" +if test "x$ac_cv_member_struct_stat_st_blocks" = xyes; then : -cat >>confdefs.h <<\_ACEOF -#define HAVE_MTSAFE_GETHOSTBYNAME 1 +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_BLOCKS 1 _ACEOF -cat >>confdefs.h <<\_ACEOF -#define HAVE_MTSAFE_GETHOSTBYADDR 1 +fi +ac_fn_c_check_member "$LINENO" "struct stat" "st_blksize" "ac_cv_member_struct_stat_st_blksize" "$ac_includes_default" +if test "x$ac_cv_member_struct_stat_st_blksize" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_BLKSIZE 1 _ACEOF - elif test "`uname -s`" = "HP-UX" && \ - test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then - # Starting with HPUX 11.00 (we believe), gethostbyX - # are actually MT-safe as they always return pointers - # from TSD instead of static storage. +fi + +fi +ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default" +if test "x$ac_cv_type_blkcnt_t" = xyes; then : -cat >>confdefs.h <<\_ACEOF -#define HAVE_MTSAFE_GETHOSTBYNAME 1 +cat >>confdefs.h <<_ACEOF +#define HAVE_BLKCNT_T 1 _ACEOF -cat >>confdefs.h <<\_ACEOF -#define HAVE_MTSAFE_GETHOSTBYADDR 1 -_ACEOF +fi +ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs" +if test "x$ac_cv_func_fstatfs" = xyes; then : - else - echo "$as_me:$LINENO: checking for gethostbyname_r" >&5 -echo $ECHO_N "checking for gethostbyname_r... $ECHO_C" >&6 -if test "${ac_cv_func_gethostbyname_r+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. */ -/* Define gethostbyname_r to an innocuous variant, in case declares gethostbyname_r. - For example, HP-UX 11i declares gettimeofday. */ -#define gethostbyname_r innocuous_gethostbyname_r -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char gethostbyname_r (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ +$as_echo "#define NO_FSTATFS 1" >>confdefs.h -#ifdef __STDC__ -# include -#else -# include -#endif +fi -#undef gethostbyname_r -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char gethostbyname_r (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_gethostbyname_r) || defined (__stub___gethostbyname_r) -choke me -#else -char (*f) () = gethostbyname_r; -#endif -#ifdef __cplusplus -} -#endif +#-------------------------------------------------------------------- +# Some system have no memcmp or it does not work with 8 bit data, this +# checks it and add memcmp.o to LIBOBJS if needed +#-------------------------------------------------------------------- +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5 +$as_echo_n "checking for working memcmp... " >&6; } +if ${ac_cv_func_memcmp_working+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_func_memcmp_working=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default int main () { -return f != gethostbyname_r; + + /* Some versions of memcmp are not 8-bit clean. */ + char c0 = '\100', c1 = '\200', c2 = '\201'; + if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) + return 1; + + /* The Next x86 OpenStep bug shows up only when comparing 16 bytes + or more and with at least one buffer not starting on a 4-byte boundary. + William Lewis provided this test program. */ + { + char foo[21]; + char bar[21]; + int i; + for (i = 0; i < 4; i++) + { + char *a = foo + i; + char *b = bar + i; + strcpy (a, "--------01111111"); + strcpy (b, "--------10000000"); + if (memcmp (a, b, 16) >= 0) + return 1; + } + return 0; + } + ; 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 - ac_cv_func_gethostbyname_r=yes +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_memcmp_working=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_gethostbyname_r=no + ac_cv_func_memcmp_working=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname_r" >&5 -echo "${ECHO_T}$ac_cv_func_gethostbyname_r" >&6 -if test $ac_cv_func_gethostbyname_r = yes; then - - echo "$as_me:$LINENO: checking for gethostbyname_r with 6 args" >&5 -echo $ECHO_N "checking for gethostbyname_r with 6 args... $ECHO_C" >&6 -if test "${tcl_cv_api_gethostbyname_r_6+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. */ +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5 +$as_echo "$ac_cv_func_memcmp_working" >&6; } +test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in + *" memcmp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" + ;; +esac - #include -int -main () -{ - char *name; - struct hostent *he, *res; - char buffer[2048]; - int buflen = 2048; - int h_errnop; +#-------------------------------------------------------------------- +# Some system like SunOS 4 and other BSD like systems have no memmove +# (we assume they have bcopy instead). {The replacement define is in +# compat/string.h} +#-------------------------------------------------------------------- - (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); +ac_fn_c_check_func "$LINENO" "memmove" "ac_cv_func_memmove" +if test "x$ac_cv_func_memmove" = xyes; then : - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_gethostbyname_r_6=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -tcl_cv_api_gethostbyname_r_6=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_6" >&5 -echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_6" >&6 - tcl_ok=$tcl_cv_api_gethostbyname_r_6 - if test "$tcl_ok" = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYNAME_R_6 1 -_ACEOF +$as_echo "#define NO_MEMMOVE 1" >>confdefs.h - else - echo "$as_me:$LINENO: checking for gethostbyname_r with 5 args" >&5 -echo $ECHO_N "checking for gethostbyname_r with 5 args... $ECHO_C" >&6 -if test "${tcl_cv_api_gethostbyname_r_5+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. */ +$as_echo "#define NO_STRING_H 1" >>confdefs.h - #include +fi -int -main () -{ - char *name; - struct hostent *he; - char buffer[2048]; - int buflen = 2048; - int h_errnop; +#-------------------------------------------------------------------- +# On some systems strstr is broken: it returns a pointer even even if +# the original string is empty. +#-------------------------------------------------------------------- - (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); - ; - return 0; + ac_fn_c_check_func "$LINENO" "strstr" "ac_cv_func_strstr" +if test "x$ac_cv_func_strstr" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 +fi + + if test "$tcl_ok" = 1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5 +$as_echo_n "checking proper strstr implementation... " >&6; } +if ${tcl_cv_strstr_unbroken+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + tcl_cv_strstr_unbroken=unknown +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int main() { + extern int strstr(); + exit(strstr("\0test", "test") ? 1 : 0); } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_gethostbyname_r_5=yes +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_strstr_unbroken=ok else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_gethostbyname_r_5=no + tcl_cv_strstr_unbroken=broken fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_5" >&5 -echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_5" >&6 - tcl_ok=$tcl_cv_api_gethostbyname_r_5 - if test "$tcl_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYNAME_R_5 1 -_ACEOF +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5 +$as_echo "$tcl_cv_strstr_unbroken" >&6; } + if test "$tcl_cv_strstr_unbroken" = "ok"; then + tcl_ok=1 else - echo "$as_me:$LINENO: checking for gethostbyname_r with 3 args" >&5 -echo $ECHO_N "checking for gethostbyname_r with 3 args... $ECHO_C" >&6 -if test "${tcl_cv_api_gethostbyname_r_3+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else + tcl_ok=0 + fi + fi + if test "$tcl_ok" = 0; then + case " $LIBOBJS " in + *" strstr.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strstr.$ac_objext" + ;; +esac - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ + USE_COMPAT=1 + fi - #include -int -main () -{ +#-------------------------------------------------------------------- +# Check for strtoul function. This is tricky because under some +# versions of AIX strtoul returns an incorrect terminator +# pointer for the string "0". +#-------------------------------------------------------------------- - char *name; - struct hostent *he; - struct hostent_data data; - (void) gethostbyname_r(name, he, &data); + ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul" +if test "x$ac_cv_func_strtoul" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 +fi - ; - return 0; + if test "$tcl_ok" = 1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5 +$as_echo_n "checking proper strtoul implementation... " >&6; } +if ${tcl_cv_strtoul_unbroken+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + tcl_cv_strtoul_unbroken=unknown +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int main() { + extern int strtoul(); + char *term, *string = "0"; + exit(strtoul(string,&term,0) != 0 || term != string+1); } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_gethostbyname_r_3=yes +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_strtoul_unbroken=ok else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_gethostbyname_r_3=no + tcl_cv_strtoul_unbroken=broken fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_3" >&5 -echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_3" >&6 - tcl_ok=$tcl_cv_api_gethostbyname_r_3 - if test "$tcl_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYNAME_R_3 1 -_ACEOF - fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5 +$as_echo "$tcl_cv_strtoul_unbroken" >&6; } + if test "$tcl_cv_strtoul_unbroken" = "ok"; then + tcl_ok=1 + else + tcl_ok=0 fi fi - if test "$tcl_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYNAME_R 1 -_ACEOF + if test "$tcl_ok" = 0; then + case " $LIBOBJS " in + *" strtoul.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" + ;; +esac + USE_COMPAT=1 fi + +#-------------------------------------------------------------------- +# Check for the strtod function. This is tricky because in some +# versions of Linux strtod mis-parses strings starting with "+". +#-------------------------------------------------------------------- + + + ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod" +if test "x$ac_cv_func_strtod" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 fi - echo "$as_me:$LINENO: checking for gethostbyaddr_r" >&5 -echo $ECHO_N "checking for gethostbyaddr_r... $ECHO_C" >&6 -if test "${ac_cv_func_gethostbyaddr_r+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if test "$tcl_ok" = 1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtod implementation" >&5 +$as_echo_n "checking proper strtod implementation... " >&6; } +if ${tcl_cv_strtod_unbroken+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define gethostbyaddr_r to an innocuous variant, in case declares gethostbyaddr_r. - For example, HP-UX 11i declares gettimeofday. */ -#define gethostbyaddr_r innocuous_gethostbyaddr_r - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char gethostbyaddr_r (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef gethostbyaddr_r - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char gethostbyaddr_r (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_gethostbyaddr_r) || defined (__stub___gethostbyaddr_r) -choke me -#else -char (*f) () = gethostbyaddr_r; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != gethostbyaddr_r; - ; - 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 - ac_cv_func_gethostbyaddr_r=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_gethostbyaddr_r=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyaddr_r" >&5 -echo "${ECHO_T}$ac_cv_func_gethostbyaddr_r" >&6 -if test $ac_cv_func_gethostbyaddr_r = yes; then - - echo "$as_me:$LINENO: checking for gethostbyaddr_r with 7 args" >&5 -echo $ECHO_N "checking for gethostbyaddr_r with 7 args... $ECHO_C" >&6 -if test "${tcl_cv_api_gethostbyaddr_r_7+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if test "$cross_compiling" = yes; then : + tcl_cv_strtod_unbroken=unknown else - - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - - #include - -int -main () -{ - - char *addr; - int length; - int type; - struct hostent *result; - char buffer[2048]; - int buflen = 2048; - int h_errnop; - - (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, - &h_errnop); - - ; - return 0; +int main() { + extern double strtod(); + char *term, *string = " +69"; + exit(strtod(string,&term) != 69 || term != string+4); } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_gethostbyaddr_r_7=yes +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_strtod_unbroken=ok else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_gethostbyaddr_r_7=no + tcl_cv_strtod_unbroken=broken fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 -echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_7" >&6 - tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 - if test "$tcl_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYADDR_R_7 1 -_ACEOF - - else - echo "$as_me:$LINENO: checking for gethostbyaddr_r with 8 args" >&5 -echo $ECHO_N "checking for gethostbyaddr_r with 8 args... $ECHO_C" >&6 -if test "${tcl_cv_api_gethostbyaddr_r_8+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. */ - - #include - -int -main () -{ - char *addr; - int length; - int type; - struct hostent *result, *resultp; - char buffer[2048]; - int buflen = 2048; - int h_errnop; - - (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, - &resultp, &h_errnop); - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_api_gethostbyaddr_r_8=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_gethostbyaddr_r_8=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 -echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_8" >&6 - tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 - if test "$tcl_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYADDR_R_8 1 -_ACEOF - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_unbroken" >&5 +$as_echo "$tcl_cv_strtod_unbroken" >&6; } + if test "$tcl_cv_strtod_unbroken" = "ok"; then + tcl_ok=1 + else + tcl_ok=0 fi fi - if test "$tcl_ok" = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_GETHOSTBYADDR_R 1 -_ACEOF - - fi - -fi + if test "$tcl_ok" = 0; then + case " $LIBOBJS " in + *" strtod.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strtod.$ac_objext" + ;; +esac + USE_COMPAT=1 fi -fi - -#--------------------------------------------------------------------------- -# Check for serial port interface. -# -# termios.h is present on all POSIX systems. -# sys/ioctl.h is almost always present, though what it contains -# is system-specific. -# sys/modem.h is needed on HP-UX. -#--------------------------------------------------------------------------- -for ac_header in termios.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +#-------------------------------------------------------------------- +# Under Solaris 2.4, strtod returns the wrong value for the +# terminating character under some conditions. Check for this +# and if the problem exists use a substitute procedure +# "fixstrtod" that corrects the error. +#-------------------------------------------------------------------- -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes + ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod" +if test "x$ac_cv_func_strtod" = xyes; then : + tcl_strtod=1 else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no + tcl_strtod=0 fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if test "$tcl_strtod" = 1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Solaris2.4/Tru64 strtod bugs" >&5 +$as_echo_n "checking for Solaris2.4/Tru64 strtod bugs... " >&6; } +if ${tcl_cv_strtod_buggy+:} false; then : + $as_echo_n "(cached) " >&6 else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - -for ac_header in sys/ioctl.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes + if test "$cross_compiling" = yes; then : + tcl_cv_strtod_buggy=buggy else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - -for ac_header in sys/modem.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - -#-------------------------------------------------------------------- -# Include sys/select.h if it exists and if it supplies things -# that appear to be useful and aren't already in sys/types.h. -# This appears to be true only on the RS/6000 under AIX. Some -# systems like OSF/1 have a sys/select.h that's of no use, and -# other systems like SCO UNIX have a sys/select.h that's -# pernicious. If "fd_set" isn't defined anywhere then set a -# special flag. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking for fd_set in sys/types" >&5 -echo $ECHO_N "checking for fd_set in sys/types... $ECHO_C" >&6 -if test "${tcl_cv_type_fd_set+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. */ -#include -int -main () -{ -fd_set readMask, writeMask; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_type_fd_set=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_type_fd_set=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_type_fd_set" >&5 -echo "${ECHO_T}$tcl_cv_type_fd_set" >&6 -tcl_ok=$tcl_cv_type_fd_set -if test $tcl_ok = no; then - echo "$as_me:$LINENO: checking for fd_mask in sys/select" >&5 -echo $ECHO_N "checking for fd_mask in sys/select... $ECHO_C" >&6 -if test "${tcl_cv_grep_fd_mask+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. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "fd_mask" >/dev/null 2>&1; then - tcl_cv_grep_fd_mask=present -else - tcl_cv_grep_fd_mask=missing -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $tcl_cv_grep_fd_mask" >&5 -echo "${ECHO_T}$tcl_cv_grep_fd_mask" >&6 - if test $tcl_cv_grep_fd_mask = present; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_SYS_SELECT_H 1 -_ACEOF - - tcl_ok=yes - fi -fi -if test $tcl_ok = no; then - -cat >>confdefs.h <<\_ACEOF -#define NO_FD_SET 1 -_ACEOF - -fi - -#------------------------------------------------------------------------------ -# Find out all about time handling differences. -#------------------------------------------------------------------------------ - - - -for ac_header in sys/time.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 -echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6 -if test "${ac_cv_header_time+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. */ -#include -#include -#include - -int -main () -{ -if ((struct tm *) 0) -return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_header_time=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_header_time=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 -echo "${ECHO_T}$ac_cv_header_time" >&6 -if test $ac_cv_header_time = yes; then - -cat >>confdefs.h <<\_ACEOF -#define TIME_WITH_SYS_TIME 1 -_ACEOF - -fi - - - - - -for ac_func in gmtime_r localtime_r mktime -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; - ; - 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 - eval "$as_ac_var=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - - echo "$as_me:$LINENO: checking tm_tzadj in struct tm" >&5 -echo $ECHO_N "checking tm_tzadj in struct tm... $ECHO_C" >&6 -if test "${tcl_cv_member_tm_tzadj+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. */ -#include -int -main () -{ -struct tm tm; tm.tm_tzadj; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_member_tm_tzadj=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_member_tm_tzadj=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_member_tm_tzadj" >&5 -echo "${ECHO_T}$tcl_cv_member_tm_tzadj" >&6 - if test $tcl_cv_member_tm_tzadj = yes ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_TM_TZADJ 1 -_ACEOF - - fi - - echo "$as_me:$LINENO: checking tm_gmtoff in struct tm" >&5 -echo $ECHO_N "checking tm_gmtoff in struct tm... $ECHO_C" >&6 -if test "${tcl_cv_member_tm_gmtoff+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. */ -#include -int -main () -{ -struct tm tm; tm.tm_gmtoff; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_member_tm_gmtoff=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_member_tm_gmtoff=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_member_tm_gmtoff" >&5 -echo "${ECHO_T}$tcl_cv_member_tm_gmtoff" >&6 - if test $tcl_cv_member_tm_gmtoff = yes ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_TM_GMTOFF 1 -_ACEOF - - fi - - # - # Its important to include time.h in this check, as some systems - # (like convex) have timezone functions, etc. - # - echo "$as_me:$LINENO: checking long timezone variable" >&5 -echo $ECHO_N "checking long timezone variable... $ECHO_C" >&6 -if test "${tcl_cv_timezone_long+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. */ -#include -int -main () -{ -extern long timezone; - timezone += 1; - exit (0); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_timezone_long=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_timezone_long=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_timezone_long" >&5 -echo "${ECHO_T}$tcl_cv_timezone_long" >&6 - if test $tcl_cv_timezone_long = yes ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_TIMEZONE_VAR 1 -_ACEOF - - else - # - # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. - # - echo "$as_me:$LINENO: checking time_t timezone variable" >&5 -echo $ECHO_N "checking time_t timezone variable... $ECHO_C" >&6 -if test "${tcl_cv_timezone_time+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. */ -#include -int -main () -{ -extern time_t timezone; - timezone += 1; - exit (0); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_timezone_time=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_timezone_time=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_timezone_time" >&5 -echo "${ECHO_T}$tcl_cv_timezone_time" >&6 - if test $tcl_cv_timezone_time = yes ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_TIMEZONE_VAR 1 -_ACEOF - - fi - fi - - -#-------------------------------------------------------------------- -# Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But -# we might be able to use fstatfs instead. Some systems (OpenBSD?) also -# lack blkcnt_t. -#-------------------------------------------------------------------- - -if test "$ac_cv_cygwin" != "yes"; then - echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5 -echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6 -if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static struct stat ac_aggr; -if (ac_aggr.st_blocks) -return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_member_struct_stat_st_blocks=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static struct stat ac_aggr; -if (sizeof ac_aggr.st_blocks) -return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_member_struct_stat_st_blocks=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_member_struct_stat_st_blocks=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blocks" >&5 -echo "${ECHO_T}$ac_cv_member_struct_stat_st_blocks" >&6 -if test $ac_cv_member_struct_stat_st_blocks = yes; then - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BLOCKS 1 -_ACEOF - - -fi -echo "$as_me:$LINENO: checking for struct stat.st_blksize" >&5 -echo $ECHO_N "checking for struct stat.st_blksize... $ECHO_C" >&6 -if test "${ac_cv_member_struct_stat_st_blksize+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. */ -$ac_includes_default -int -main () -{ -static struct stat ac_aggr; -if (ac_aggr.st_blksize) -return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_member_struct_stat_st_blksize=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static struct stat ac_aggr; -if (sizeof ac_aggr.st_blksize) -return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_member_struct_stat_st_blksize=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_member_struct_stat_st_blksize=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blksize" >&5 -echo "${ECHO_T}$ac_cv_member_struct_stat_st_blksize" >&6 -if test $ac_cv_member_struct_stat_st_blksize = yes; then - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BLKSIZE 1 -_ACEOF - - -fi - -fi -echo "$as_me:$LINENO: checking for blkcnt_t" >&5 -echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6 -if test "${ac_cv_type_blkcnt_t+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. */ -$ac_includes_default -int -main () -{ -if ((blkcnt_t *) 0) - return 0; -if (sizeof (blkcnt_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_blkcnt_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_blkcnt_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_blkcnt_t" >&5 -echo "${ECHO_T}$ac_cv_type_blkcnt_t" >&6 -if test $ac_cv_type_blkcnt_t = yes; then - -cat >>confdefs.h <<_ACEOF -#define HAVE_BLKCNT_T 1 -_ACEOF - - -fi - -echo "$as_me:$LINENO: checking for fstatfs" >&5 -echo $ECHO_N "checking for fstatfs... $ECHO_C" >&6 -if test "${ac_cv_func_fstatfs+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. */ -/* Define fstatfs to an innocuous variant, in case declares fstatfs. - For example, HP-UX 11i declares gettimeofday. */ -#define fstatfs innocuous_fstatfs - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char fstatfs (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef fstatfs - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char fstatfs (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_fstatfs) || defined (__stub___fstatfs) -choke me -#else -char (*f) () = fstatfs; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != fstatfs; - ; - 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 - ac_cv_func_fstatfs=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_fstatfs=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_fstatfs" >&5 -echo "${ECHO_T}$ac_cv_func_fstatfs" >&6 -if test $ac_cv_func_fstatfs = yes; then - : -else - -cat >>confdefs.h <<\_ACEOF -#define NO_FSTATFS 1 -_ACEOF - -fi - - -#-------------------------------------------------------------------- -# Some system have no memcmp or it does not work with 8 bit data, this -# checks it and add memcmp.o to LIBOBJS if needed -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking for working memcmp" >&5 -echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6 -if test "${ac_cv_func_memcmp_working+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - ac_cv_func_memcmp_working=no -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ - - /* Some versions of memcmp are not 8-bit clean. */ - char c0 = 0x40, c1 = 0x80, c2 = 0x81; - if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) - exit (1); - - /* The Next x86 OpenStep bug shows up only when comparing 16 bytes - or more and with at least one buffer not starting on a 4-byte boundary. - William Lewis provided this test program. */ - { - char foo[21]; - char bar[21]; - int i; - for (i = 0; i < 4; i++) - { - char *a = foo + i; - char *b = bar + i; - strcpy (a, "--------01111111"); - strcpy (b, "--------10000000"); - if (memcmp (a, b, 16) >= 0) - exit (1); - } - exit (0); - } - - ; - return 0; -} -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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 - ac_cv_func_memcmp_working=yes -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -ac_cv_func_memcmp_working=no -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5 -echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6 -test $ac_cv_func_memcmp_working = no && case $LIBOBJS in - "memcmp.$ac_objext" | \ - *" memcmp.$ac_objext" | \ - "memcmp.$ac_objext "* | \ - *" memcmp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;; -esac - - - -#-------------------------------------------------------------------- -# Some system like SunOS 4 and other BSD like systems have no memmove -# (we assume they have bcopy instead). {The replacement define is in -# compat/string.h} -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking for memmove" >&5 -echo $ECHO_N "checking for memmove... $ECHO_C" >&6 -if test "${ac_cv_func_memmove+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. */ -/* Define memmove to an innocuous variant, in case declares memmove. - For example, HP-UX 11i declares gettimeofday. */ -#define memmove innocuous_memmove - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char memmove (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef memmove - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char memmove (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_memmove) || defined (__stub___memmove) -choke me -#else -char (*f) () = memmove; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != memmove; - ; - 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 - ac_cv_func_memmove=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_memmove=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_memmove" >&5 -echo "${ECHO_T}$ac_cv_func_memmove" >&6 -if test $ac_cv_func_memmove = yes; then - : -else - - -cat >>confdefs.h <<\_ACEOF -#define NO_MEMMOVE 1 -_ACEOF - - -cat >>confdefs.h <<\_ACEOF -#define NO_STRING_H 1 -_ACEOF - -fi - - -#-------------------------------------------------------------------- -# On some systems strstr is broken: it returns a pointer even even if -# the original string is empty. -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strstr" >&5 -echo $ECHO_N "checking for strstr... $ECHO_C" >&6 -if test "${ac_cv_func_strstr+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. */ -/* Define strstr to an innocuous variant, in case declares strstr. - For example, HP-UX 11i declares gettimeofday. */ -#define strstr innocuous_strstr - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strstr (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strstr - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strstr (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strstr) || defined (__stub___strstr) -choke me -#else -char (*f) () = strstr; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strstr; - ; - 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 - ac_cv_func_strstr=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strstr=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strstr" >&5 -echo "${ECHO_T}$ac_cv_func_strstr" >&6 -if test $ac_cv_func_strstr = yes; then - tcl_ok=1 -else - tcl_ok=0 -fi - - if test "$tcl_ok" = 1; then - echo "$as_me:$LINENO: checking proper strstr implementation" >&5 -echo $ECHO_N "checking proper strstr implementation... $ECHO_C" >&6 -if test "${tcl_cv_strstr_unbroken+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - tcl_cv_strstr_unbroken=unknown -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() { - extern int strstr(); - exit(strstr("\0test", "test") ? 1 : 0); -} -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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_strstr_unbroken=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strstr_unbroken=broken -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strstr_unbroken" >&5 -echo "${ECHO_T}$tcl_cv_strstr_unbroken" >&6 - if test "$tcl_cv_strstr_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 - fi - fi - if test "$tcl_ok" = 0; then - case $LIBOBJS in - "strstr.$ac_objext" | \ - *" strstr.$ac_objext" | \ - "strstr.$ac_objext "* | \ - *" strstr.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strstr.$ac_objext" ;; -esac - - USE_COMPAT=1 - fi - - -#-------------------------------------------------------------------- -# Check for strtoul function. This is tricky because under some -# versions of AIX strtoul returns an incorrect terminator -# pointer for the string "0". -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strtoul" >&5 -echo $ECHO_N "checking for strtoul... $ECHO_C" >&6 -if test "${ac_cv_func_strtoul+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. */ -/* Define strtoul to an innocuous variant, in case declares strtoul. - For example, HP-UX 11i declares gettimeofday. */ -#define strtoul innocuous_strtoul - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strtoul (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strtoul - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strtoul (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strtoul) || defined (__stub___strtoul) -choke me -#else -char (*f) () = strtoul; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strtoul; - ; - 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 - ac_cv_func_strtoul=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strtoul=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strtoul" >&5 -echo "${ECHO_T}$ac_cv_func_strtoul" >&6 -if test $ac_cv_func_strtoul = yes; then - tcl_ok=1 -else - tcl_ok=0 -fi - - if test "$tcl_ok" = 1; then - echo "$as_me:$LINENO: checking proper strtoul implementation" >&5 -echo $ECHO_N "checking proper strtoul implementation... $ECHO_C" >&6 -if test "${tcl_cv_strtoul_unbroken+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - tcl_cv_strtoul_unbroken=unknown -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() { - extern int strtoul(); - char *term, *string = "0"; - exit(strtoul(string,&term,0) != 0 || term != string+1); -} -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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_strtoul_unbroken=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strtoul_unbroken=broken -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strtoul_unbroken" >&5 -echo "${ECHO_T}$tcl_cv_strtoul_unbroken" >&6 - if test "$tcl_cv_strtoul_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 - fi - fi - if test "$tcl_ok" = 0; then - case $LIBOBJS in - "strtoul.$ac_objext" | \ - *" strtoul.$ac_objext" | \ - "strtoul.$ac_objext "* | \ - *" strtoul.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" ;; -esac - - USE_COMPAT=1 - fi - - -#-------------------------------------------------------------------- -# Check for the strtod function. This is tricky because in some -# versions of Linux strtod mis-parses strings starting with "+". -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strtod" >&5 -echo $ECHO_N "checking for strtod... $ECHO_C" >&6 -if test "${ac_cv_func_strtod+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. */ -/* Define strtod to an innocuous variant, in case declares strtod. - For example, HP-UX 11i declares gettimeofday. */ -#define strtod innocuous_strtod - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strtod (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strtod - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strtod (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strtod) || defined (__stub___strtod) -choke me -#else -char (*f) () = strtod; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strtod; - ; - 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 - ac_cv_func_strtod=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strtod=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 -echo "${ECHO_T}$ac_cv_func_strtod" >&6 -if test $ac_cv_func_strtod = yes; then - tcl_ok=1 -else - tcl_ok=0 -fi - - if test "$tcl_ok" = 1; then - echo "$as_me:$LINENO: checking proper strtod implementation" >&5 -echo $ECHO_N "checking proper strtod implementation... $ECHO_C" >&6 -if test "${tcl_cv_strtod_unbroken+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - tcl_cv_strtod_unbroken=unknown -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() { - extern double strtod(); - char *term, *string = " +69"; - exit(strtod(string,&term) != 69 || term != string+4); -} -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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_strtod_unbroken=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strtod_unbroken=broken -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strtod_unbroken" >&5 -echo "${ECHO_T}$tcl_cv_strtod_unbroken" >&6 - if test "$tcl_cv_strtod_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 - fi - fi - if test "$tcl_ok" = 0; then - case $LIBOBJS in - "strtod.$ac_objext" | \ - *" strtod.$ac_objext" | \ - "strtod.$ac_objext "* | \ - *" strtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strtod.$ac_objext" ;; -esac - - USE_COMPAT=1 - fi - - -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" that corrects the error. -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strtod" >&5 -echo $ECHO_N "checking for strtod... $ECHO_C" >&6 -if test "${ac_cv_func_strtod+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. */ -/* Define strtod to an innocuous variant, in case declares strtod. - For example, HP-UX 11i declares gettimeofday. */ -#define strtod innocuous_strtod - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strtod (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strtod - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strtod (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strtod) || defined (__stub___strtod) -choke me -#else -char (*f) () = strtod; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strtod; - ; - 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 - ac_cv_func_strtod=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strtod=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 -echo "${ECHO_T}$ac_cv_func_strtod" >&6 -if test $ac_cv_func_strtod = yes; then - tcl_strtod=1 -else - tcl_strtod=0 -fi - - if test "$tcl_strtod" = 1; then - echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5 -echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6 -if test "${tcl_cv_strtod_buggy+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - if test "$cross_compiling" = yes; then - tcl_cv_strtod_buggy=buggy -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - } -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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_strtod_buggy=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strtod_buggy=buggy -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5 -echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6 - if test "$tcl_cv_strtod_buggy" = buggy; then - case $LIBOBJS in - "fixstrtod.$ac_objext" | \ - *" fixstrtod.$ac_objext" | \ - "fixstrtod.$ac_objext "* | \ - *" fixstrtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;; -esac - - USE_COMPAT=1 - -cat >>confdefs.h <<\_ACEOF -#define strtod fixstrtod -_ACEOF - - fi - fi - - -#-------------------------------------------------------------------- -# Check for various typedefs and provide substitutes if -# they don't exist. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking for mode_t" >&5 -echo $ECHO_N "checking for mode_t... $ECHO_C" >&6 -if test "${ac_cv_type_mode_t+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. */ -$ac_includes_default -int -main () -{ -if ((mode_t *) 0) - return 0; -if (sizeof (mode_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_mode_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_mode_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_mode_t" >&5 -echo "${ECHO_T}$ac_cv_type_mode_t" >&6 -if test $ac_cv_type_mode_t = yes; then - : -else - -cat >>confdefs.h <<_ACEOF -#define mode_t int -_ACEOF - -fi - -echo "$as_me:$LINENO: checking for pid_t" >&5 -echo $ECHO_N "checking for pid_t... $ECHO_C" >&6 -if test "${ac_cv_type_pid_t+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. */ -$ac_includes_default -int -main () -{ -if ((pid_t *) 0) - return 0; -if (sizeof (pid_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_pid_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_pid_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 -echo "${ECHO_T}$ac_cv_type_pid_t" >&6 -if test $ac_cv_type_pid_t = yes; then - : -else - -cat >>confdefs.h <<_ACEOF -#define pid_t int -_ACEOF - -fi - -echo "$as_me:$LINENO: checking for size_t" >&5 -echo $ECHO_N "checking for size_t... $ECHO_C" >&6 -if test "${ac_cv_type_size_t+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. */ -$ac_includes_default -int -main () -{ -if ((size_t *) 0) - return 0; -if (sizeof (size_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_size_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_size_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 -echo "${ECHO_T}$ac_cv_type_size_t" >&6 -if test $ac_cv_type_size_t = yes; then - : -else - -cat >>confdefs.h <<_ACEOF -#define size_t unsigned -_ACEOF - -fi - -echo "$as_me:$LINENO: checking for uid_t in sys/types.h" >&5 -echo $ECHO_N "checking for uid_t in sys/types.h... $ECHO_C" >&6 -if test "${ac_cv_type_uid_t+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. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "uid_t" >/dev/null 2>&1; then - ac_cv_type_uid_t=yes -else - ac_cv_type_uid_t=no -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $ac_cv_type_uid_t" >&5 -echo "${ECHO_T}$ac_cv_type_uid_t" >&6 -if test $ac_cv_type_uid_t = no; then - -cat >>confdefs.h <<\_ACEOF -#define uid_t int -_ACEOF - - -cat >>confdefs.h <<\_ACEOF -#define gid_t int -_ACEOF - -fi - - -echo "$as_me:$LINENO: checking for socklen_t" >&5 -echo $ECHO_N "checking for socklen_t... $ECHO_C" >&6 -if test "${tcl_cv_type_socklen_t+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. */ - - #include - #include - -int -main () -{ - - socklen_t foo; - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_type_socklen_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_type_socklen_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5 -echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6 -if test $tcl_cv_type_socklen_t = no; then - -cat >>confdefs.h <<\_ACEOF -#define socklen_t int -_ACEOF - -fi - -echo "$as_me:$LINENO: checking for intptr_t" >&5 -echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 -if test "${ac_cv_type_intptr_t+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. */ -$ac_includes_default -int -main () -{ -if ((intptr_t *) 0) - return 0; -if (sizeof (intptr_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_intptr_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_intptr_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 -echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 -if test $ac_cv_type_intptr_t = yes; then - - -cat >>confdefs.h <<\_ACEOF -#define HAVE_INTPTR_T 1 -_ACEOF - -else - - echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 -echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 -if test "${tcl_cv_intptr_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - for tcl_cv_intptr_t in "int" "long" "long long" none; do - if test "$tcl_cv_intptr_t" != none; then - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; -test_array [0] = 0 - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_ok=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_ok=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - test "$tcl_ok" = yes && break; fi - done -fi -echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 -echo "${ECHO_T}$tcl_cv_intptr_t" >&6 - if test "$tcl_cv_intptr_t" != none; then - -cat >>confdefs.h <<_ACEOF -#define intptr_t $tcl_cv_intptr_t -_ACEOF - - fi - -fi - -echo "$as_me:$LINENO: checking for uintptr_t" >&5 -echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 -if test "${ac_cv_type_uintptr_t+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. */ -$ac_includes_default -int -main () -{ -if ((uintptr_t *) 0) - return 0; -if (sizeof (uintptr_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_type_uintptr_t=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_uintptr_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 -echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 -if test $ac_cv_type_uintptr_t = yes; then - - -cat >>confdefs.h <<\_ACEOF -#define HAVE_UINTPTR_T 1 -_ACEOF - -else - - echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 -echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 -if test "${tcl_cv_uintptr_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ - none; do - if test "$tcl_cv_uintptr_t" != none; then - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; -test_array [0] = 0 - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_ok=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_ok=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - test "$tcl_ok" = yes && break; fi - done -fi -echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 -echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 - if test "$tcl_cv_uintptr_t" != none; then - -cat >>confdefs.h <<_ACEOF -#define uintptr_t $tcl_cv_uintptr_t -_ACEOF - - fi - -fi - - -#-------------------------------------------------------------------- -# If a system doesn't have an opendir function (man, that's old!) -# then we have to supply a different version of dirent.h which -# is compatible with the substitute version of opendir that's -# provided. This version only works with V7-style directories. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking for opendir" >&5 -echo $ECHO_N "checking for opendir... $ECHO_C" >&6 -if test "${ac_cv_func_opendir+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. */ -/* Define opendir to an innocuous variant, in case declares opendir. - For example, HP-UX 11i declares gettimeofday. */ -#define opendir innocuous_opendir - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char opendir (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef opendir - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char opendir (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_opendir) || defined (__stub___opendir) -choke me -#else -char (*f) () = opendir; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != opendir; - ; - 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 - ac_cv_func_opendir=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_opendir=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_opendir" >&5 -echo "${ECHO_T}$ac_cv_func_opendir" >&6 -if test $ac_cv_func_opendir = yes; then - : -else - -cat >>confdefs.h <<\_ACEOF -#define USE_DIRENT2_H 1 -_ACEOF - -fi - - -#-------------------------------------------------------------------- -# The check below checks whether defines the type -# "union wait" correctly. It's needed because of weirdness in -# HP-UX where "union wait" is defined in both the BSD and SYS-V -# environments. Checking the usability of WIFEXITED seems to do -# the trick. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking union wait" >&5 -echo $ECHO_N "checking union wait... $ECHO_C" >&6 -if test "${tcl_cv_union_wait+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. */ -#include -#include -int -main () -{ - -union wait x; -WIFEXITED(x); /* Generates compiler error if WIFEXITED - * uses an int. */ - - ; - 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_union_wait=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_union_wait=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $tcl_cv_union_wait" >&5 -echo "${ECHO_T}$tcl_cv_union_wait" >&6 -if test $tcl_cv_union_wait = no; then - -cat >>confdefs.h <<\_ACEOF -#define NO_UNION_WAIT 1 -_ACEOF - -fi - -#-------------------------------------------------------------------- -# Check whether there is an strncasecmp function on this system. -# This is a bit tricky because under SCO it's in -lsocket and -# under Sequent Dynix it's in -linet. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking for strncasecmp" >&5 -echo $ECHO_N "checking for strncasecmp... $ECHO_C" >&6 -if test "${ac_cv_func_strncasecmp+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. */ -/* Define strncasecmp to an innocuous variant, in case declares strncasecmp. - For example, HP-UX 11i declares gettimeofday. */ -#define strncasecmp innocuous_strncasecmp - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strncasecmp (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strncasecmp - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strncasecmp (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strncasecmp) || defined (__stub___strncasecmp) -choke me -#else -char (*f) () = strncasecmp; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strncasecmp; - ; - 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 - ac_cv_func_strncasecmp=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strncasecmp=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strncasecmp" >&5 -echo "${ECHO_T}$ac_cv_func_strncasecmp" >&6 -if test $ac_cv_func_strncasecmp = yes; then - tcl_ok=1 -else - tcl_ok=0 -fi - -if test "$tcl_ok" = 0; then - echo "$as_me:$LINENO: checking for strncasecmp in -lsocket" >&5 -echo $ECHO_N "checking for strncasecmp in -lsocket... $ECHO_C" >&6 -if test "${ac_cv_lib_socket_strncasecmp+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lsocket $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strncasecmp (); -int -main () -{ -strncasecmp (); - ; - 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 - ac_cv_lib_socket_strncasecmp=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_socket_strncasecmp=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -echo "$as_me:$LINENO: result: $ac_cv_lib_socket_strncasecmp" >&5 -echo "${ECHO_T}$ac_cv_lib_socket_strncasecmp" >&6 -if test $ac_cv_lib_socket_strncasecmp = yes; then - tcl_ok=1 -else - tcl_ok=0 -fi - -fi -if test "$tcl_ok" = 0; then - echo "$as_me:$LINENO: checking for strncasecmp in -linet" >&5 -echo $ECHO_N "checking for strncasecmp in -linet... $ECHO_C" >&6 -if test "${ac_cv_lib_inet_strncasecmp+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-linet $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strncasecmp (); -int -main () -{ -strncasecmp (); - ; - return 0; -} + extern double strtod(); + int main() { + char *infString="Inf", *nanString="NaN", *spaceString=" "; + char *term; + double value; + value = strtod(infString, &term); + if ((term != infString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(nanString, &term); + if ((term != nanString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(spaceString, &term); + if (term == (spaceString+1)) { + exit(1); + } + exit(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 - ac_cv_lib_inet_strncasecmp=yes +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_strtod_buggy=ok else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_inet_strncasecmp=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS + tcl_cv_strtod_buggy=buggy fi -echo "$as_me:$LINENO: result: $ac_cv_lib_inet_strncasecmp" >&5 -echo "${ECHO_T}$ac_cv_lib_inet_strncasecmp" >&6 -if test $ac_cv_lib_inet_strncasecmp = yes; then - tcl_ok=1 -else - tcl_ok=0 +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi fi -if test "$tcl_ok" = 0; then - case $LIBOBJS in - "strncasecmp.$ac_objext" | \ - *" strncasecmp.$ac_objext" | \ - "strncasecmp.$ac_objext "* | \ - *" strncasecmp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" ;; +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_buggy" >&5 +$as_echo "$tcl_cv_strtod_buggy" >&6; } + if test "$tcl_cv_strtod_buggy" = buggy; then + case " $LIBOBJS " in + *" fixstrtod.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" + ;; esac - USE_COMPAT=1 -fi + USE_COMPAT=1 + +$as_echo "#define strtod fixstrtod" >>confdefs.h + + fi + fi + #-------------------------------------------------------------------- -# The code below deals with several issues related to gettimeofday: -# 1. Some systems don't provide a gettimeofday function at all -# (set NO_GETTOD if this is the case). -# 2. See if gettimeofday is declared in the header file. -# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can -# declare it. +# Check for various typedefs and provide substitutes if +# they don't exist. #-------------------------------------------------------------------- -echo "$as_me:$LINENO: checking for gettimeofday" >&5 -echo $ECHO_N "checking for gettimeofday... $ECHO_C" >&6 -if test "${ac_cv_func_gettimeofday+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" +if test "x$ac_cv_type_mode_t" = xyes; then : + else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define gettimeofday to an innocuous variant, in case declares gettimeofday. - For example, HP-UX 11i declares gettimeofday. */ -#define gettimeofday innocuous_gettimeofday -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char gettimeofday (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ +cat >>confdefs.h <<_ACEOF +#define mode_t int +_ACEOF -#ifdef __STDC__ -# include -#else -# include -#endif +fi -#undef gettimeofday +ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" +if test "x$ac_cv_type_pid_t" = xyes; then : -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char gettimeofday (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_gettimeofday) || defined (__stub___gettimeofday) -choke me -#else -char (*f) () = gettimeofday; -#endif -#ifdef __cplusplus -} -#endif +else -int -main () -{ -return f != gettimeofday; - ; - return 0; -} +cat >>confdefs.h <<_ACEOF +#define pid_t int _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 - ac_cv_func_gettimeofday=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_cv_func_gettimeofday=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_gettimeofday" >&5 -echo "${ECHO_T}$ac_cv_func_gettimeofday" >&6 -if test $ac_cv_func_gettimeofday = yes; then - : -else +ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" +if test "x$ac_cv_type_size_t" = xyes; then : -cat >>confdefs.h <<\_ACEOF -#define NO_GETTOD 1 -_ACEOF +else +cat >>confdefs.h <<_ACEOF +#define size_t unsigned int +_ACEOF fi -echo "$as_me:$LINENO: checking for gettimeofday declaration" >&5 -echo $ECHO_N "checking for gettimeofday declaration... $ECHO_C" >&6 -if test "${tcl_cv_grep_gettimeofday+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5 +$as_echo_n "checking for uid_t in sys/types.h... " >&6; } +if ${ac_cv_type_uid_t+:} false; then : + $as_echo_n "(cached) " >&6 else - - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include +#include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "gettimeofday" >/dev/null 2>&1; then - tcl_cv_grep_gettimeofday=present + $EGREP "uid_t" >/dev/null 2>&1; then : + ac_cv_type_uid_t=yes else - tcl_cv_grep_gettimeofday=missing + ac_cv_type_uid_t=no fi rm -f conftest* fi -echo "$as_me:$LINENO: result: $tcl_cv_grep_gettimeofday" >&5 -echo "${ECHO_T}$tcl_cv_grep_gettimeofday" >&6 -if test $tcl_cv_grep_gettimeofday = missing ; then - -cat >>confdefs.h <<\_ACEOF -#define GETTOD_NOT_DECLARED 1 -_ACEOF - -fi - -#-------------------------------------------------------------------- -# The following code checks to see whether it is possible to get -# signed chars on this platform. This is needed in order to -# properly generate sign-extended ints from character values. -#-------------------------------------------------------------------- +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5 +$as_echo "$ac_cv_type_uid_t" >&6; } +if test $ac_cv_type_uid_t = no; then +$as_echo "#define uid_t int" >>confdefs.h -echo "$as_me:$LINENO: checking whether char is unsigned" >&5 -echo $ECHO_N "checking whether char is unsigned... $ECHO_C" >&6 -if test "${ac_cv_c_char_unsigned+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. */ -$ac_includes_default -int -main () -{ -static int test_array [1 - 2 * !(((char) -1) < 0)]; -test_array [0] = 0 - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_cv_c_char_unsigned=no -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +$as_echo "#define gid_t int" >>confdefs.h -ac_cv_c_char_unsigned=yes -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $ac_cv_c_char_unsigned" >&5 -echo "${ECHO_T}$ac_cv_c_char_unsigned" >&6 -if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then - cat >>confdefs.h <<\_ACEOF -#define __CHAR_UNSIGNED__ 1 -_ACEOF -fi -echo "$as_me:$LINENO: checking signed char declarations" >&5 -echo $ECHO_N "checking signed char declarations... $ECHO_C" >&6 -if test "${tcl_cv_char_signed+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t" >&5 +$as_echo_n "checking for socklen_t... " >&6; } +if ${tcl_cv_type_socklen_t+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ + #include + #include + int main () { - signed char *p; - p = 0; + socklen_t foo; ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_char_signed=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_type_socklen_t=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_char_signed=no + tcl_cv_type_socklen_t=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_char_signed" >&5 -echo "${ECHO_T}$tcl_cv_char_signed" >&6 -if test $tcl_cv_char_signed = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_socklen_t" >&5 +$as_echo "$tcl_cv_type_socklen_t" >&6; } +if test $tcl_cv_type_socklen_t = no; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_SIGNED_CHAR 1 -_ACEOF +$as_echo "#define socklen_t int" >>confdefs.h fi -#-------------------------------------------------------------------- -# Does putenv() copy or not? We need to know to avoid memory leaks. -#-------------------------------------------------------------------- +ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default" +if test "x$ac_cv_type_intptr_t" = xyes; then : + + +$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h -echo "$as_me:$LINENO: checking for a putenv() that copies the buffer" >&5 -echo $ECHO_N "checking for a putenv() that copies the buffer... $ECHO_C" >&6 -if test "${tcl_cv_putenv_copy+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test "$cross_compiling" = yes; then - tcl_cv_putenv_copy=no + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5 +$as_echo_n "checking for pointer-size signed integer type... " >&6; } +if ${tcl_cv_intptr_t+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - #include - #define OURVAR "havecopy=yes" - int main (int argc, char *argv[]) - { - char *foo, *bar; - foo = (char *)strdup(OURVAR); - putenv(foo); - strcpy((char *)(strchr(foo, '=') + 1), "no"); - bar = getenv("havecopy"); - if (!strcmp(bar, "no")) { - /* doesnt copy */ - return 0; - } else { - /* does copy */ - return 1; - } - } + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +test_array [0] = 0; +return test_array [0]; + ; + return 0; +} _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./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_putenv_copy=no +if ac_fn_c_try_compile "$LINENO"; then : + tcl_ok=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_putenv_copy=yes -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + tcl_ok=no fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done fi -echo "$as_me:$LINENO: result: $tcl_cv_putenv_copy" >&5 -echo "${ECHO_T}$tcl_cv_putenv_copy" >&6 -if test $tcl_cv_putenv_copy = yes; then +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5 +$as_echo "$tcl_cv_intptr_t" >&6; } + if test "$tcl_cv_intptr_t" != none; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_PUTENV_THAT_COPIES 1 +cat >>confdefs.h <<_ACEOF +#define intptr_t $tcl_cv_intptr_t _ACEOF -fi - -#-------------------------------------------------------------------- -# Check for support of nl_langinfo function -#-------------------------------------------------------------------- - - - # Check whether --enable-langinfo or --disable-langinfo was given. -if test "${enable_langinfo+set}" = set; then - enableval="$enable_langinfo" - langinfo_ok=$enableval -else - langinfo_ok=yes -fi; - - HAVE_LANGINFO=0 - if test "$langinfo_ok" = "yes"; then - if test "${ac_cv_header_langinfo_h+set}" = set; then - echo "$as_me:$LINENO: checking for langinfo.h" >&5 -echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 -if test "${ac_cv_header_langinfo_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 -echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking langinfo.h usability" >&5 -echo $ECHO_N "checking langinfo.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + fi -ac_header_compiler=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 -# Is the header present? -echo "$as_me:$LINENO: checking langinfo.h presence" >&5 -echo $ECHO_N "checking langinfo.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default" +if test "x$ac_cv_type_uintptr_t" = xyes; then : - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: langinfo.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: langinfo.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: langinfo.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: langinfo.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: langinfo.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: langinfo.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: langinfo.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: langinfo.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: langinfo.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: langinfo.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for langinfo.h" >&5 -echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 -if test "${ac_cv_header_langinfo_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_langinfo_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 -echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 +$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h -fi -if test $ac_cv_header_langinfo_h = yes; then - langinfo_ok=yes else - langinfo_ok=no -fi - - fi - echo "$as_me:$LINENO: checking whether to use nl_langinfo" >&5 -echo $ECHO_N "checking whether to use nl_langinfo... $ECHO_C" >&6 - if test "$langinfo_ok" = "yes"; then - if test "${tcl_cv_langinfo_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5 +$as_echo_n "checking for pointer-size unsigned integer type... " >&6; } +if ${tcl_cv_uintptr_t+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include +$ac_includes_default int main () { -nl_langinfo(CODESET); +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; +test_array [0] = 0; +return test_array [0]; + ; return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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_langinfo_h=yes +if ac_fn_c_try_compile "$LINENO"; then : + tcl_ok=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_langinfo_h=no + tcl_ok=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5 +$as_echo "$tcl_cv_uintptr_t" >&6; } + if test "$tcl_cv_uintptr_t" != none; then - echo "$as_me:$LINENO: result: $tcl_cv_langinfo_h" >&5 -echo "${ECHO_T}$tcl_cv_langinfo_h" >&6 - if test $tcl_cv_langinfo_h = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_LANGINFO 1 +cat >>confdefs.h <<_ACEOF +#define uintptr_t $tcl_cv_uintptr_t _ACEOF - fi - else - echo "$as_me:$LINENO: result: $langinfo_ok" >&5 -echo "${ECHO_T}$langinfo_ok" >&6 fi +fi + #-------------------------------------------------------------------- -# Check for support of chflags and mkstemps functions +# If a system doesn't have an opendir function (man, that's old!) +# then we have to supply a different version of dirent.h which +# is compatible with the substitute version of opendir that's +# provided. This version only works with V7-style directories. #-------------------------------------------------------------------- +ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir" +if test "x$ac_cv_func_opendir" = xyes; then : +else -for ac_func in chflags mkstemps -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func +$as_echo "#define USE_DIRENT2_H 1" >>confdefs.h -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ +fi -#ifdef __STDC__ -# include -#else -# include -#endif -#undef $ac_func +#-------------------------------------------------------------------- +# The check below checks whether defines the type +# "union wait" correctly. It's needed because of weirdness in +# HP-UX where "union wait" is defined in both the BSD and SYS-V +# environments. Checking the usability of WIFEXITED seems to do +# the trick. +#-------------------------------------------------------------------- -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking union wait" >&5 +$as_echo_n "checking union wait... " >&6; } +if ${tcl_cv_union_wait+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include int main () { -return f != $ac_func; + +union wait x; +WIFEXITED(x); /* Generates compiler error if WIFEXITED + * uses an int. */ + ; 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 - eval "$as_ac_var=yes" +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_union_wait=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" + tcl_cv_union_wait=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_union_wait" >&5 +$as_echo "$tcl_cv_union_wait" >&6; } +if test $tcl_cv_union_wait = no; then -fi -done +$as_echo "#define NO_UNION_WAIT 1" >>confdefs.h +fi #-------------------------------------------------------------------- -# Check for support of isnan() function or macro +# Check whether there is an strncasecmp function on this system. +# This is a bit tricky because under SCO it's in -lsocket and +# under Sequent Dynix it's in -linet. #-------------------------------------------------------------------- -echo "$as_me:$LINENO: checking isnan" >&5 -echo $ECHO_N "checking isnan... $ECHO_C" >&6 -if test "${tcl_cv_isnan+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +ac_fn_c_check_func "$LINENO" "strncasecmp" "ac_cv_func_strncasecmp" +if test "x$ac_cv_func_strncasecmp" = xyes; then : + tcl_ok=1 else + tcl_ok=0 +fi - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +if test "$tcl_ok" = 0; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -lsocket" >&5 +$as_echo_n "checking for strncasecmp in -lsocket... " >&6; } +if ${ac_cv_lib_socket_strncasecmp+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char strncasecmp (); int main () { - -isnan(0.0); /* Generates an error if isnan is missing */ - +return strncasecmp (); ; 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_isnan=yes +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_socket_strncasecmp=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_isnan=no + ac_cv_lib_socket_strncasecmp=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: $tcl_cv_isnan" >&5 -echo "${ECHO_T}$tcl_cv_isnan" >&6 -if test $tcl_cv_isnan = no; then - -cat >>confdefs.h <<\_ACEOF -#define NO_ISNAN 1 -_ACEOF - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_strncasecmp" >&5 +$as_echo "$ac_cv_lib_socket_strncasecmp" >&6; } +if test "x$ac_cv_lib_socket_strncasecmp" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 fi -#-------------------------------------------------------------------- -# Darwin specific API checks and defines -#-------------------------------------------------------------------- - -if test "`uname -s`" = "Darwin" ; then - -for ac_func in getattrlist -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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 +fi +if test "$tcl_ok" = 0; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -linet" >&5 +$as_echo_n "checking for strncasecmp in -linet... " >&6; } +if ${ac_cv_lib_inet_strncasecmp+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-linet $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif #ifdef __cplusplus -} +extern "C" #endif - +char strncasecmp (); int main () { -return f != $ac_func; +return strncasecmp (); ; 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 - eval "$as_ac_var=yes" +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_inet_strncasecmp=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" + ac_cv_lib_inet_strncasecmp=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_strncasecmp" >&5 +$as_echo "$ac_cv_lib_inet_strncasecmp" >&6; } +if test "x$ac_cv_lib_inet_strncasecmp" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 fi -done +fi +if test "$tcl_ok" = 0; then + case " $LIBOBJS " in + *" strncasecmp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" + ;; +esac -for ac_header in copyfile.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + USE_COMPAT=1 fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes + +#-------------------------------------------------------------------- +# The code below deals with several issues related to gettimeofday: +# 1. Some systems don't provide a gettimeofday function at all +# (set NO_GETTOD if this is the case). +# 2. See if gettimeofday is declared in the header file. +# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can +# declare it. +#-------------------------------------------------------------------- + +ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" +if test "x$ac_cv_func_gettimeofday" = xyes; then : + else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_header_compiler=no + +$as_echo "#define NO_GETTOD 1" >>confdefs.h + + fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 +$as_echo_n "checking for gettimeofday declaration... " >&6; } +if ${tcl_cv_grep_gettimeofday+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include <$ac_header> +#include + _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "gettimeofday" >/dev/null 2>&1; then : + tcl_cv_grep_gettimeofday=present else - ac_cpp_err=yes + tcl_cv_grep_gettimeofday=missing fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +rm -f conftest* - ac_header_preproc=no fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5 +$as_echo "$tcl_cv_grep_gettimeofday" >&6; } +if test $tcl_cv_grep_gettimeofday = missing ; then -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +$as_echo "#define GETTOD_NOT_DECLARED 1" >>confdefs.h + +fi + +#-------------------------------------------------------------------- +# The following code checks to see whether it is possible to get +# signed chars on this platform. This is needed in order to +# properly generate sign-extended ints from character values. +#-------------------------------------------------------------------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether char is unsigned" >&5 +$as_echo_n "checking whether char is unsigned... " >&6; } +if ${ac_cv_c_char_unsigned+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(((char) -1) < 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_char_unsigned=no else - eval "$as_ac_Header=\$ac_header_preproc" + ac_cv_c_char_unsigned=yes fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_char_unsigned" >&5 +$as_echo "$ac_cv_c_char_unsigned" >&6; } +if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then + $as_echo "#define __CHAR_UNSIGNED__ 1" >>confdefs.h fi -done - +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking signed char declarations" >&5 +$as_echo_n "checking signed char declarations... " >&6; } +if ${tcl_cv_char_signed+:} false; then : + $as_echo_n "(cached) " >&6 +else -for ac_func in copyfile -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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 + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif int main () { -return f != $ac_func; + + signed char *p; + p = 0; + ; 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 - eval "$as_ac_var=yes" +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_char_signed=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" + tcl_cv_char_signed=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_char_signed" >&5 +$as_echo "$tcl_cv_char_signed" >&6; } +if test $tcl_cv_char_signed = yes; then + +$as_echo "#define HAVE_SIGNED_CHAR 1" >>confdefs.h fi -done - if test $tcl_corefoundation = yes; then +#-------------------------------------------------------------------- +# Does putenv() copy or not? We need to know to avoid memory leaks. +#-------------------------------------------------------------------- -for ac_header in libkern/OSAtomic.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a putenv() that copies the buffer" >&5 +$as_echo_n "checking for a putenv() that copies the buffer... " >&6; } +if ${tcl_cv_putenv_copy+:} false; then : + $as_echo_n "(cached) " >&6 else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes + + if test "$cross_compiling" = yes; then : + tcl_cv_putenv_copy=no else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 + #include + #define OURVAR "havecopy=yes" + int main (int argc, char *argv[]) + { + char *foo, *bar; + foo = (char *)strdup(OURVAR); + putenv(foo); + strcpy((char *)(strchr(foo, '=') + 1), "no"); + bar = getenv("havecopy"); + if (!strcmp(bar, "no")) { + /* doesnt copy */ + return 0; + } else { + /* does copy */ + return 1; + } + } -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_putenv_copy=no else - ac_cpp_err=yes + tcl_cv_putenv_copy=yes fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5 +$as_echo "$tcl_cv_putenv_copy" >&6; } +if test $tcl_cv_putenv_copy = yes; then -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF +$as_echo "#define HAVE_PUTENV_THAT_COPIES 1" >>confdefs.h fi -done +#-------------------------------------------------------------------- +# Check for support of nl_langinfo function +#-------------------------------------------------------------------- -for ac_func in OSSpinLockLock -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case declares $ac_func. - For example, HP-UX 11i declares gettimeofday. */ -#define $ac_func innocuous_$ac_func + # Check whether --enable-langinfo was given. +if test "${enable_langinfo+set}" = set; then : + enableval=$enable_langinfo; langinfo_ok=$enableval +else + langinfo_ok=yes +fi -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ -#ifdef __STDC__ -# include -#else -# include -#endif + HAVE_LANGINFO=0 + if test "$langinfo_ok" = "yes"; then + ac_fn_c_check_header_mongrel "$LINENO" "langinfo.h" "ac_cv_header_langinfo_h" "$ac_includes_default" +if test "x$ac_cv_header_langinfo_h" = xyes; then : + langinfo_ok=yes +else + langinfo_ok=no +fi -#undef $ac_func -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use nl_langinfo" >&5 +$as_echo_n "checking whether to use nl_langinfo... " >&6; } + if test "$langinfo_ok" = "yes"; then + if ${tcl_cv_langinfo_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include int main () { -return f != $ac_func; +nl_langinfo(CODESET); ; 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 - eval "$as_ac_var=yes" +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_langinfo_h=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" + tcl_cv_langinfo_h=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_langinfo_h" >&5 +$as_echo "$tcl_cv_langinfo_h" >&6; } + if test $tcl_cv_langinfo_h = yes; then + +$as_echo "#define HAVE_LANGINFO 1" >>confdefs.h + + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $langinfo_ok" >&5 +$as_echo "$langinfo_ok" >&6; } + fi + + +#-------------------------------------------------------------------- +# Check for support of chflags and mkstemps functions +#-------------------------------------------------------------------- + +for ac_func in chflags mkstemps +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done - fi -cat >>confdefs.h <<\_ACEOF -#define USE_VFORK 1 -_ACEOF +#-------------------------------------------------------------------- +# Check for support of isnan() function or macro +#-------------------------------------------------------------------- +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking isnan" >&5 +$as_echo_n "checking isnan... " >&6; } +if ${tcl_cv_isnan+:} false; then : + $as_echo_n "(cached) " >&6 +else -cat >>confdefs.h <<\_ACEOF -#define TCL_DEFAULT_ENCODING "utf-8" -_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +isnan(0.0); /* Generates an error if isnan is missing */ -cat >>confdefs.h <<\_ACEOF -#define TCL_LOAD_FROM_MEMORY 1 + ; + return 0; +} _ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_isnan=yes +else + tcl_cv_isnan=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_isnan" >&5 +$as_echo "$tcl_cv_isnan" >&6; } +if test $tcl_cv_isnan = no; then +$as_echo "#define NO_ISNAN 1" >>confdefs.h -cat >>confdefs.h <<\_ACEOF -#define TCL_WIDE_CLICKS 1 -_ACEOF +fi +#-------------------------------------------------------------------- +# Darwin specific API checks and defines +#-------------------------------------------------------------------- + +if test "`uname -s`" = "Darwin" ; then + for ac_func in getattrlist +do : + ac_fn_c_check_func "$LINENO" "getattrlist" "ac_cv_func_getattrlist" +if test "x$ac_cv_func_getattrlist" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_GETATTRLIST 1 +_ACEOF -for ac_header in AvailabilityMacros.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ +done + + for ac_header in copyfile.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "copyfile.h" "ac_cv_header_copyfile_h" "$ac_includes_default" +if test "x$ac_cv_header_copyfile_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_COPYFILE_H 1 _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> + +fi + +done + + for ac_func in copyfile +do : + ac_fn_c_check_func "$LINENO" "copyfile" "ac_cv_func_copyfile" +if test "x$ac_cv_func_copyfile" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_COPYFILE 1 _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -ac_header_compiler=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 +done -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ + if test $tcl_corefoundation = yes; then + for ac_header in libkern/OSAtomic.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "libkern/OSAtomic.h" "ac_cv_header_libkern_OSAtomic_h" "$ac_includes_default" +if test "x$ac_cv_header_libkern_OSAtomic_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBKERN_OSATOMIC_H 1 _ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> + +fi + +done + + for ac_func in OSSpinLockLock +do : + ac_fn_c_check_func "$LINENO" "OSSpinLockLock" "ac_cv_func_OSSpinLockLock" +if test "x$ac_cv_func_OSSpinLockLock" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_OSSPINLOCKLOCK 1 _ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes + fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +done + + fi + +$as_echo "#define USE_VFORK 1" >>confdefs.h + + +$as_echo "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h + - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 +$as_echo "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then +$as_echo "#define TCL_WIDE_CLICKS 1" >>confdefs.h + + for ac_header in AvailabilityMacros.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "AvailabilityMacros.h" "ac_cv_header_AvailabilityMacros_h" "$ac_includes_default" +if test "x$ac_cv_header_AvailabilityMacros_h" = xyes; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define HAVE_AVAILABILITYMACROS_H 1 _ACEOF fi @@ -18064,18 +9826,14 @@ fi done if test "$ac_cv_header_AvailabilityMacros_h" = yes; then - echo "$as_me:$LINENO: checking if weak import is available" >&5 -echo $ECHO_N "checking if weak import is available... $ECHO_C" >&6 -if test "${tcl_cv_cc_weak_import+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if weak import is available" >&5 +$as_echo_n "checking if weak import is available... " >&6; } +if ${tcl_cv_cc_weak_import+:} false; then : + $as_echo_n "(cached) " >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ @@ -18095,60 +9853,30 @@ rand(); 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_cc_weak_import=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_weak_import=no + tcl_cv_cc_weak_import=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_weak_import" >&5 -echo "${ECHO_T}$tcl_cv_cc_weak_import" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_weak_import" >&5 +$as_echo "$tcl_cv_cc_weak_import" >&6; } if test $tcl_cv_cc_weak_import = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_WEAK_IMPORT 1 -_ACEOF +$as_echo "#define HAVE_WEAK_IMPORT 1" >>confdefs.h fi - echo "$as_me:$LINENO: checking if Darwin SUSv3 extensions are available" >&5 -echo $ECHO_N "checking if Darwin SUSv3 extensions are available... $ECHO_C" >&6 -if test "${tcl_cv_cc_darwin_c_source+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Darwin SUSv3 extensions are available" >&5 +$as_echo_n "checking if Darwin SUSv3 extensions are available... " >&6; } +if ${tcl_cv_cc_darwin_c_source+:} false; then : + $as_echo_n "(cached) " >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ @@ -18169,45 +9897,19 @@ main () return 0; } _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 +if ac_fn_c_try_compile "$LINENO"; then : tcl_cv_cc_darwin_c_source=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_darwin_c_source=no + tcl_cv_cc_darwin_c_source=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_darwin_c_source" >&5 -echo "${ECHO_T}$tcl_cv_cc_darwin_c_source" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_darwin_c_source" >&5 +$as_echo "$tcl_cv_cc_darwin_c_source" >&6; } if test $tcl_cv_cc_darwin_c_source = yes; then -cat >>confdefs.h <<\_ACEOF -#define _DARWIN_C_SOURCE 1 -_ACEOF +$as_echo "#define _DARWIN_C_SOURCE 1" >>confdefs.h fi fi @@ -18223,17 +9925,13 @@ fi # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- -echo "$as_me:$LINENO: checking for fts" >&5 -echo $ECHO_N "checking for fts... $ECHO_C" >&6 -if test "${tcl_cv_api_fts+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fts" >&5 +$as_echo_n "checking for fts... " >&6; } +if ${tcl_cv_api_fts+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -18252,45 +9950,19 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_api_fts=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_api_fts=no + tcl_cv_api_fts=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_api_fts" >&5 -echo "${ECHO_T}$tcl_cv_api_fts" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_fts" >&5 +$as_echo "$tcl_cv_api_fts" >&6; } if test $tcl_cv_api_fts = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_FTS 1 -_ACEOF +$as_echo "#define HAVE_FTS 1" >>confdefs.h fi @@ -18301,300 +9973,24 @@ fi #-------------------------------------------------------------------- - -for ac_header in sys/ioctl.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then + for ac_header in sys/ioctl.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_ioctl_h" = xyes; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define HAVE_SYS_IOCTL_H 1 _ACEOF fi done - -for ac_header in sys/filio.h -do -as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking $ac_header usability" >&5 -echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <$ac_header> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking $ac_header presence" >&5 -echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <$ac_header> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 -echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for $ac_header" >&5 -echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 -if eval "test \"\${$as_ac_Header+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - eval "$as_ac_Header=\$ac_header_preproc" -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - -fi -if test `eval echo '${'$as_ac_Header'}'` = yes; then + for ac_header in sys/filio.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/filio.h" "ac_cv_header_sys_filio_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_filio_h" = xyes; then : cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define HAVE_SYS_FILIO_H 1 _ACEOF fi @@ -18602,10 +9998,10 @@ fi done - echo "$as_me:$LINENO: checking system version" >&5 -echo $ECHO_N "checking system version... $ECHO_C" >&6 -if test "${tcl_cv_sys_version+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 +$as_echo_n "checking system version... " >&6; } +if ${tcl_cv_sys_version+:} false; then : + $as_echo_n "(cached) " >&6 else if test -f /usr/lib/NextStep/software_version; then @@ -18613,8 +10009,8 @@ else else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then - { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 -echo "$as_me: WARNING: can't find uname command" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 +$as_echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird @@ -18630,58 +10026,52 @@ echo "$as_me: WARNING: can't find uname command" >&2;} fi fi -echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 -echo "${ECHO_T}$tcl_cv_sys_version" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 +$as_echo "$tcl_cv_sys_version" >&6; } system=$tcl_cv_sys_version - echo "$as_me:$LINENO: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 -echo $ECHO_N "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... $ECHO_C" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 +$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } case $system in OSF*) -cat >>confdefs.h <<\_ACEOF -#define USE_FIONBIO 1 -_ACEOF +$as_echo "#define USE_FIONBIO 1" >>confdefs.h - echo "$as_me:$LINENO: result: FIONBIO" >&5 -echo "${ECHO_T}FIONBIO" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 +$as_echo "FIONBIO" >&6; } ;; SunOS-4*) -cat >>confdefs.h <<\_ACEOF -#define USE_FIONBIO 1 -_ACEOF +$as_echo "#define USE_FIONBIO 1" >>confdefs.h - echo "$as_me:$LINENO: result: FIONBIO" >&5 -echo "${ECHO_T}FIONBIO" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 +$as_echo "FIONBIO" >&6; } ;; *) - echo "$as_me:$LINENO: result: O_NONBLOCK" >&5 -echo "${ECHO_T}O_NONBLOCK" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5 +$as_echo "O_NONBLOCK" >&6; } ;; esac #------------------------------------------------------------------------ -echo "$as_me:$LINENO: checking whether to use dll unloading" >&5 -echo $ECHO_N "checking whether to use dll unloading... $ECHO_C" >&6 -# Check whether --enable-dll-unloading or --disable-dll-unloading was given. -if test "${enable_dll_unloading+set}" = set; then - enableval="$enable_dll_unloading" - tcl_ok=$enableval +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use dll unloading" >&5 +$as_echo_n "checking whether to use dll unloading... " >&6; } +# Check whether --enable-dll-unloading was given. +if test "${enable_dll_unloading+set}" = set; then : + enableval=$enable_dll_unloading; tcl_ok=$enableval else tcl_ok=yes -fi; +fi + if test $tcl_ok = yes; then -cat >>confdefs.h <<\_ACEOF -#define TCL_UNLOAD_DLLS 1 -_ACEOF +$as_echo "#define TCL_UNLOAD_DLLS 1" >>confdefs.h fi -echo "$as_me:$LINENO: result: $tcl_ok" >&5 -echo "${ECHO_T}$tcl_ok" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 +$as_echo "$tcl_ok" >&6; } #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has @@ -18689,31 +10079,31 @@ echo "${ECHO_T}$tcl_ok" >&6 # be overriden on the configure command line either way. #------------------------------------------------------------------------ -echo "$as_me:$LINENO: checking for timezone data" >&5 -echo $ECHO_N "checking for timezone data... $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5 +$as_echo_n "checking for timezone data... " >&6; } -# Check whether --with-tzdata or --without-tzdata was given. -if test "${with_tzdata+set}" = set; then - withval="$with_tzdata" - tcl_ok=$withval +# Check whether --with-tzdata was given. +if test "${with_tzdata+set}" = set; then : + withval=$with_tzdata; tcl_ok=$withval else tcl_ok=auto -fi; +fi + # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in no) - echo "$as_me:$LINENO: result: supplied by OS vendor" >&5 -echo "${ECHO_T}supplied by OS vendor" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by OS vendor" >&5 +$as_echo "supplied by OS vendor" >&6; } ;; yes) # nothing to do here ;; auto*) - if test "${tcl_cv_dir_zoneinfo+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 + if ${tcl_cv_dir_zoneinfo+:} false; then : + $as_echo_n "(cached) " >&6 else for dir in /usr/share/zoneinfo \ @@ -18730,22 +10120,20 @@ fi if test -n "$tcl_cv_dir_zoneinfo"; then tcl_ok=no - echo "$as_me:$LINENO: result: $dir" >&5 -echo "${ECHO_T}$dir" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $dir" >&5 +$as_echo "$dir" >&6; } else tcl_ok=yes fi ;; *) - { { echo "$as_me:$LINENO: error: invalid argument: $tcl_ok" >&5 -echo "$as_me: error: invalid argument: $tcl_ok" >&2;} - { (exit 1); exit 1; }; } + as_fn_error $? "invalid argument: $tcl_ok" "$LINENO" 5 ;; esac if test $tcl_ok = yes then - echo "$as_me:$LINENO: result: supplied by Tcl" >&5 -echo "${ECHO_T}supplied by Tcl" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by Tcl" >&5 +$as_echo "supplied by Tcl" >&6; } INSTALL_TZDATA=install-tzdata fi @@ -18753,152 +10141,16 @@ fi # DTrace support #-------------------------------------------------------------------- -# Check whether --enable-dtrace or --disable-dtrace was given. -if test "${enable_dtrace+set}" = set; then - enableval="$enable_dtrace" - tcl_ok=$enableval +# Check whether --enable-dtrace was given. +if test "${enable_dtrace+set}" = set; then : + enableval=$enable_dtrace; tcl_ok=$enableval else tcl_ok=no -fi; -if test $tcl_ok = yes; then - if test "${ac_cv_header_sys_sdt_h+set}" = set; then - echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 -echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 -if test "${ac_cv_header_sys_sdt_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 -echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking sys/sdt.h usability" >&5 -echo $ECHO_N "checking sys/sdt.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 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_objext' - { (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 - ac_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking sys/sdt.h presence" >&5 -echo $ECHO_N "checking sys/sdt.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: sys/sdt.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: sys/sdt.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: sys/sdt.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ------------------------------ ## -## Report this to the tcl lists. ## -## ------------------------------ ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 -echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 -if test "${ac_cv_header_sys_sdt_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_sys_sdt_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 -echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 -fi -if test $ac_cv_header_sys_sdt_h = yes; then +if test $tcl_ok = yes; then + ac_fn_c_check_header_mongrel "$LINENO" "sys/sdt.h" "ac_cv_header_sys_sdt_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_sdt_h" = xyes; then : tcl_ok=yes else tcl_ok=no @@ -18909,10 +10161,10 @@ fi if test $tcl_ok = yes; then # Extract the first word of "dtrace", so it can be a program name with args. set dummy dtrace; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_path_DTRACE+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_DTRACE+:} false; then : + $as_echo_n "(cached) " >&6 else case $DTRACE in [\\/]* | ?:[\\/]*) @@ -18925,38 +10177,37 @@ for as_dir in $as_dummy do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_DTRACE="$as_dir/$ac_word$ac_exec_ext" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done -done + done +IFS=$as_save_IFS ;; esac fi DTRACE=$ac_cv_path_DTRACE - if test -n "$DTRACE"; then - echo "$as_me:$LINENO: result: $DTRACE" >&5 -echo "${ECHO_T}$DTRACE" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5 +$as_echo "$DTRACE" >&6; } else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } fi + test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi -echo "$as_me:$LINENO: checking whether to enable DTrace support" >&5 -echo $ECHO_N "checking whether to enable DTrace support... $ECHO_C" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable DTrace support" >&5 +$as_echo_n "checking whether to enable DTrace support... " >&6; } MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then -cat >>confdefs.h <<\_ACEOF -#define USE_DTRACE 1 -_ACEOF +$as_echo "#define USE_DTRACE 1" >>confdefs.h DTRACE_SRC="\${DTRACE_SRC}" DTRACE_HDR="\${DTRACE_HDR}" @@ -18974,24 +10225,20 @@ _ACEOF fi fi fi -echo "$as_me:$LINENO: result: $tcl_ok" >&5 -echo "${ECHO_T}$tcl_ok" >&6 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 +$as_echo "$tcl_ok" >&6; } #-------------------------------------------------------------------- # 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 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5 +$as_echo_n "checking whether the cpuid instruction is usable... " >&6; } +if ${tcl_cv_cpuid+:} false; then : + $as_echo_n "(cached) " >&6 else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -19010,45 +10257,19 @@ main () 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 +if ac_fn_c_try_link "$LINENO"; then : tcl_cv_cpuid=yes else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cpuid=no + tcl_cv_cpuid=no fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f core 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 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cpuid" >&5 +$as_echo "$tcl_cv_cpuid" >&6; } if test $tcl_cv_cpuid = yes; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_CPUID 1 -_ACEOF +$as_echo "#define HAVE_CPUID 1" >>confdefs.h fi @@ -19067,6 +10288,10 @@ eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" eval "TCL_LIB_FILE=${TCL_LIB_FILE}" +eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" +eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" + + TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' @@ -19079,38 +10304,38 @@ HTML_DIR='$(DISTDIR)/html' if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then - echo "$as_me:$LINENO: checking how to package libraries" >&5 -echo $ECHO_N "checking how to package libraries... $ECHO_C" >&6 - # Check whether --enable-framework or --disable-framework was given. -if test "${enable_framework+set}" = set; then - enableval="$enable_framework" - enable_framework=$enableval + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to package libraries" >&5 +$as_echo_n "checking how to package libraries... " >&6; } + # Check whether --enable-framework was given. +if test "${enable_framework+set}" = set; then : + enableval=$enable_framework; enable_framework=$enableval else enable_framework=no -fi; +fi + if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then - { echo "$as_me:$LINENO: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 -echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 +$as_echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} enable_framework=no fi if test $tcl_corefoundation = no; then - { echo "$as_me:$LINENO: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 -echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 +$as_echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} enable_framework=no fi fi if test $enable_framework = yes; then - echo "$as_me:$LINENO: result: framework" >&5 -echo "${ECHO_T}framework" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: framework" >&5 +$as_echo "framework" >&6; } FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then - echo "$as_me:$LINENO: result: shared library" >&5 -echo "${ECHO_T}shared library" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared library" >&5 +$as_echo "shared library" >&6; } else - echo "$as_me:$LINENO: result: static library" >&5 -echo "${ECHO_T}static library" >&6 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: static library" >&5 +$as_echo "static library" >&6; } fi FRAMEWORK_BUILD=0 fi @@ -19122,20 +10347,18 @@ echo "${ECHO_T}static library" >&6 TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' - ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" + ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" TCL_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then -cat >>confdefs.h <<\_ACEOF -#define TCL_FRAMEWORK 1 -_ACEOF +$as_echo "#define TCL_FRAMEWORK 1" >>confdefs.h # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work - ac_config_commands="$ac_config_commands Tcl.framework" + ac_config_commands="$ac_config_commands Tcl.framework" LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" # default install directory for bundled packages @@ -19295,7 +10518,8 @@ TCL_SHARED_BUILD=${SHARED_BUILD} - ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" + +ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -19315,39 +10539,70 @@ _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. -# So, don't put newlines in cache variables' values. +# So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -{ +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | - case `(ac_space=' '; set | grep ac_space) 2>&1` in - *ac_space=\ *) - # `set' does not quote correctly, so add quotes (double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \). + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" - ;; + ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n \ - "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; - esac; -} | + esac | + sort +) | sed ' + /^ac_cv_env_/b end t clear - : clear + :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end - /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - : end' >>confcache -if diff $cache_file confcache >/dev/null 2>&1; then :; else - if test -w $cache_file; then - test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" - cat confcache >$cache_file + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi else - echo "not updating unwritable cache $cache_file" + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache @@ -19356,63 +10611,56 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' -# VPATH may cause trouble with some makes, so we remove $(srcdir), -# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and -# trailing colons and then remove the whole line if VPATH becomes empty -# (actually we leave an empty line to preserve line numbers). -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=/{ -s/:*\$(srcdir):*/:/; -s/:*\${srcdir}:*/:/; -s/:*@srcdir@:*/:/; -s/^\([^=]*=[ ]*\):*/\1/; -s/:*$//; -s/^[^=]*=[ ]*$//; -}' -fi - # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that -# take arguments), then we branch to the quote section. Otherwise, +# take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. -cat >confdef2opt.sed <<\_ACEOF +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} t clear -: clear -s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote -s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote -d -: quote -s,[ `~#$^&*(){}\\|;'"<>?],\\&,g -s,\[,\\&,g -s,\],\\&,g -s,\$,$$,g -p -_ACEOF -# We use echo to avoid assuming a particular line-breaking character. -# The extra dot is to prevent the shell from consuming trailing -# line-breaks from the sub-command output. A line-break within -# single-quotes doesn't work because, if this script is created in a -# platform that uses two characters for line-breaks (e.g., DOS), tr -# would break. -ac_LF_and_DOT=`echo; echo .` -DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` -rm -f confdef2opt.sed +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" -: ${CONFIG_STATUS=./config.status} + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 -echo "$as_me: creating $CONFIG_STATUS" >&6;} -cat >$CONFIG_STATUS <<_ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. @@ -19422,81 +10670,253 @@ cat >$CONFIG_STATUS <<_ACEOF debug=false ac_cs_recheck=false ac_cs_silent=false -SHELL=\${CONFIG_SHELL-$SHELL} -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF -## --------------------- ## -## M4sh Initialization. ## -## --------------------- ## -# Be Bourne compatible -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' -elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then - set -o posix + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac fi -DUALCASE=1; export DUALCASE # for MKS sh -# Support unset when possible. -if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - as_unset=unset -else - as_unset=false + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } fi -# Work around bugs in pre-3.0 UWIN ksh. -$as_unset ENV MAIL MAILPATH +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME -do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var - else - $as_unset $as_var +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi -done + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + -# Required to use basename. -if expr a : '\(a\)' >/dev/null 2>&1; then +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi -if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi -# Name of the executable. -as_me=`$as_basename "$0" || +as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)$' \| \ - . : '\(.\)' 2>/dev/null || -echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } - /^X\/\(\/\/\)$/{ s//\1/; q; } - /^X\/\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` - -# PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -19504,148 +10924,111 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh -fi - - - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" || { - # Find who we are. Look in the path if we contain no path at all - # relative or not. - case $0 in - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break -done - - ;; - esac - # We did not find ourselves, most probably we were run as `sh COMMAND' - # in which case we are not to be found in the path. - if test "x$as_myself" = x; then - as_myself=$0 - fi - if test ! -f "$as_myself"; then - { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 -echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} - { (exit 1); exit 1; }; } - fi - case $CONFIG_SHELL in - '') - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for as_base in sh bash ksh sh5; do - case $as_dir in - /*) - if ("$as_dir/$as_base" -c ' - as_lineno_1=$LINENO - as_lineno_2=$LINENO - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then - $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } - $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } - CONFIG_SHELL=$as_dir/$as_base - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$0" ${1+"$@"} - fi;; - esac - done -done -;; - esac - - # Create $as_me.lineno as a copy of $as_myself, but with $LINENO - # uniformly replaced by the line number. The first 'sed' inserts a - # line-number line before each line; the second 'sed' does the real - # work. The second script uses 'N' to pair each line-number line - # with the numbered line, and appends trailing '-' during - # substitution so that $LINENO is not a special case at line end. - # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the - # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) - sed '=' <$as_myself | - sed ' - N - s,$,-, - : loop - s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, - t loop - s,-$,, - s,^['$as_cr_digits']*\n,, - ' >$as_me.lineno && - chmod +x $as_me.lineno || - { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 -echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} - { (exit 1); exit 1; }; } - - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensible to this). - . ./$as_me.lineno - # Exit status is that of the last command. - exit -} - - -case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in - *c*,-n*) ECHO_N= ECHO_C=' -' ECHO_T=' ' ;; - *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; - *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; esac -if expr a : '\(a\)' >/dev/null 2>&1; then - as_expr=expr +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file else - as_expr=false + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null fi - -rm -f conf$$ conf$$.exe conf$$.file -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - # We could just check for DJGPP; but this test a) works b) is more generic - # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). - if test -f conf$$.exe; then - # Don't use ln at all; we don't have any links - as_ln_s='cp -p' - else +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' fi -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln else - as_ln_s='cp -p' + as_ln_s='cp -pR' fi -rm -f conf$$ conf$$.exe conf$$.file +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + +} # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then - as_mkdir_p=: + as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi -as_executable_p="test -f" + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -19654,31 +11037,20 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" -# IFS -# We need space, tab and new line, in precisely that order. -as_nl=' -' -IFS=" $as_nl" - -# CDPATH. -$as_unset CDPATH - exec 6>&1 - -# Open the log real soon, to keep \$[0] and so on meaningful, and to +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. Logging --version etc. is OK. -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX -} >&5 -cat >&5 <<_CSEOF - +# values after options handling. +ac_log=" This file was extended by tcl $as_me 8.6, which was -generated by GNU Autoconf 2.59. Invocation command line was +generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -19686,43 +11058,41 @@ generated by GNU Autoconf 2.59. Invocation command line was CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ -_CSEOF -echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 -echo >&5 +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + _ACEOF -# Files that config.status was made for. -if test -n "$ac_config_files"; then - echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS -fi +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac -if test -n "$ac_config_headers"; then - echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS -fi -if test -n "$ac_config_links"; then - echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS -fi -if test -n "$ac_config_commands"; then - echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS -fi +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_commands="$ac_config_commands" -cat >>$CONFIG_STATUS <<\_ACEOF +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -\`$as_me' instantiates files from templates according to the -current configuration. +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. -Usage: $0 [OPTIONS] [FILE]... +Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit - -V, --version print version number, then exit - -q, --quiet do not print progress messages + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE Configuration files: $config_files @@ -19730,83 +11100,78 @@ $config_files Configuration commands: $config_commands -Report bugs to ." -_ACEOF +Report bugs to the package provider." -cat >>$CONFIG_STATUS <<_ACEOF +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ tcl config.status 8.6 -configured by $0, generated by GNU Autoconf 2.59, - with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" -Copyright (C) 2003 Free Software Foundation, Inc. +Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." -srcdir=$srcdir + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -# If no file are specified by the user, then we need to provide default -# value. By we need to know if files were specified by the user. +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in - --*=*) - ac_option=`expr "x$1" : 'x\([^=]*\)='` - ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= ac_shift=: ;; - -*) + *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; - *) # This is not an option, so the user has probably given explicit - # arguments. - ac_option=$1 - ac_need_defaults=false;; esac case $ac_option in # Handling of the options. -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; - --version | --vers* | -V ) - echo "$ac_cs_version"; exit 0 ;; - --he | --h) - # Conflict between --help and --header - { { echo "$as_me:$LINENO: error: ambiguous option: $1 -Try \`$0 --help' for more information." >&5 -echo "$as_me: error: ambiguous option: $1 -Try \`$0 --help' for more information." >&2;} - { (exit 1); exit 1; }; };; - --help | --hel | -h ) - echo "$ac_cs_usage"; exit 0 ;; - --debug | --d* | -d ) + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift - CONFIG_FILES="$CONFIG_FILES $ac_optarg" - ac_need_defaults=false;; - --header | --heade | --head | --hea ) - $ac_shift - CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. - -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 -Try \`$0 --help' for more information." >&5 -echo "$as_me: error: unrecognized option: $1 -Try \`$0 --help' for more information." >&2;} - { (exit 1); exit 1; }; } ;; + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; - *) ac_config_targets="$ac_config_targets $1" ;; + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; esac shift @@ -19820,43 +11185,55 @@ if $ac_cs_silent; then fi _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then - echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 - exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" fi _ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 -cat >>$CONFIG_STATUS <<_ACEOF +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # -# INIT-COMMANDS section. +# INIT-COMMANDS # - VERSION=${TCL_VERSION} _ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<\_ACEOF +# Handling of arguments. for ac_config_target in $ac_config_targets do - case "$ac_config_target" in - # Handling of arguments. - "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; - "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; - "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; - "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; - "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; - "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; - "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; - *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 -echo "$as_me: error: invalid argument: $ac_config_target" >&2;} - { (exit 1); exit 1; }; };; + case $ac_config_target in + "Tcl-Info.plist") CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; + "Tclsh-Info.plist") CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; + "Tcl.framework") CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; + "dltest/Makefile") CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; + "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; + "tcl.pc") CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done + # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely @@ -19867,533 +11244,427 @@ if $ac_need_defaults; then fi # Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason to put it here, and in addition, +# simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. -# Create a temporary directory, and hook for its removal unless debugging. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. $debug || { - trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 - trap '{ (exit 1); exit 1; }' 1 2 13 15 + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 } - # Create a (secure) tmp directory for tmp files. { - tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" } || { - tmp=./confstat$$-$RANDOM - (umask 077 && mkdir $tmp) -} || + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + { - echo "$me: cannot create a temporary directory in ." >&2 - { (exit 1); exit 1; } + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi -# -# CONFIG_FILES section. -# +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" -# No need to generate the scripts if there are no CONFIG_FILES. -# This happens for instance when ./config.status config.h -if test -n "\$CONFIG_FILES"; then - # Protect against being on the right side of a sed subst in config.status. - sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; - s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF -s,@SHELL@,$SHELL,;t t -s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t -s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t -s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t -s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t -s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t -s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t -s,@exec_prefix@,$exec_prefix,;t t -s,@prefix@,$prefix,;t t -s,@program_transform_name@,$program_transform_name,;t t -s,@bindir@,$bindir,;t t -s,@sbindir@,$sbindir,;t t -s,@libexecdir@,$libexecdir,;t t -s,@datadir@,$datadir,;t t -s,@sysconfdir@,$sysconfdir,;t t -s,@sharedstatedir@,$sharedstatedir,;t t -s,@localstatedir@,$localstatedir,;t t -s,@libdir@,$libdir,;t t -s,@includedir@,$includedir,;t t -s,@oldincludedir@,$oldincludedir,;t t -s,@infodir@,$infodir,;t t -s,@mandir@,$mandir,;t t -s,@build_alias@,$build_alias,;t t -s,@host_alias@,$host_alias,;t t -s,@target_alias@,$target_alias,;t t -s,@DEFS@,$DEFS,;t t -s,@ECHO_C@,$ECHO_C,;t t -s,@ECHO_N@,$ECHO_N,;t t -s,@ECHO_T@,$ECHO_T,;t t -s,@LIBS@,$LIBS,;t t -s,@MAN_FLAGS@,$MAN_FLAGS,;t t -s,@CC@,$CC,;t t -s,@CFLAGS@,$CFLAGS,;t t -s,@LDFLAGS@,$LDFLAGS,;t t -s,@CPPFLAGS@,$CPPFLAGS,;t t -s,@ac_ct_CC@,$ac_ct_CC,;t t -s,@EXEEXT@,$EXEEXT,;t t -s,@OBJEXT@,$OBJEXT,;t t -s,@CPP@,$CPP,;t t -s,@EGREP@,$EGREP,;t t -s,@TCL_THREADS@,$TCL_THREADS,;t t -s,@TCLSH_PROG@,$TCLSH_PROG,;t t -s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t -s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t -s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t -s,@RANLIB@,$RANLIB,;t t -s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t -s,@AR@,$AR,;t t -s,@ac_ct_AR@,$ac_ct_AR,;t t -s,@LIBOBJS@,$LIBOBJS,;t t -s,@TCL_LIBS@,$TCL_LIBS,;t t -s,@DL_LIBS@,$DL_LIBS,;t t -s,@DL_OBJS@,$DL_OBJS,;t t -s,@PLAT_OBJS@,$PLAT_OBJS,;t t -s,@PLAT_SRCS@,$PLAT_SRCS,;t t -s,@LDAIX_SRC@,$LDAIX_SRC,;t t -s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t -s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t -s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t -s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t -s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t -s,@CC_SEARCH_FLAGS@,$CC_SEARCH_FLAGS,;t t -s,@LD_SEARCH_FLAGS@,$LD_SEARCH_FLAGS,;t t -s,@STLIB_LD@,$STLIB_LD,;t t -s,@SHLIB_LD@,$SHLIB_LD,;t t -s,@TCL_SHLIB_LD_EXTRAS@,$TCL_SHLIB_LD_EXTRAS,;t t -s,@TK_SHLIB_LD_EXTRAS@,$TK_SHLIB_LD_EXTRAS,;t t -s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t -s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t -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 -s,@DTRACE@,$DTRACE,;t t -s,@TCL_VERSION@,$TCL_VERSION,;t t -s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t -s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t -s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t -s,@TCL_YEAR@,$TCL_YEAR,;t t -s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t -s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t -s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t -s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t -s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t -s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t -s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t -s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t -s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t -s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t -s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t -s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t -s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t -s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t -s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t -s,@LD_LIBRARY_PATH_VAR@,$LD_LIBRARY_PATH_VAR,;t t -s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t -s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t -s,@TCL_SHARED_LIB_SUFFIX@,$TCL_SHARED_LIB_SUFFIX,;t t -s,@TCL_UNSHARED_LIB_SUFFIX@,$TCL_UNSHARED_LIB_SUFFIX,;t t -s,@TCL_HAS_LONGLONG@,$TCL_HAS_LONGLONG,;t t -s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t -s,@DTRACE_SRC@,$DTRACE_SRC,;t t -s,@DTRACE_HDR@,$DTRACE_HDR,;t t -s,@DTRACE_OBJ@,$DTRACE_OBJ,;t t -s,@MAKEFILE_SHELL@,$MAKEFILE_SHELL,;t t -s,@BUILD_DLTEST@,$BUILD_DLTEST,;t t -s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t -s,@TCL_MODULE_PATH@,$TCL_MODULE_PATH,;t t -s,@TCL_LIBRARY@,$TCL_LIBRARY,;t t -s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t -s,@HTML_DIR@,$HTML_DIR,;t t -s,@PACKAGE_DIR@,$PACKAGE_DIR,;t t -s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t -s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t -s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t -s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t -s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t -s,@EXTRA_TCLSH_LIBS@,$EXTRA_TCLSH_LIBS,;t t -s,@DLTEST_LD@,$DLTEST_LD,;t t -s,@DLTEST_SUFFIX@,$DLTEST_SUFFIX,;t t -CEOF -_ACEOF +eval set X " :F $CONFIG_FILES :C $CONFIG_COMMANDS" +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift - cat >>$CONFIG_STATUS <<\_ACEOF - # Split the substitutions into bite-sized pieces for seds with - # small command number limits, like on Digital OSF/1 and HP-UX. - ac_max_sed_lines=48 - ac_sed_frag=1 # Number of current file. - ac_beg=1 # First line for current file. - ac_end=$ac_max_sed_lines # Line after last line for current file. - ac_more_lines=: - ac_sed_cmds= - while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag - else - sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag - fi - if test ! -s $tmp/subs.frag; then - ac_more_lines=false - else - # The purpose of the label and of the branching condition is to - # speed up the sed processing (if there are no `@' at all, there - # is no need to browse any of the substitutions). - # These are the two extra sed commands mentioned above. - (echo ':t - /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" - else - ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" - fi - ac_sed_frag=`expr $ac_sed_frag + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_lines` + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} fi - done - if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat - fi -fi # test -n "$CONFIG_FILES" + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF -for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case $ac_file in - - | *:- | *:-:* ) # input from stdin - cat >$tmp/stdin - ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; - *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; - * ) ac_file_in=$ac_file.in ;; + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; esac - # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. - ac_dir=`(dirname "$ac_file") 2>/dev/null || + ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - { if $as_mkdir_p; then - mkdir -p "$ac_dir" - else - as_dir="$ac_dir" - as_dirs= - while test ! -d "$as_dir"; do - as_dirs="$as_dir $as_dirs" - as_dir=`(dirname "$as_dir") 2>/dev/null || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - done - test ! -n "$as_dirs" || mkdir $as_dirs - fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 -echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} - { (exit 1); exit 1; }; }; } - + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix case $srcdir in - .) # No --srcdir option. We are building in place. + .) # We are building in place. ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; -esac - -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; esac - - - - if test x"$ac_file" != x-; then - { echo "$as_me:$LINENO: creating $ac_file" >&5 -echo "$as_me: creating $ac_file" >&6;} - rm -f "$ac_file" - fi - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - if test x"$ac_file" = x-; then - configure_input= - else - configure_input="$ac_file. " - fi - configure_input=$configure_input"Generated from `echo $ac_file_in | - sed 's,.*/,,'` by configure." - - # First look for the input files in the build tree, otherwise in the - # src tree. - ac_file_inputs=`IFS=: - for f in $ac_file_in; do - case $f in - -) echo $tmp/stdin ;; - [\\/$]*) - # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 -echo "$as_me: error: cannot find input file: $f" >&2;} - { (exit 1); exit 1; }; } - echo "$f";; - *) # Relative - if test -f "$f"; then - # Build tree - echo "$f" - elif test -f "$srcdir/$f"; then - # Source tree - echo "$srcdir/$f" - else - # /dev/null tree - { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 -echo "$as_me: error: cannot find input file: $f" >&2;} - { (exit 1); exit 1; }; } - fi;; - esac - done` || { (exit 1); exit 1; } _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF - sed "$ac_vpsub + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub $extrasub _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s,@configure_input@,$configure_input,;t t -s,@srcdir@,$ac_srcdir,;t t -s,@abs_srcdir@,$ac_abs_srcdir,;t t -s,@top_srcdir@,$ac_top_srcdir,;t t -s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t -s,@builddir@,$ac_builddir,;t t -s,@abs_builddir@,$ac_abs_builddir,;t t -s,@top_builddir@,$ac_top_builddir,;t t -s,@abs_top_builddir@,$ac_abs_top_builddir,;t t -" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out - rm -f $tmp/stdin - if test x"$ac_file" != x-; then - mv $tmp/out $ac_file - else - cat $tmp/out - rm -f $tmp/out - fi - -done -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF - -# -# CONFIG_COMMANDS section. -# -for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue - ac_dest=`echo "$ac_file" | sed 's,:.*,,'` - ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_dir=`(dirname "$ac_dest") 2>/dev/null || -$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_dest" : 'X\(//\)[^/]' \| \ - X"$ac_dest" : 'X\(//\)$' \| \ - X"$ac_dest" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$ac_dest" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - { if $as_mkdir_p; then - mkdir -p "$ac_dir" - else - as_dir="$ac_dir" - as_dirs= - while test ! -d "$as_dir"; do - as_dirs="$as_dir $as_dirs" - as_dir=`(dirname "$as_dir") 2>/dev/null || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - done - test ! -n "$as_dirs" || mkdir $as_dirs - fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 -echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} - { (exit 1); exit 1; }; }; } - - ac_builddir=. - -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; -case $srcdir in - .) # No --srcdir option. We are building in place. - ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; -esac -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; -esac + :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 +$as_echo "$as_me: executing $ac_file commands" >&6;} + ;; + esac - { echo "$as_me:$LINENO: executing $ac_dest commands" >&5 -echo "$as_me: executing $ac_dest commands" >&6;} - case $ac_dest in - Tcl.framework ) n=Tcl && + case $ac_file$ac_mode in + "Tcl.framework":C) n=Tcl && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && unset n f v ;; + esac -done -_ACEOF +done # for ac_tag -cat >>$CONFIG_STATUS <<\_ACEOF -{ (exit 0); exit 0; } +as_fn_exit 0 _ACEOF -chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. @@ -20413,7 +11684,11 @@ if test "$no_create" != yes; then exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. - $ac_cs_success || { (exit 1); exit 1; } + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi diff --git a/unix/configure.in b/unix/configure.in index 85bd7ee..7a15fb7 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -793,6 +793,10 @@ eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" eval "TCL_LIB_FILE=${TCL_LIB_FILE}" +eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" +eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" + + TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' @@ -937,6 +941,7 @@ AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_PATH) +AC_SUBST(TCL_KIT_LIB_FILE) AC_SUBST(TCL_INCLUDE_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_PATH) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 3ca65d8..88f2b81 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2060,6 +2060,14 @@ dnl # preprocessing tests use only CPPFLAGS. ]) ]) + AS_IF([test "$RANLIB" = ""], [ + MAKE_KIT_LIB='$(STLIB_LD) [$]@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS}' + INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)"' + ], [ + MAKE_KIT_LIB='${STLIB_LD} [$]@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} ; ${RANLIB} [$]@' + INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(TCL_KIT_LIB_FILE))' + ]) + # Stub lib does not depend on shared/static configuration AS_IF([test "$RANLIB" = ""], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}' @@ -2126,10 +2134,12 @@ dnl # preprocessing tests use only CPPFLAGS. [What is the default extension for shared libraries?]) AC_SUBST(MAKE_LIB) + AC_SUBST(MAKE_KIT_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(INSTALL_LIB) AC_SUBST(DLL_INSTALL_DIR) AC_SUBST(INSTALL_STUB_LIB) + AC_SUBST(INSTALL_KIT_LIB) AC_SUBST(RANLIB) ]) -- cgit v0.12 From ab35383fda8fe297152230b0f3778eb992d015d7 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Sep 2014 13:59:09 +0000 Subject: Add Static library link instructions to tclConfig.sh --- unix/Makefile.in | 6 ------ unix/configure | 46 +++++++++++++++++++++++++++++++++++++++------- unix/configure.in | 41 ++++++++++++++++++++++++++++++++++------- unix/tclConfig.sh.in | 28 ++++++++++++++++++++++++++++ 4 files changed, 101 insertions(+), 20 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 7d9b82d..c66cc0a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -649,12 +649,6 @@ ${TCL_KIT_LIB_FILE}: ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} rm -f $@ @MAKE_KIT_LIB@ - #${SHLIB_LD} $@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} ; ${RANLIB} $@ - #${CC} ${CFLAGS} ${LDFLAGS} \ - # ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} \ - # ${CC_SEARCH_FLAGS} -o ${TCL_KIT_LIB_FILE} - - # Make target which outputs the list of the .o contained in the Tcl lib useful # to build a single big shared library containing Tcl and other extensions. # Used for the Tcl Plugin. -- dl diff --git a/unix/configure b/unix/configure index 2740498..a5f318e 100755 --- a/unix/configure +++ b/unix/configure @@ -642,20 +642,25 @@ TCL_HAS_LONGLONG TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_LIB_SUFFIX TCL_LIB_VERSIONS_OK -TCL_BUILD_LIB_SPEC LD_LIBRARY_PATH_VAR TCL_SHARED_BUILD CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_SHARED_LIB_SUFFIX TCL_SRC_DIR -TCL_BUILD_STUB_LIB_PATH -TCL_BUILD_STUB_LIB_SPEC TCL_INCLUDE_SPEC +TCL_BUILD_KIT_LIB_PATH +TCL_BUILD_KIT_LIB_SPEC +TCL_KIT_LIB_PATH +TCL_KIT_LIB_SPEC +TCL_KIT_LIB_FLAG TCL_KIT_LIB_FILE +TCL_BUILD_STUB_LIB_PATH +TCL_BUILD_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_STUB_LIB_SPEC TCL_STUB_LIB_FLAG TCL_STUB_LIB_FILE +TCL_BUILD_LIB_SPEC TCL_LIB_SPEC TCL_LIB_FLAG TCL_LIB_FILE @@ -10288,10 +10293,6 @@ eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" eval "TCL_LIB_FILE=${TCL_LIB_FILE}" -eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" -eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" - - TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' @@ -10428,6 +10429,29 @@ fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl +# core vfs and kit support. +#-------------------------------------------------------------------- + +eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" +eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" + +eval "TCL_KIT_LIB_FILE=libtclkit${TCL_UNSHARED_LIB_SUFFIX}" +eval "TCL_KIT_LIB_FILE=\"${TCL_KIT_LIB_FILE}\"" +eval "TCL_KIT_LIB_DIR=${libdir}" + +if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + TCL_KIT_LIB_FLAG="-ltclkit${TCL_VERSION}" +else + TCL_KIT_LIB_FLAG="-ltclkit`echo ${TCL_VERSION} | tr -d .`" +fi + +TCL_BUILD_KIT_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_KIT_LIB_FLAG}" +TCL_KIT_LIB_SPEC="-L${TCL_KIT_LIB_DIR} ${TCL_KIT_LIB_FLAG}" +TCL_BUILD_KIT_LIB_PATH="`pwd`/${TCL_KIT_LIB_FILE}" +TCL_KIT_LIB_PATH="${TCL_KIT_LIB_DIR}/${TCL_KIT_LIB_FILE}" + +#-------------------------------------------------------------------- +# The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- @@ -10519,6 +10543,14 @@ TCL_SHARED_BUILD=${SHARED_BUILD} + + + + + + + + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF diff --git a/unix/configure.in b/unix/configure.in index 7a15fb7..bc7bdef 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -793,10 +793,6 @@ eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" eval "TCL_LIB_FILE=${TCL_LIB_FILE}" -eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" -eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" - - TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' @@ -897,6 +893,29 @@ fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl +# core vfs and kit support. +#-------------------------------------------------------------------- + +eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" +eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" + +eval "TCL_KIT_LIB_FILE=libtclkit${TCL_UNSHARED_LIB_SUFFIX}" +eval "TCL_KIT_LIB_FILE=\"${TCL_KIT_LIB_FILE}\"" +eval "TCL_KIT_LIB_DIR=${libdir}" + +if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + TCL_KIT_LIB_FLAG="-ltclkit${TCL_VERSION}" +else + TCL_KIT_LIB_FLAG="-ltclkit`echo ${TCL_VERSION} | tr -d .`" +fi + +TCL_BUILD_KIT_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_KIT_LIB_FLAG}" +TCL_KIT_LIB_SPEC="-L${TCL_KIT_LIB_DIR} ${TCL_KIT_LIB_FLAG}" +TCL_BUILD_KIT_LIB_PATH="`pwd`/${TCL_KIT_LIB_FILE}" +TCL_KIT_LIB_PATH="${TCL_KIT_LIB_DIR}/${TCL_KIT_LIB_FILE}" + +#-------------------------------------------------------------------- +# The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- @@ -937,15 +956,24 @@ AC_SUBST(PKG_CFG_ARGS) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) +AC_SUBST(TCL_BUILD_LIB_SPEC) + AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_PATH) -AC_SUBST(TCL_KIT_LIB_FILE) -AC_SUBST(TCL_INCLUDE_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_PATH) +AC_SUBST(TCL_KIT_LIB_FILE) +AC_SUBST(TCL_KIT_LIB_FLAG) +AC_SUBST(TCL_KIT_LIB_SPEC) +AC_SUBST(TCL_KIT_LIB_PATH) +AC_SUBST(TCL_BUILD_KIT_LIB_SPEC) +AC_SUBST(TCL_BUILD_KIT_LIB_PATH) + +AC_SUBST(TCL_INCLUDE_SPEC) + AC_SUBST(TCL_SRC_DIR) AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX) AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) @@ -953,7 +981,6 @@ AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) AC_SUBST(TCL_SHARED_BUILD) AC_SUBST(LD_LIBRARY_PATH_VAR) -AC_SUBST(TCL_BUILD_LIB_SPEC) AC_SUBST(TCL_LIB_VERSIONS_OK) AC_SUBST(TCL_SHARED_LIB_SUFFIX) diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index b58e9fd..976bd7f 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -39,6 +39,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' +# The name of the static Tcl library (intended for kits): +TCL_KIT_LIB_FILE='@TCL_KIT_LIB_FILE@' + # Additional libraries to use when linking Tcl. TCL_LIBS='@TCL_LIBS@' @@ -142,6 +145,31 @@ TCL_SRC_DIR='@TCL_SRC_DIR@' # the "exec_prefix" directory, if it is different. TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@' +# Core VFS Kit Support +TCL_SUPPORT_KITS=1 + +# The name of the Tcl kit library (.a): +TCL_KIT_LIB_FILE='@TCL_KIT_LIB_FILE@' + +# -l flag to pass to the linker to pick up the Tcl kit library +TCL_KIT_LIB_FLAG='@TCL_KIT_LIB_FLAG@' + +# String to pass to linker to pick up the Tcl kit library from its +# build directory. +TCL_BUILD_KIT_LIB_SPEC='@TCL_BUILD_KIT_LIB_SPEC@' + +# String to pass to linker to pick up the Tcl kit library from its +# installed directory. +TCL_KIT_LIB_SPEC='@TCL_KIT_LIB_SPEC@' + +# Path to the Tcl kit library in the build directory. +TCL_BUILD_KIT_LIB_PATH='@TCL_BUILD_KIT_LIB_PATH@' + +# Path to the Tcl kit library in the install directory. +TCL_KIT_LIB_PATH='@TCL_KIT_LIB_PATH@' + +# END VFS SUPPORT + # Tcl supports stub. TCL_SUPPORTS_STUBS=1 -- cgit v0.12 From 627a5bfa7394225c69b765ba58c42fc7850a8157 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Sep 2014 14:47:12 +0000 Subject: Instead of statically link the tclkit executable, pack the tcl dll in the VFS --- tools/mkVfs.tcl | 16 +++++++++++----- unix/Makefile.in | 21 +++++++++++++-------- win/Makefile.in | 2 +- 3 files changed, 25 insertions(+), 14 deletions(-) diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl index c7bf17b..c796f8a 100644 --- a/tools/mkVfs.tcl +++ b/tools/mkVfs.tcl @@ -53,14 +53,20 @@ proc copyDir {d1 d2} { } } -if {[llength $argv] < 3} { - puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" +if {[llength $argv] < 4} { + puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM TCLDLL" exit 1 } -set TCL_SCRIPT_DIR [lindex $argv 0] -set TCLSRC_ROOT [lindex $argv 1] -set PLATFORM [lindex $argv 2] +set VFSROOT [lindex $argv 0] +set VERSION [lindex $argv 1] +set TCLSRC_ROOT [lindex $argv 2] +set PLATFORM [lindex $argv 3] +set TCLDLL [lindex $argv 4] +file mkdir [file join $VFSROOT bin] +file copy -force $TCLDLL [file join $VFSROOT bin $TCLDLL] + +set TCL_SCRIPT_DIR [file join $VFSROOT tcl$VERSION] puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} diff --git a/unix/Makefile.in b/unix/Makefile.in index 30e7109..bce12bd 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -588,6 +588,8 @@ MAC_OSX_SRCS = \ CYGWIN_SRCS = \ $(TOP_DIR)/win/tclWinError.c +TCLKIT_SRCS = $(UNIX_DIR)/tclKitInit.c + DTRACE_HDR = tclDTrace.h DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d @@ -610,7 +612,7 @@ ZLIB_SRCS = \ # things like "make depend". SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ - $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ + $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ $TCLKIT_SRCS PWD=`pwd` VFS_INSTALL_DIR=${PWD}/tclkit.vfs/tcl8.6 @@ -665,18 +667,18 @@ null.zip: # Rather than force an install, pack the files we need into a # file system under our control tclkit.vfs: - make install-libraries DESTDIR=tclkit.vfs - make install-tzdata DESTDIR=tclkit.vfs - make install-packages DESTDIR=tclkit.vfs + @echo "Building VFS File system in tclkit.vfs" + @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ + "$(UNIX_DIR)/tclkit.vfs" "$(VERSION)" "$(TOP_DIR)" unix ${TCL_LIB_FILE} # Assemble all of the tcl sources into a single executable -${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs +${TCLKIT_EXE}: ${TCL_EXE} $(TCLKIT_OBJS) ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${ZLIB_OBJS} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLKIT_OBJS} ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} \ - ${LIBS} @EXTRA_TCLSH_LIBS@ \ + $(TCLKIT_OBJS) ${ZLIB_OBJS} \ + @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} - cd tclkit.vfs${prefix}/lib ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . + cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status @@ -1195,6 +1197,9 @@ tclIORChan.o: $(GENERIC_DIR)/tclIORChan.c $(IOHDR) tclIORTrans.o: $(GENERIC_DIR)/tclIORTrans.c $(IOHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIORTrans.c +tclKitInit.o: $(UNIX_DIR)/tclKitInit.c + $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclKitInit.c + tclLink.o: $(GENERIC_DIR)/tclLink.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c diff --git a/win/Makefile.in b/win/Makefile.in index ec824cc..bf3e303 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -443,7 +443,7 @@ null.zip: tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) @echo "Building VFS File system in tclkit.vfs" @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ - "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows + "$(WIN_DIR)/tclkit.vfs" "$(VERSION)" "$(ROOT_DIR)" windows $(TCL_LIB_FILE) $(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) $(LIBS) \ -- cgit v0.12 From 39145d45d1ef517387a8247804f7ccb8fa811174 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Sep 2014 15:02:11 +0000 Subject: Add tclkit to "make all" and install --- unix/Makefile.in | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index bce12bd..c5c3fa6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -623,7 +623,7 @@ VFS_INSTALL_DIR=${PWD}/tclkit.vfs/tcl8.6 all: binaries libraries doc packages -binaries: ${LIB_FILE} ${TCL_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} ${TCLKIT_EXE} libraries: @@ -677,6 +677,7 @@ ${TCLKIT_EXE}: ${TCL_EXE} $(TCLKIT_OBJS) ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} $ $(TCLKIT_OBJS) ${ZLIB_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} + cp -f ${TCLKIT_EXE} ${TCLKIT_EXE}.raw cat null.zip >> ${TCLKIT_EXE} cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . @@ -833,6 +834,8 @@ install-binaries: binaries @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" + @echo "Installing ${TCLKIT_EXE} as $(BIN_INSTALL_DIR)/tclkit$(VERSION)${EXE_SUFFIX}" + @$(INSTALL_PROGRAM) ${TCLKIT_EXE} "$(BIN_INSTALL_DIR)/tclkit$(VERSION)${EXE_SUFFIX}" @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/" -- cgit v0.12 From 99d72ae8921b1f93943f485fedc93d03e285509b Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Sep 2014 15:09:23 +0000 Subject: Added the "run tcl dll from vfs" magic to windows --- win/Makefile.in | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index bf3e303..6d74cdb 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -411,8 +411,7 @@ ZLIB_OBJS = \ TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ -TCLKIT_OBJS = tclKitInit.$(OBJEXT) \ - ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} +TCLKIT_OBJS = tclKitInit.$(OBJEXT) ${ZLIB_OBJS} TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] @@ -446,7 +445,7 @@ tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) "$(WIN_DIR)/tclkit.vfs" "$(VERSION)" "$(ROOT_DIR)" windows $(TCL_LIB_FILE) $(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs - $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) $(LIBS) \ + $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat null.zip >> $(TCLKIT) -- cgit v0.12 From ee30b1c0abf416e9e6b409e713c1309f2de7eb1b Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 12 Sep 2014 16:03:20 +0000 Subject: Developed an improved bootloader built around TclSetPreInitScript. The new bootloader now mounts the VFS before the interpreter is initialized, and gives it enough hints to point to the VFS for init.tcl and main.tcl (If present) Also, Tcl_ZVfs_Boot now takes and additional argument: the name of the file to mount. As the difference between a normal shell and a zvfs enabled shell is one again, several lines of code, the example shells is folded back into tclAppInit.c and controlled with macros. The ZVFS commands are now loaded in as a static package. Removed the Stubs entry for Tcl_Boot_ZVFS, it's now intended that shells build their own copy of tclZipVfs.o --- generic/tcl.decls | 5 -- generic/tclDecls.h | 7 --- generic/tclInt.h | 1 + generic/tclStubInit.c | 1 - generic/tclZipVfs.c | 123 +++++++++++++++++++++++++++++++------------------- tools/mkVfs.tcl | 6 +-- unix/Makefile.in | 44 ++++++++++++++---- unix/tclAppInit.c | 20 ++++++-- win/Makefile.in | 41 +++++++++++++---- win/tclAppInit.c | 20 +++++++- 10 files changed, 182 insertions(+), 86 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index c24898e..1829249 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2326,11 +2326,6 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # -# ZipVfs -declare 631 { -int Tcl_Zvfs_Boot(Tcl_Interp *interp,const char *vfsmountpoint,const char *initscript) -} - ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 65d940d..91c0add 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1815,10 +1815,6 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); -/* 631 */ -EXTERN int Tcl_Zvfs_Boot(Tcl_Interp *interp, - const char *vfsmountpoint, - const char *initscript); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2485,7 +2481,6 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ - int (*tcl_Zvfs_Boot) (Tcl_Interp *interp, const char *vfsmountpoint, const char *initscript); /* 631 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3778,8 +3773,6 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FSUnloadFile) /* 629 */ #define Tcl_ZlibStreamSetCompressionDictionary \ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ -#define Tcl_Zvfs_Boot \ - (tclStubsPtr->tcl_Zvfs_Boot) /* 631 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 6bf1ef9..6a4e354 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3153,6 +3153,7 @@ MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); #endif MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); +MODULE_SCOPE int TclZvfsInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ace1766..7a84cba 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1412,7 +1412,6 @@ const TclStubs tclStubs = { Tcl_FindSymbol, /* 628 */ Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ - Tcl_Zvfs_Boot, /* 631 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index dc96313..15f38bd 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1,7 +1,7 @@ /* * Copyright (c) 2000 D. Richard Hipp * Copyright (c) 2007 PDQ Interfaces Inc. - * Copyright (c) 2013 Sean Woods + * Copyright (c) 2013-2014 Sean Woods * * This file is now released under the BSD style license outlined in the * included file license.terms. @@ -105,7 +105,7 @@ struct ZFile { EXTERN int Tcl_Zvfs_Mount(Tcl_Interp *interp,const char *zArchive,const char *zMountPoint); EXTERN int Tcl_Zvfs_Umount(const char *zArchive); -EXTERN int Tcl_Zvfs_Init(Tcl_Interp *interp); +EXTERN int TclZvfsInit(Tcl_Interp *interp); EXTERN int Tcl_Zvfs_SafeInit(Tcl_Interp *interp); /* @@ -534,7 +534,7 @@ Tcl_Zvfs_Mount( pEntry = Tcl_FindHashEntry(&local.archiveHash, zTrueName); if (pEntry) { pArchive = Tcl_GetHashValue(pEntry); - if (pArchive) { + if (pArchive && interp) { Tcl_AppendResult(interp, pArchive->zMountPoint, 0); } } @@ -560,7 +560,7 @@ Tcl_Zvfs_Mount( iPos = Tcl_Seek(chan, -22, SEEK_END); Tcl_Read(chan, (char *) zBuf, 22); if (memcmp(zBuf, "\120\113\05\06", 4)) { - Tcl_AppendResult(interp, "not a ZIP archive", NULL); + if(interp) Tcl_AppendResult(interp, "not a ZIP archive", NULL); return TCL_ERROR; } @@ -572,8 +572,9 @@ Tcl_Zvfs_Mount( pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew); if (!isNew) { pArchive = Tcl_GetHashValue(pEntry); - Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint, - 0); + if (interp) { + Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint,0); + } Tcl_Free(zArchiveName); Tcl_Close(interp, chan); return TCL_ERROR; @@ -630,12 +631,13 @@ Tcl_Zvfs_Mount( Tcl_Read(chan, (char *) zBuf, 46); if (memcmp(zBuf, "\120\113\01\02", 4)) { - Tcl_AppendResult(interp, "ill-formed central directory entry", - NULL); - if (zTrueName) { - Tcl_Free(zTrueName); - } - return TCL_ERROR; + if(interp) { + Tcl_AppendResult(interp, "ill-formed central directory entry",NULL); + } + if (zTrueName) { + Tcl_Free(zTrueName); + } + return TCL_ERROR; } lenName = INT16(zBuf, 28); lenExtra = INT16(zBuf, 30) + INT16(zBuf, 32); @@ -1718,6 +1720,18 @@ static int ZvfsAddObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *c static int ZvfsDumpObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); static int ZvfsStartObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +static int Zvfs_Common_Init(Tcl_Interp *interp) { + if (local.isInit) return TCL_OK; + /* One-time initialization of the ZVFS */ + if(Tcl_FSRegister(interp, &Tobe_Filesystem)) { + return TCL_ERROR; + } + Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); + local.isInit = 1; + return TCL_OK; +} + /* * Initialize the ZVFS system. */ @@ -1731,7 +1745,7 @@ Zvfs_doInit( return TCL_ERROR; } #endif - Tcl_StaticPackage(interp, "zvfs", Tcl_Zvfs_Init, Tcl_Zvfs_SafeInit); + Tcl_StaticPackage(interp, "zvfs", TclZvfsInit, Tcl_Zvfs_SafeInit); if (!safe) { Tcl_CreateObjCommand(interp, "zvfs::mount", ZvfsMountObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "zvfs::unmount", ZvfsUnmountObjCmd, 0, 0); @@ -1746,16 +1760,10 @@ Zvfs_doInit( Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); /* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ - - if (!local.isInit) { - /* One-time initialization of the ZVFS */ - if(Tcl_FSRegister(NULL, &Tobe_Filesystem)) { - return TCL_ERROR; - } - Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); - local.isInit = 1; + if(Zvfs_Common_Init(interp)) { + return TCL_ERROR; } + if (Zvfs_PostInit) { Zvfs_PostInit(interp); } @@ -1765,43 +1773,58 @@ Zvfs_doInit( /* ** Boot a shell, mount the executable's VFS, detect main.tcl */ -int Tcl_Zvfs_Boot(Tcl_Interp *interp,const char *vfsmountpoint,const char *initscript) { - CONST char *cp=Tcl_GetNameOfExecutable(); - char filepath[256]; - +int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *initscript) { + FILE *fout; + Zvfs_Common_Init(NULL); + if(!vfsmountpoint) { + vfsmountpoint="/zvfs"; + } + if(!initscript) { + initscript="main.tcl"; + } /* We have to initialize the virtual filesystem before calling ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find ** its startup script files. */ - if(Zvfs_doInit(interp, 0)) { - return TCL_ERROR; - } - if(!Tcl_Zvfs_Mount(interp, cp, vfsmountpoint)) { + if(!Tcl_Zvfs_Mount(NULL, archive, vfsmountpoint)) { + Tcl_DString filepath; + Tcl_DString preinit; + Tcl_Obj *vfsinitscript; Tcl_Obj *vfstcllib; Tcl_Obj *vfstklib; + Tcl_Obj *vfspreinit; + Tcl_DStringInit(&filepath); + Tcl_DStringInit(&preinit); + + Tcl_DStringInit(&filepath); + Tcl_DStringAppend(&filepath,vfsmountpoint,-1); + Tcl_DStringAppend(&filepath,"/",-1); + Tcl_DStringAppend(&filepath,initscript,-1); + vfsinitscript=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); + Tcl_DStringFree(&filepath); - strcpy(filepath,vfsmountpoint); - strcat(filepath,"/"); - strcat(filepath,initscript); - vfsinitscript=Tcl_NewStringObj(filepath,-1); - strcpy(filepath,vfsmountpoint); - strcat(filepath,"/tcl8.6"); - vfstcllib=Tcl_NewStringObj(filepath,-1); - strcpy(filepath,vfsmountpoint); - strcat(filepath,"/tk8.6"); - vfstklib=Tcl_NewStringObj(filepath,-1); - + Tcl_DStringInit(&filepath); + Tcl_DStringAppend(&filepath,vfsmountpoint,-1); + Tcl_DStringAppend(&filepath,"/tcl8.6",-1); + vfstcllib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); + Tcl_DStringFree(&filepath); + + Tcl_DStringInit(&filepath); + Tcl_DStringAppend(&filepath,vfsmountpoint,-1); + Tcl_DStringAppend(&filepath,"/tk8.6",-1); + vfstklib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); + Tcl_DStringFree(&filepath); + Tcl_IncrRefCount(vfsinitscript); Tcl_IncrRefCount(vfstcllib); Tcl_IncrRefCount(vfstklib); if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { /* Startup script should be set before calling Tcl_AppInit */ + fprintf(fout,"%s\n",Tcl_GetString(vfsinitscript)); Tcl_SetStartupScript(vfsinitscript,NULL); - } else { - Tcl_SetStartupScript(NULL,NULL); } if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { @@ -1811,12 +1834,18 @@ int Tcl_Zvfs_Boot(Tcl_Interp *interp,const char *vfsmountpoint,const char *inits Tcl_SetStartupScript(NULL,NULL); } if(Tcl_FSAccess(vfstcllib,F_OK)==0) { - Tcl_SetVar2(interp, "env", "TCL_LIBRARY", Tcl_GetString(vfstcllib), TCL_GLOBAL_ONLY); + Tcl_DStringAppend(&preinit,"\nset tcl_library ",-1); + Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstcllib)); } if(Tcl_FSAccess(vfstklib,F_OK)==0) { - Tcl_SetVar2(interp, "env", "TK_LIBRARY", Tcl_GetString(vfstklib), TCL_GLOBAL_ONLY); + Tcl_DStringAppend(&preinit,"\nset tk_library ",-1); + Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstklib)); } - + vfspreinit=Tcl_NewStringObj(Tcl_DStringValue(&preinit),-1); + /* NOTE: We never decr this refcount, lest the contents of the script be deallocated */ + Tcl_IncrRefCount(vfspreinit); + TclSetPreInitScript(Tcl_GetString(vfspreinit)); + Tcl_DecrRefCount(vfsinitscript); Tcl_DecrRefCount(vfstcllib); Tcl_DecrRefCount(vfstklib); @@ -1826,7 +1855,7 @@ int Tcl_Zvfs_Boot(Tcl_Interp *interp,const char *vfsmountpoint,const char *inits int -Tcl_Zvfs_Init( +TclZvfsInit( Tcl_Interp *interp) { return Zvfs_doInit(interp, 0); diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl index c7bf17b..83eb9e6 100644 --- a/tools/mkVfs.tcl +++ b/tools/mkVfs.tcl @@ -15,7 +15,7 @@ proc pkgIndexDir {root fout d1} { if {[file isdirectory $f] && [string compare CVS $ftail]} { pkgIndexDir $root $fout $f } elseif {[file tail $f] eq "pkgIndex.tcl"} { - puts $fout "set dir \$HERE[string range $d1 $idx end]" + puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]" puts $fout [cat $f] } } @@ -87,7 +87,7 @@ set fout [open ${TCL_SCRIPT_DIR}/tclIndex a] puts $fout {# # MANIFEST OF INCLUDED PACKAGES # -set HERE $dir +set VFSROOT $dir } pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} close $fout @@ -96,12 +96,10 @@ puts $fout { # Save Tcl the trouble of hunting for these packages } set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] -puts "DDE DLL $ddedll" if {$ddedll != {}} { puts $fout [cat ${TCL_SCRIPT_DIR}/dde/pkgIndex.tcl] } set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] -puts "REG DLL $ddedll" if {$regdll != {}} { puts $fout [cat ${TCL_SCRIPT_DIR}/reg/pkgIndex.tcl] } diff --git a/unix/Makefile.in b/unix/Makefile.in index c66cc0a..c98f6ce 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -312,7 +312,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ - tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o tclZipVfs.o \ + tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ tclTomMathInterface.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ @@ -364,7 +364,7 @@ ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ -TCLKIT_OBJS = tclKitInit.o +TCLKIT_OBJS = tclKitInit.o tclZipVfs.o OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ @@ -558,7 +558,6 @@ UNIX_HDRS = \ UNIX_SRCS = \ $(UNIX_DIR)/tclAppInit.c \ - $(UNIX_DIR)/tclKitInit.c \ $(UNIX_DIR)/tclUnixChan.c \ $(UNIX_DIR)/tclUnixEvent.c \ $(UNIX_DIR)/tclUnixFCmd.c \ @@ -674,19 +673,41 @@ null.zip: # Rather than force an install, pack the files we need into a # file system under our control tclkit.vfs: - make install-libraries DESTDIR=tclkit.vfs - make install-tzdata DESTDIR=tclkit.vfs - make install-packages DESTDIR=tclkit.vfs + @echo "Building VFS File system in tclkit.vfs" + @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ + "$(UNIX_DIR)/tclkit.vfs/tcl$(VERSION)" "$(TOP_DIR)" unix # Assemble all of the tcl sources into a single executable -${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_KIT_LIB_FILE} null.zip tclkit.vfs +${TCLKIT_EXE}: + +# Builds an executable directly from the Tcl sources +tclkit-direct: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs + ${CC} ${CFLAGS} ${LDFLAGS} \ + ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} \ + ${LIBS} @EXTRA_TCLSH_LIBS@ \ + ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} + cat null.zip >> ${TCLKIT_EXE} + cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . + +# Builds an executable linked to the Tcl dynamic library +tclkit-dynamic: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tclkit.vfs + ${CC} ${CFLAGS} ${LDFLAGS} \ + ${TCLKIT_OBJS} \ + @TCL_BUILD_LIB_SPEC@ \ + ${LIBS} @EXTRA_TCLSH_LIBS@ \ + ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} + cat null.zip >> ${TCLKIT_EXE} + cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . + +# Builds a tcl static library, as well as an executable linked to the Tcl static library +tclkit-kitlib: ${TCLKIT_OBJS} ${TCL_KIT_LIB_FILE} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ ${TCLKIT_OBJS} \ - @TCL_BUILD_LIB_SPEC@ ${TCL_KIT_LIB_FILE} \ + @TCL_BUILD_KIT_LIB_SPEC@ \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} - cd tclkit.vfs${prefix}/lib ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . + cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status @@ -1070,6 +1091,10 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} mv tclAppInit.sav tclAppInit.o; \ fi; +tclKitInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} + $(CC) -c $(APP_CC_SWITCHES) \ + -DTCL_ZIPVFS $(UNIX_DIR)/tclAppInit.c -o tclKitInit.o + # Object files used on all Unix systems: REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \ @@ -2171,6 +2196,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages +.PHONY: tclkit-direct tclkit-dynamic tclkit-kitlib #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 9bbc88b..4df6387 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -40,7 +40,10 @@ extern Tcl_PackageInitProc Tclxttest_Init; #endif MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); MODULE_SCOPE int main(int, char **); - +#ifdef TCL_ZIPVFS + MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); + MODULE_SCOPE int TclZvfsInit(Tcl_Interp *); +#endif /* TCL_ZIPVFS */ /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, etc., @@ -80,7 +83,13 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif - +#ifdef TCL_ZIPVFS + #define TCLKIT_INIT "main.tcl" + #define TCLKIT_VFSMOUNT "/zvfs" + Tcl_FindExecutable(argv[0]); + CONST char *cp=Tcl_GetNameOfExecutable(); + Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT); +#endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -111,7 +120,12 @@ Tcl_AppInit( if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } - +#ifdef TCL_ZIPVFS + /* Load the ZipVfs package */ + if (TclZvfsInit(interp) == TCL_ERROR) { + return TCL_ERROR; + } +#endif #ifdef TCL_XT_TEST if (Tclxttest_Init(interp) == TCL_ERROR) { return TCL_ERROR; diff --git a/win/Makefile.in b/win/Makefile.in index 6fdbacf..0b52640 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -299,9 +299,8 @@ GENERIC_OBJS = \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ - tclZlib.$(OBJEXT) \ - tclZipVfs.$(OBJEXT) - + tclZlib.$(OBJEXT) + TOMMATH_OBJS = \ bncore.${OBJEXT} \ bn_reverse.${OBJEXT} \ @@ -411,9 +410,7 @@ ZLIB_OBJS = \ TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ -TCLKIT_OBJS = tclKitInit.$(OBJEXT) \ - ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} - +TCLKIT_OBJS = tclKitInit.$(OBJEXT) tclZipVfs.$(OBJEXT) TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] @@ -445,8 +442,31 @@ tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows -$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs - $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) $(LIBS) \ +$(TCLKIT): tclkit-direct + +# Builds an executable directly from the Tcl sources +tclkit-direct: $(TCLKIT_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs + rm *.$(OBJEXT) + $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) \ + ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} \ + $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ + rm *.$(OBJEXT) + cat null.zip >> $(TCLKIT) + cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . + + +# Builds an executable linked to the Tcl dynamic library +tclkit-dynamic: $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs + $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ + cat null.zip >> $(TCLKIT) + cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . + +tclkit-kitlib: $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs + $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat null.zip >> $(TCLKIT) @@ -515,6 +535,9 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +tclKitInit.${OBJEXT}: tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_ZIPVFS @DEPARG@ $(CC_OBJNAME) + # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -899,5 +922,7 @@ html-tk: $(TCLSH) .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk tclkit +.PHONY: tclkit-direct tclkit-dynamic tclkit-kitlib + # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/win/tclAppInit.c b/win/tclAppInit.c index a6c1a67..6f49afa 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -27,6 +27,11 @@ extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ +#ifdef TCL_ZIPVFS + MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); + MODULE_SCOPE int TclZvfsInit(Tcl_Interp *); +#endif /* TCL_ZIPVFS */ + #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES extern Tcl_PackageInitProc Registry_Init; extern Tcl_PackageInitProc Dde_Init; @@ -123,7 +128,13 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif - +#ifdef TCL_ZIPVFS + #define TCLKIT_INIT "main.tcl" + #define TCLKIT_VFSMOUNT "/zvfs" + Tcl_FindExecutable(argv[0]); + CONST char *cp=Tcl_GetNameOfExecutable(); + Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT); +#endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -154,7 +165,12 @@ Tcl_AppInit( if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } - +#ifdef TCL_ZIPVFS + /* Load the ZipVfs package */ + if (TclZvfsInit(interp) == TCL_ERROR) { + return TCL_ERROR; + } +#endif #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; -- cgit v0.12 From c003b95ed4a2c757d79b8161e72d50f32ea6e9d5 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 12 Sep 2014 16:13:00 +0000 Subject: Backing out code that inserted a debug statement into the http package --- library/http/http.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index afa9458..a6b2bfd 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -12,7 +12,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.8 -puts [list LOADED [info script]] + namespace eval http { # Allow resourcing to not clobber existing data -- cgit v0.12 From b25f4f5272e7987bb9a914c4dd414c095b1769ed Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 15 Sep 2014 09:44:39 +0000 Subject: The unix build has been pared down to the minimum hooks required to build a VFS enabled Tclsh with a simple compile flag. Modified the BC and Visual Studio makefiles for Windows, but these are untested. The default for Tcl is now to build a static or dynamic shell in the same way it would build a static or dynamic shell for Tclsh. Controlled by the --enable-shared flag. Note however that ZLib is compiled in to every VFS enabled shell. (Rather than rely on a dylib.) The "direct" build is maintained in the Makefile, mostly as a h(istor|yster)ical reference. The technique is not portable to Windows, and may not work outside of OSX. --- unix/Makefile.in | 40 +- unix/configure | 20975 +++++++++++++++++++++++++++++++++++++--------------- unix/configure.in | 36 +- unix/tcl.m4 | 10 - win/makefile.bc | 15 +- win/makefile.vc | 22 +- 6 files changed, 14876 insertions(+), 6222 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index c98f6ce..7523fca 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -168,7 +168,6 @@ INSTALL_DATA_DIR = ${INSTALL} -d -m 755 EXE_SUFFIX = @EXEEXT@ TCL_EXE = tclsh${EXE_SUFFIX} TCLKIT_EXE = tclkit${EXE_SUFFIX} -TCLKIT_LIB = tclkit${EXE_SUFFIX} TCLTEST_EXE = tcltest${EXE_SUFFIX} NATIVE_TCLSH = @TCLSH_PROG@ @@ -204,9 +203,6 @@ BUILD_DLTEST = @BUILD_DLTEST@ TCL_LIB_FILE = @TCL_LIB_FILE@ #TCL_LIB_FILE = libtcl.a -TCL_KIT_LIB_FILE = @TCL_KIT_LIB_FILE@ -#TCL_KIT_LIB_FILE = libtclkit.a - # Generic lib name used in rules that apply to tcl and tk LIB_FILE = ${TCL_LIB_FILE} @@ -469,7 +465,6 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclUtil.c \ $(GENERIC_DIR)/tclVar.c \ $(GENERIC_DIR)/tclAssembly.c \ - $(GENERIC_DIR)/tclZipVfs.obj \ $(GENERIC_DIR)/tclZlib.c OO_SRCS = \ @@ -615,9 +610,6 @@ ZLIB_SRCS = \ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ -PWD=`pwd` -VFS_INSTALL_DIR=${PWD}/tclkit.vfs/tcl8.6 - #-------------------------------------------------------------------------- # Start of rules #-------------------------------------------------------------------------- @@ -642,11 +634,6 @@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} fi rm -f $@ @MAKE_STUB_LIB@ - - -${TCL_KIT_LIB_FILE}: ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} - rm -f $@ - @MAKE_KIT_LIB@ # Make target which outputs the list of the .o contained in the Tcl lib useful # to build a single big shared library containing Tcl and other extensions. @@ -677,20 +664,8 @@ tclkit.vfs: @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ "$(UNIX_DIR)/tclkit.vfs/tcl$(VERSION)" "$(TOP_DIR)" unix -# Assemble all of the tcl sources into a single executable -${TCLKIT_EXE}: - -# Builds an executable directly from the Tcl sources -tclkit-direct: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs - ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} \ - ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} - cat null.zip >> ${TCLKIT_EXE} - cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . - # Builds an executable linked to the Tcl dynamic library -tclkit-dynamic: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tclkit.vfs +${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ ${TCLKIT_OBJS} \ @TCL_BUILD_LIB_SPEC@ \ @@ -699,11 +674,10 @@ tclkit-dynamic: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tcl cat null.zip >> ${TCLKIT_EXE} cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . -# Builds a tcl static library, as well as an executable linked to the Tcl static library -tclkit-kitlib: ${TCLKIT_OBJS} ${TCL_KIT_LIB_FILE} null.zip tclkit.vfs +# Builds an executable directly from the Tcl sources +tclkit-direct: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLKIT_OBJS} \ - @TCL_BUILD_KIT_LIB_SPEC@ \ + ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} cat null.zip >> ${TCLKIT_EXE} @@ -873,10 +847,6 @@ install-binaries: binaries echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi - @if test "$(TCL_KIT_LIB_FILE)" != "" ; then \ - echo "Installing $(TCL_KIT_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ - @INSTALL_KIT_LIB@ ; \ - fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig @@ -2196,7 +2166,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages -.PHONY: tclkit-direct tclkit-dynamic tclkit-kitlib +.PHONY: tclkit-direct #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/unix/configure b/unix/configure index a5f318e..a82c692 100755 --- a/unix/configure +++ b/unix/configure @@ -1,459 +1,81 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for tcl 8.6. -# -# -# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. -# +# Generated by GNU Autoconf 2.59 for tcl 8.6. # +# Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix fi +DUALCASE=1; export DUALCASE # for MKS sh -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false fi -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -# Use a proper internal environment variable to ensure we don't fall - # into an infinite loop, continuously re-executing ourselves. - if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then - _as_can_reexec=no; export _as_can_reexec; - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -as_fn_exit 255 - fi - # We don't want this to propagate to other subprocesses. - { _as_can_reexec=; unset _as_can_reexec;} -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : - -else - exitcode=1; echo positional parameters were not saved. -fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1" - if (eval "$as_required") 2>/dev/null; then : - as_have_required=yes -else - as_have_required=no -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : - -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir/$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : - CONFIG_SHELL=$as_shell as_have_required=yes - if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : - break 2 -fi -fi - done;; - esac - as_found=false -done -$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi; } -IFS=$as_save_IFS - - - if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 -fi - - if test x$as_have_required = xno; then : - $as_echo "$0: This script requires a shell more modern than all" - $as_echo "$0: the shells that I found on your system." - if test x${ZSH_VERSION+set} = xset ; then - $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" - $as_echo "$0: be upgraded to zsh 4.3.4 or later." + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var else - $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, -$0: including any error possibly output before this -$0: message. Then install a modern shell, or manually run -$0: the script under such a shell if you do have one." - fi - exit 1 -fi -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + $as_unset $as_var fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error +done -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi -as_me=`$as_basename -- "$0" || +# Name of the executable. +as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + +# PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -461,91 +83,146 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac - as_lineno_1=$LINENO as_lineno_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | sed ' - s/[$]LINENO.*/&-/ - t lineno - b - :lineno N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop - s/-\n.*// + s,-$,, + s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensitive to this). - . "./$as_me.lineno" + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno # Exit status is that of the last command. exit } -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null + as_expr=false fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' else - as_ln_s='cp -pR' + as_ln_s='ln -s' fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null +rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' + as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi -as_test_x='test -x' -as_executable_p=as_fn_executable_p +as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -554,25 +231,38 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" -test -n "$DJDIR" || exec 7<&0 &1 +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + # Name of the host. -# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` +exec 6>&1 + # # Initializations. # ac_default_prefix=/usr/local -ac_clean_files= ac_config_libobj_dir=. -LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='tcl' @@ -580,220 +270,50 @@ PACKAGE_TARNAME='tcl' PACKAGE_VERSION='8.6' PACKAGE_STRING='tcl 8.6' PACKAGE_BUGREPORT='' -PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ #include -#ifdef HAVE_SYS_TYPES_H +#if HAVE_SYS_TYPES_H # include #endif -#ifdef HAVE_SYS_STAT_H +#if HAVE_SYS_STAT_H # include #endif -#ifdef STDC_HEADERS +#if STDC_HEADERS # include # include #else -# ifdef HAVE_STDLIB_H +# if HAVE_STDLIB_H # include # endif #endif -#ifdef HAVE_STRING_H -# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +#if HAVE_STRING_H +# if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif -#ifdef HAVE_STRINGS_H +#if HAVE_STRINGS_H # include #endif -#ifdef HAVE_INTTYPES_H +#if HAVE_INTTYPES_H # include +#else +# if HAVE_STDINT_H +# include +# endif #endif -#ifdef HAVE_STDINT_H -# include -#endif -#ifdef HAVE_UNISTD_H +#if HAVE_UNISTD_H # include #endif" -ac_subst_vars='DLTEST_SUFFIX -DLTEST_LD -EXTRA_TCLSH_LIBS -EXTRA_BUILD_HTML -EXTRA_INSTALL_BINARIES -EXTRA_INSTALL -EXTRA_APP_CC_SWITCHES -EXTRA_CC_SWITCHES -PACKAGE_DIR -HTML_DIR -PRIVATE_INCLUDE_DIR -TCL_LIBRARY -TCL_MODULE_PATH -TCL_PACKAGE_PATH -BUILD_DLTEST -MAKEFILE_SHELL -DTRACE_OBJ -DTRACE_HDR -DTRACE_SRC -INSTALL_TZDATA -TCL_HAS_LONGLONG -TCL_UNSHARED_LIB_SUFFIX -TCL_SHARED_LIB_SUFFIX -TCL_LIB_VERSIONS_OK -LD_LIBRARY_PATH_VAR -TCL_SHARED_BUILD -CFG_TCL_UNSHARED_LIB_SUFFIX -CFG_TCL_SHARED_LIB_SUFFIX -TCL_SRC_DIR -TCL_INCLUDE_SPEC -TCL_BUILD_KIT_LIB_PATH -TCL_BUILD_KIT_LIB_SPEC -TCL_KIT_LIB_PATH -TCL_KIT_LIB_SPEC -TCL_KIT_LIB_FLAG -TCL_KIT_LIB_FILE -TCL_BUILD_STUB_LIB_PATH -TCL_BUILD_STUB_LIB_SPEC -TCL_STUB_LIB_PATH -TCL_STUB_LIB_SPEC -TCL_STUB_LIB_FLAG -TCL_STUB_LIB_FILE -TCL_BUILD_LIB_SPEC -TCL_LIB_SPEC -TCL_LIB_FLAG -TCL_LIB_FILE -PKG_CFG_ARGS -TCL_YEAR -TCL_PATCH_LEVEL -TCL_MINOR_VERSION -TCL_MAJOR_VERSION -TCL_VERSION -DTRACE -LDFLAGS_DEFAULT -CFLAGS_DEFAULT -INSTALL_KIT_LIB -INSTALL_STUB_LIB -DLL_INSTALL_DIR -INSTALL_LIB -MAKE_STUB_LIB -MAKE_KIT_LIB -MAKE_LIB -SHLIB_SUFFIX -SHLIB_CFLAGS -SHLIB_LD_LIBS -TK_SHLIB_LD_EXTRAS -TCL_SHLIB_LD_EXTRAS -SHLIB_LD -STLIB_LD -LD_SEARCH_FLAGS -CC_SEARCH_FLAGS -LDFLAGS_OPTIMIZE -LDFLAGS_DEBUG -CFLAGS_WARNING -CFLAGS_OPTIMIZE -CFLAGS_DEBUG -LDAIX_SRC -PLAT_SRCS -PLAT_OBJS -DL_OBJS -DL_LIBS -TCL_LIBS -LIBOBJS -AR -RANLIB -ZLIB_INCLUDE -ZLIB_SRCS -ZLIB_OBJS -TCLSH_PROG -TCL_THREADS -EGREP -GREP -CPP -OBJEXT -EXEEXT -ac_ct_CC -CPPFLAGS -LDFLAGS -CFLAGS -CC -MAN_FLAGS -target_alias -host_alias -build_alias -LIBS -ECHO_T -ECHO_N -ECHO_C -DEFS -mandir -localedir -libdir -psdir -pdfdir -dvidir -htmldir -infodir -docdir -oldincludedir -includedir -localstatedir -sharedstatedir -sysconfdir -datadir -datarootdir -libexecdir -sbindir -bindir -program_transform_name -prefix -exec_prefix -PACKAGE_URL -PACKAGE_BUGREPORT -PACKAGE_STRING -PACKAGE_VERSION -PACKAGE_TARNAME -PACKAGE_NAME -PATH_SEPARATOR -SHELL' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' ac_subst_files='' -ac_user_opts=' -enable_option_checking -enable_man_symlinks -enable_man_compression -enable_man_suffix -enable_threads -with_encoding -enable_shared -enable_64bit -enable_64bit_vis -enable_rpath -enable_corefoundation -enable_load -enable_symbols -enable_langinfo -enable_dll_unloading -with_tzdata -enable_dtrace -enable_framework -' - ac_precious_vars='build_alias -host_alias -target_alias -CC -CFLAGS -LDFLAGS -LIBS -CPPFLAGS -CPP' - # Initialize some variables set by options. ac_init_help= ac_init_version=false -ac_unrecognized_opts= -ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null @@ -816,49 +336,34 @@ x_libraries=NONE # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. -# (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' -datarootdir='${prefix}/share' -datadir='${datarootdir}' +datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' -docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' -infodir='${datarootdir}/info' -htmldir='${docdir}' -dvidir='${docdir}' -pdfdir='${docdir}' -psdir='${docdir}' -libdir='${exec_prefix}/lib' -localedir='${datarootdir}/locale' -mandir='${datarootdir}/man' +infodir='${prefix}/info' +mandir='${prefix}/man' ac_prev= -ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then - eval $ac_prev=\$ac_option + eval "$ac_prev=\$ac_option" ac_prev= continue fi - case $ac_option in - *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *=) ac_optarg= ;; - *) ac_optarg=yes ;; - esac + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. - case $ac_dashdash$ac_option in - --) - ac_dashdash=yes ;; + case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; @@ -880,59 +385,33 @@ do --config-cache | -C) cache_file=config.cache ;; - -datadir | --datadir | --datadi | --datad) + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=*) + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) datadir=$ac_optarg ;; - -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ - | --dataroo | --dataro | --datar) - ac_prev=datarootdir ;; - -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ - | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) - datarootdir=$ac_optarg ;; - -disable-* | --disable-*) - ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=no ;; - - -docdir | --docdir | --docdi | --doc | --do) - ac_prev=docdir ;; - -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) - docdir=$ac_optarg ;; - - -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) - ac_prev=dvidir ;; - -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) - dvidir=$ac_optarg ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) - ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; esac - eval enable_$ac_useropt=\$ac_optarg ;; + eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -959,12 +438,6 @@ do -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; - -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) - ac_prev=htmldir ;; - -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ - | --ht=*) - htmldir=$ac_optarg ;; - -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; @@ -989,16 +462,13 @@ do | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; - -localedir | --localedir | --localedi | --localed | --locale) - ac_prev=localedir ;; - -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) - localedir=$ac_optarg ;; - -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst | --locals) + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) @@ -1063,16 +533,6 @@ do | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; - -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) - ac_prev=pdfdir ;; - -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) - pdfdir=$ac_optarg ;; - - -psdir | --psdir | --psdi | --psd | --ps) - ac_prev=psdir ;; - -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) - psdir=$ac_optarg ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; @@ -1123,36 +583,26 @@ do ac_init_version=: ;; -with-* | --with-*) - ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" - ac_unrecognized_sep=', ';; + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package| sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; esac - eval with_$ac_useropt=\$ac_optarg ;; + eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) - ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=no ;; + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. @@ -1172,26 +622,27 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error $? "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information" + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. - case $ac_envvar in #( - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; - esac - eval $ac_envvar=\$ac_optarg + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. - $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac @@ -1199,36 +650,31 @@ done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error $? "missing argument to $ac_option" -fi - -if test -n "$ac_unrecognized_opts"; then - case $enable_option_checking in - no) ;; - fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; - *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; - esac + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } fi -# Check all directory arguments for consistency. -for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ - datadir sysconfdir sharedstatedir localstatedir includedir \ - oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix do - eval ac_val=\$$ac_var - # Remove trailing slashes. + eval ac_val=$`echo $ac_var` case $ac_val in - */ ) - ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` - eval $ac_var=\$ac_val;; + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac - # Be sure to have absolute directory names. +done + +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir +do + eval ac_val=$`echo $ac_var` case $ac_val in - [\\/$]* | ?:[\\/]* ) continue;; - NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac - as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' @@ -1242,6 +688,8 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -1253,72 +701,74 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null -ac_pwd=`pwd` && test -n "$ac_pwd" && -ac_ls_di=`ls -di .` && -ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error $? "working directory cannot be determined" -test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error $? "pwd does not report name of working directory" - - # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes - # Try the directory containing this script, then the parent directory. - ac_confdir=`$as_dirname -- "$as_myself" || -$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_myself" : 'X\(//\)[^/]' \| \ - X"$as_myself" : 'X\(//\)$' \| \ - X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_myself" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` + # Try the directory containing this script, then its parent. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` srcdir=$ac_confdir - if test ! -r "$srcdir/$ac_unique_file"; then + if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi -if test ! -r "$srcdir/$ac_unique_file"; then - test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" -fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" -ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" - pwd)` -# When building in place, set srcdir=. -if test "$ac_abs_confdir" = "$ac_pwd"; then - srcdir=. -fi -# Remove unnecessary trailing slashes from srcdir. -# Double slashes in file names in object file debugging info -# mess up M-x gdb in Emacs. -case $srcdir in -*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; -esac -for ac_var in $ac_precious_vars; do - eval ac_env_${ac_var}_set=\${${ac_var}+set} - eval ac_env_${ac_var}_value=\$${ac_var} - eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} - eval ac_cv_env_${ac_var}_value=\$${ac_var} -done +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } + else + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } + fi +fi +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias +ac_env_CC_set=${CC+set} +ac_env_CC_value=$CC +ac_cv_env_CC_set=${CC+set} +ac_cv_env_CC_value=$CC +ac_env_CFLAGS_set=${CFLAGS+set} +ac_env_CFLAGS_value=$CFLAGS +ac_cv_env_CFLAGS_set=${CFLAGS+set} +ac_cv_env_CFLAGS_value=$CFLAGS +ac_env_LDFLAGS_set=${LDFLAGS+set} +ac_env_LDFLAGS_value=$LDFLAGS +ac_cv_env_LDFLAGS_set=${LDFLAGS+set} +ac_cv_env_LDFLAGS_value=$LDFLAGS +ac_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_env_CPPFLAGS_value=$CPPFLAGS +ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_cv_env_CPPFLAGS_value=$CPPFLAGS +ac_env_CPP_set=${CPP+set} +ac_env_CPP_value=$CPP +ac_cv_env_CPP_set=${CPP+set} +ac_cv_env_CPP_value=$CPP # # Report the --help message. @@ -1341,17 +791,20 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking ...' messages + -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] +_ACEOF + + cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] + [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] + [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify @@ -1361,25 +814,18 @@ for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] - --datadir=DIR read-only architecture-independent data [DATAROOTDIR] - --infodir=DIR info documentation [DATAROOTDIR/info] - --localedir=DIR locale-dependent data [DATAROOTDIR/locale] - --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/tcl] - --htmldir=DIR html documentation [DOCDIR] - --dvidir=DIR dvi documentation [DOCDIR] - --pdfdir=DIR pdf documentation [DOCDIR] - --psdir=DIR ps documentation [DOCDIR] + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF @@ -1393,7 +839,6 @@ if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Features: - --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-man-symlinks use symlinks for the manpages (default: off) @@ -1431,593 +876,160 @@ Some influential environment variables: CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory - LIBS libraries to pass to the linker, e.g. -l - CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if - you have headers in a nonstandard directory + CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have + headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. -Report bugs to the package provider. _ACEOF -ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. + ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d "$ac_dir" || - { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || - continue + test -d $ac_dir || continue ac_builddir=. -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi case $srcdir in - .) # We are building in place. + .) # No --srcdir option. We are building in place. ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - cd "$ac_dir" || { ac_status=$?; continue; } - # Check for guested configure. - if test -f "$ac_srcdir/configure.gnu"; then - echo && - $SHELL "$ac_srcdir/configure.gnu" --help=recursive - elif test -f "$ac_srcdir/configure"; then - echo && - $SHELL "$ac_srcdir/configure" --help=recursive +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + cd $ac_dir + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help else - $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi || ac_status=$? - cd "$ac_pwd" || { ac_status=$?; break; } + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir done fi -test -n "$ac_init_help" && exit $ac_status +test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF tcl configure 8.6 -generated by GNU Autoconf 2.69 +generated by GNU Autoconf 2.59 -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF - exit + exit 0 fi +exec 5>config.log +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by tcl $as_me 8.6, which was +generated by GNU Autoconf 2.59. Invocation command line was -## ------------------------ ## -## Autoconf initialization. ## -## ------------------------ ## + $ $0 $@ -# ac_fn_c_try_compile LINENO -# -------------------------- -# Try to compile conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_compile () +_ACEOF { - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext - if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest.$ac_objext; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## - ac_retval=1 -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` -} # ac_fn_c_try_compile +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` -# ac_fn_c_try_link LINENO -# ----------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_link () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext conftest$ac_exeext - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && { - test "$cross_compiling" = yes || - test -x conftest$ac_exeext - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information - # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would - # interfere with the next link command; also delete a directory that is - # left behind by Apple's compiler. We do this before executing the actions. - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_link - -# ac_fn_c_try_cpp LINENO -# ---------------------- -# Try to preprocess conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_cpp () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_cpp conftest.$ac_ext" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } > conftest.i && { - test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || - test ! -s conftest.err - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - ac_retval=1 -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval +_ASUNAME -} # ac_fn_c_try_cpp - -# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists, giving a warning if it cannot be compiled using -# the include files in INCLUDES and setting the cache variable VAR -# accordingly. -ac_fn_c_check_header_mongrel () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if eval \${$3+:} false; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -else - # Is the header compilable? -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 -$as_echo_n "checking $2 usability... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_header_compiler=yes -else - ac_header_compiler=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 -$as_echo "$ac_header_compiler" >&6; } - -# Is the header present? -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 -$as_echo_n "checking $2 presence... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <$2> -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - ac_header_preproc=yes -else - ac_header_preproc=no -fi -rm -f conftest.err conftest.i conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 -$as_echo "$ac_header_preproc" >&6; } - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( - yes:no: ) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 -$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 -$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} - ;; - no:yes:* ) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 -$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 -$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 -$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 -$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 -$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} - ;; -esac - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=\$ac_header_compiler" -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_mongrel - -# ac_fn_c_try_run LINENO -# ---------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes -# that executables *can* be run. -ac_fn_c_try_run () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then : - ac_retval=0 -else - $as_echo "$as_me: program exited with status $ac_status" >&5 - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=$ac_status -fi - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_run - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_compile - -# ac_fn_c_check_func LINENO FUNC VAR -# ---------------------------------- -# Tests whether FUNC exists, setting the cache variable VAR accordingly -ac_fn_c_check_func () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Define $2 to an innocuous variant, in case declares $2. - For example, HP-UX 11i declares gettimeofday. */ -#define $2 innocuous_$2 - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $2 (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $2 - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char $2 (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined __stub_$2 || defined __stub___$2 -choke me -#endif - -int -main () -{ -return $2 (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_func - -# ac_fn_c_check_type LINENO TYPE VAR INCLUDES -# ------------------------------------------- -# Tests whether TYPE exists after having included INCLUDES, setting cache -# variable VAR accordingly. -ac_fn_c_check_type () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=no" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof ($2)) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof (($2))) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - eval "$3=yes" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_type - -# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES -# ---------------------------------------------------- -# Tries to find if the field MEMBER exists in type AGGR, after including -# INCLUDES, setting cache variable VAR accordingly. -ac_fn_c_check_member () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 -$as_echo_n "checking for $2.$3... " >&6; } -if eval \${$4+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$5 -int -main () -{ -static $2 ac_aggr; -if (ac_aggr.$3) -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$4=yes" -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$5 -int -main () -{ -static $2 ac_aggr; -if (sizeof ac_aggr.$3) -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$4=yes" -else - eval "$4=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$4 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_member -cat >config.log <<_ACEOF -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by tcl $as_me 8.6, which was -generated by GNU Autoconf 2.69. Invocation command line was - - $ $0 $@ - -_ACEOF -exec 5>>config.log -{ -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## - -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` - -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - -_ASUNAME - -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - $as_echo "PATH: $as_dir" - done -IFS=$as_save_IFS +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done } >&5 @@ -2039,6 +1051,7 @@ _ACEOF ac_configure_args= ac_configure_args0= ac_configure_args1= +ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do @@ -2049,13 +1062,13 @@ do -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; - *\'*) - ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in - 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) - as_fn_append ac_configure_args1 " '$ac_arg'" + ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else @@ -2071,115 +1084,104 @@ do -* ) ac_must_keep_next=true ;; esac fi - as_fn_append ac_configure_args " '$ac_arg'" + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " ;; esac done done -{ ac_configure_args0=; unset ac_configure_args0;} -{ ac_configure_args1=; unset ac_configure_args1;} +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. -# WARNING: Use '\'' to represent an apostrophe within the trap. -# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo - $as_echo "## ---------------- ## + cat <<\_ASBOX +## ---------------- ## ## Cache variables. ## -## ---------------- ##" +## ---------------- ## +_ASBOX echo # The following way of writing the cache mishandles newlines in values, -( - for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done +{ (set) 2>&1 | - case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( - *${as_nl}ac_space=\ *) + case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in + *ac_space=\ *) sed -n \ - "s/'\''/'\''\\\\'\'''\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" - ;; #( + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; *) - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; - esac | - sort -) + esac; +} echo - $as_echo "## ----------------- ## + cat <<\_ASBOX +## ----------------- ## ## Output variables. ## -## ----------------- ##" +## ----------------- ## +_ASBOX echo for ac_var in $ac_subst_vars do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then - $as_echo "## ------------------- ## -## File substitutions. ## -## ------------------- ##" + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX echo for ac_var in $ac_subst_files do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then - $as_echo "## ----------- ## + cat <<\_ASBOX +## ----------- ## ## confdefs.h. ## -## ----------- ##" +## ----------- ## +_ASBOX echo - cat confdefs.h + sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && - $as_echo "$as_me: caught signal $ac_signal" - $as_echo "$as_me: exit $exit_status" + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" } >&5 - rm -f core *.core core.conftest.* && - rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status -' 0 + ' 0 for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -f -r conftest* confdefs.h - -$as_echo "/* confdefs.h */" > confdefs.h +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h # Predefined preprocessor variables. @@ -2187,137 +1189,112 @@ cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF + cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF + cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF + cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF -cat >>confdefs.h <<_ACEOF -#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" -_ACEOF cat >>confdefs.h <<_ACEOF -#define PACKAGE_URL "$PACKAGE_URL" +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. -# Prefer an explicitly selected file to automatically selected ones. -ac_site_file1=NONE -ac_site_file2=NONE -if test -n "$CONFIG_SITE"; then - # We do not want a PATH search for config.site. - case $CONFIG_SITE in #(( - -*) ac_site_file1=./$CONFIG_SITE;; - */*) ac_site_file1=$CONFIG_SITE;; - *) ac_site_file1=./$CONFIG_SITE;; - esac -elif test "x$prefix" != xNONE; then - ac_site_file1=$prefix/share/config.site - ac_site_file2=$prefix/etc/config.site -else - ac_site_file1=$ac_default_prefix/share/config.site - ac_site_file2=$ac_default_prefix/etc/config.site +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi fi -for ac_site_file in "$ac_site_file1" "$ac_site_file2" -do - test "x$ac_site_file" = xNONE && continue - if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 -$as_echo "$as_me: loading site script $ac_site_file" >&6;} +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" \ - || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } + . "$ac_site_file" fi done if test -r "$cache_file"; then - # Some versions of bash will fail to source /dev/null (special files - # actually), so we avoid doing that. DJGPP emulates it as a regular file. - if test /dev/null != "$cache_file" && test -f "$cache_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 -$as_echo "$as_me: loading cache $cache_file" >&6;} + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in - [\\/]* | ?:[\\/]* ) . "$cache_file";; - *) . "./$cache_file";; + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; esac fi else - { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 -$as_echo "$as_me: creating cache $cache_file" >&6;} + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false -for ac_var in $ac_precious_vars; do +for ac_var in `(set) 2>&1 | + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set - eval ac_old_val=\$ac_cv_env_${ac_var}_value - eval ac_new_val=\$ac_env_${ac_var}_value + eval ac_old_val="\$ac_cv_env_${ac_var}_value" + eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then - # differences in whitespace do not lead to failure. - ac_old_val_w=`echo x $ac_old_val` - ac_new_val_w=`echo x $ac_new_val` - if test "$ac_old_val_w" != "$ac_new_val_w"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - ac_cache_corrupted=: - else - { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} - eval $ac_var=\$ac_old_val - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 +echo "$as_me: former value: $ac_old_val" >&2;} + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 +echo "$as_me: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in - *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. - *) as_fn_append ac_configure_args " '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 -$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } fi -## -------------------- ## -## Main body of script. ## -## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' @@ -2330,6 +1307,31 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + + + + + + + + + + + + TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 @@ -2380,60 +1382,62 @@ TCL_SRC_DIR="`cd "$srcdir"/..; pwd`" #------------------------------------------------------------------------ - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use symlinks for manpages" >&5 -$as_echo_n "checking whether to use symlinks for manpages... " >&6; } - # Check whether --enable-man-symlinks was given. -if test "${enable_man_symlinks+set}" = set; then : - enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" + echo "$as_me:$LINENO: checking whether to use symlinks for manpages" >&5 +echo $ECHO_N "checking whether to use symlinks for manpages... $ECHO_C" >&6 + # Check whether --enable-man-symlinks or --disable-man-symlinks was given. +if test "${enable_man_symlinks+set}" = set; then + enableval="$enable_man_symlinks" + test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" else enableval="no" -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 -$as_echo "$enableval" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to compress the manpages" >&5 -$as_echo_n "checking whether to compress the manpages... " >&6; } - # Check whether --enable-man-compression was given. -if test "${enable_man_compression+set}" = set; then : - enableval=$enable_man_compression; case $enableval in - yes) as_fn_error $? "missing argument to --enable-man-compression" "$LINENO" 5;; +fi; + echo "$as_me:$LINENO: result: $enableval" >&5 +echo "${ECHO_T}$enableval" >&6 + + echo "$as_me:$LINENO: checking whether to compress the manpages" >&5 +echo $ECHO_N "checking whether to compress the manpages... $ECHO_C" >&6 + # Check whether --enable-man-compression or --disable-man-compression was given. +if test "${enable_man_compression+set}" = set; then + enableval="$enable_man_compression" + case $enableval in + yes) { { echo "$as_me:$LINENO: error: missing argument to --enable-man-compression" >&5 +echo "$as_me: error: missing argument to --enable-man-compression" >&2;} + { (exit 1); exit 1; }; };; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac else enableval="no" -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 -$as_echo "$enableval" >&6; } +fi; + echo "$as_me:$LINENO: result: $enableval" >&5 +echo "${ECHO_T}$enableval" >&6 if test "$enableval" != "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for compressed file suffix" >&5 -$as_echo_n "checking for compressed file suffix... " >&6; } + echo "$as_me:$LINENO: checking for compressed file suffix" >&5 +echo $ECHO_N "checking for compressed file suffix... $ECHO_C" >&6 touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $Z" >&5 -$as_echo "$Z" >&6; } + echo "$as_me:$LINENO: result: $Z" >&5 +echo "${ECHO_T}$Z" >&6 fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to add a package name suffix for the manpages" >&5 -$as_echo_n "checking whether to add a package name suffix for the manpages... " >&6; } - # Check whether --enable-man-suffix was given. -if test "${enable_man_suffix+set}" = set; then : - enableval=$enable_man_suffix; case $enableval in + echo "$as_me:$LINENO: checking whether to add a package name suffix for the manpages" >&5 +echo $ECHO_N "checking whether to add a package name suffix for the manpages... $ECHO_C" >&6 + # Check whether --enable-man-suffix or --disable-man-suffix was given. +if test "${enable_man_suffix+set}" = set; then + enableval="$enable_man_suffix" + case $enableval in yes) enableval="tcl" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac else enableval="no" -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 -$as_echo "$enableval" >&6; } +fi; + echo "$as_me:$LINENO: result: $enableval" >&5 +echo "${ECHO_T}$enableval" >&6 @@ -2456,10 +1460,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2469,37 +1473,35 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -2509,50 +1511,39 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi + CC=$ac_ct_CC else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2562,40 +1553,80 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - - fi fi -if test -z "$CC"; then +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2603,19 +1634,18 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. @@ -2633,25 +1663,24 @@ fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then - for ac_prog in cl.exe + for ac_prog in cl do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2661,41 +1690,39 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC - for ac_prog in cl.exe + for ac_prog in cl do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. @@ -2705,78 +1732,66 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - test -n "$ac_ct_CC" && break done - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi + CC=$ac_ct_CC fi fi -test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } +test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&5 +echo "$as_me: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } # Provide some information about the compiler. -$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 -set X $ac_compile -ac_compiler=$2 -for ac_option in --version -v -V -qversion; do - { { ac_try="$ac_compiler $ac_option >&5" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compiler $ac_option >&5") 2>conftest.err +echo "$as_me:$LINENO:" \ + "checking for C compiler version" >&5 +ac_compiler=`set X $ac_compile; echo $2` +{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 + (eval $ac_compiler --version &5) 2>&5 ac_status=$? - if test -s conftest.err; then - sed '10a\ -... rest of stderr output deleted ... - 10q' conftest.err >conftest.er1 - cat conftest.er1 >&5 - fi - rm -f conftest.er1 conftest.err - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -done + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 + (eval $ac_compiler -v &5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 + (eval $ac_compiler -V &5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -2788,108 +1803,112 @@ main () } _ACEOF ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 -$as_echo_n "checking whether the C compiler works... " >&6; } -ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` - -# The possible output files: -ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" - -ac_rmfiles= -for ac_file in $ac_files -do - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - * ) ac_rmfiles="$ac_rmfiles $ac_file";; - esac -done -rm -f $ac_rmfiles - -if { { ac_try="$ac_link_default" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link_default") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' -# in a Makefile. We should not override ac_cv_exeext if it was cached, -# so that the user can short-circuit this test for compilers unknown to -# Autoconf. -for ac_file in $ac_files '' +echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 +echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 +ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` +if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 + (eval $ac_link_default) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Find the output, starting from the most likely. This scheme is +# not robust to junk in `.', hence go to wildcards (a.*) only as a last +# resort. + +# Be careful to initialize this variable, since it used to be cached. +# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. +ac_cv_exeext= +# b.out is created by i960 compilers. +for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) + ;; + conftest.$ac_ext ) + # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) - if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; - then :; else - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - fi - # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' - # argument, so we may need to know it at that point already. - # Even if this section looks crufty: it has the advantage of - # actually working. + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + # FIXME: I believe we export ac_cv_exeext for Libtool, + # but it would be cool to find out if it's true. Does anybody + # maintain Libtool? --akim. + export ac_cv_exeext break;; * ) break;; esac done -test "$ac_cv_exeext" = no && ac_cv_exeext= - else - ac_file='' -fi -if test -z "$ac_file"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -$as_echo "$as_me: failed program was:" >&5 + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } +{ { echo "$as_me:$LINENO: error: C compiler cannot create executables +See \`config.log' for more details." >&5 +echo "$as_me: error: C compiler cannot create executables +See \`config.log' for more details." >&2;} + { (exit 77); exit 77; }; } fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 -$as_echo_n "checking for C compiler default output file name... " >&6; } -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 -$as_echo "$ac_file" >&6; } + ac_exeext=$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_file" >&5 +echo "${ECHO_T}$ac_file" >&6 + +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether the C compiler works" >&5 +echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 +# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 +# If not cross compiling, check that we can run a simple program. +if test "$cross_compiling" != yes; then + if { ac_try='./$ac_file' + { (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 + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { echo "$as_me:$LINENO: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi + fi +fi +echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 -rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 -$as_echo_n "checking for suffix of executables... " >&6; } -if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 +echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 +echo "$as_me:$LINENO: result: $cross_compiling" >&5 +echo "${ECHO_T}$cross_compiling" >&6 + +echo "$as_me:$LINENO: checking for suffix of executables" >&5 +echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with @@ -2897,90 +1916,38 @@ $as_echo "$ac_try_echo"; } >&5 for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + export ac_cv_exeext break;; * ) break;; esac done else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } + { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } fi -rm -f conftest conftest$ac_cv_exeext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 -$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 +echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -FILE *f = fopen ("conftest.out", "w"); - return ferror (f) || fclose (f) != 0; - - ; - return 0; -} -_ACEOF -ac_clean_files="$ac_clean_files conftest.out" -# Check that the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 -$as_echo_n "checking whether we are cross compiling... " >&6; } -if test "$cross_compiling" != yes; then - { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if { ac_try='./conftest$ac_cv_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } - fi - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 -$as_echo "$cross_compiling" >&6; } - -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 -$as_echo_n "checking for suffix of object files... " >&6; } -if ${ac_cv_objext+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for suffix of object files" >&5 +echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 +if test "${ac_cv_objext+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -2992,46 +1959,45 @@ main () } _ACEOF rm -f conftest.o conftest.obj -if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - for ac_file in conftest.o conftest.obj conftest.*; do - test -f "$ac_file" || continue; +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else - $as_echo "$as_me: failed program was:" >&5 + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } +{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } fi + rm -f conftest.$ac_cv_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 -$as_echo "$ac_cv_objext" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 -$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if ${ac_cv_c_compiler_gnu+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 +echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 +if test "${ac_cv_c_compiler_gnu+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -3045,49 +2011,55 @@ main () return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 ac_compiler_gnu=yes else - ac_compiler_gnu=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_compiler_gnu=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 -$as_echo "$ac_cv_c_compiler_gnu" >&6; } -if test $ac_compiler_gnu = yes; then - GCC=yes -else - GCC= -fi +echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 +echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 +GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 -$as_echo_n "checking whether $CC accepts -g... " >&6; } -if ${ac_cv_prog_cc_g+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_save_c_werror_flag=$ac_c_werror_flag - ac_c_werror_flag=yes - ac_cv_prog_cc_g=no - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} +CFLAGS="-g" +echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 +echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_g+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -else - CFLAGS="" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -3098,34 +2070,39 @@ main () return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_prog_cc_g=yes else - ac_c_werror_flag=$ac_save_c_werror_flag - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes +ac_cv_prog_cc_g=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 -$as_echo "$ac_cv_prog_cc_g" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then @@ -3141,18 +2118,23 @@ else CFLAGS= fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 -$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if ${ac_cv_prog_cc_c89+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 +echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - ac_cv_prog_cc_c89=no + ac_cv_prog_cc_stdc=no ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include -struct stat; +#include +#include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); @@ -3175,17 +2157,12 @@ static char *f (char * (*g) (char **, int), char **p, ...) /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std is added to get + as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std. */ + that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) 'x' -int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; - int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; @@ -3200,37 +2177,205 @@ return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; return 0; } _ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +# Don't try gcc -ansi; that turns off useful extensions and +# breaks some systems' header files. +# AIX -qlanglvl=ansi +# Ultrix and OSF/1 -std1 +# HP-UX 10.20 and later -Ae +# HP-UX older versions -Aa -D_HPUX_SOURCE +# SVR4 -Xc -D__EXTENSIONS__ +for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c89=$ac_arg + rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_prog_cc_stdc=$ac_arg +break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c89" != "xno" && break +rm -f conftest.err conftest.$ac_objext done -rm -f conftest.$ac_ext +rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c89" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; + +case "x$ac_cv_prog_cc_stdc" in + x|xno) + echo "$as_me:$LINENO: result: none needed" >&5 +echo "${ECHO_T}none needed" >&6 ;; *) - CC="$CC $ac_cv_prog_cc_c89" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; + echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 + CC="$CC $ac_cv_prog_cc_stdc" ;; esac -if test "x$ac_cv_prog_cc_c89" != xno; then : +# Some people use a C++ compiler to compile C. Since we use `exit', +# in C++ we need to declare it. In case someone uses the same compiler +# for both compiling C and C++ we need to have the C++ compiler decide +# the declaration of exit, since it's the most demanding environment. +cat >conftest.$ac_ext <<_ACEOF +#ifndef __cplusplus + choke me +#endif +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + for ac_declaration in \ + '' \ + 'extern "C" void std::exit (int) throw (); using std::exit;' \ + 'extern "C" void std::exit (int); using std::exit;' \ + 'extern "C" void exit (int) throw ();' \ + 'extern "C" void exit (int);' \ + 'void exit (int);' +do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +#include +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +continue +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done +rm -f conftest* +if test -n "$ac_declaration"; then + echo '#ifdef __cplusplus' >>confdefs.h + echo $ac_declaration >>confdefs.h + echo '#endif' >>confdefs.h fi +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -3238,14 +2383,18 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 -$as_echo_n "checking for inline... " >&6; } -if ${ac_cv_c_inline+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for inline" >&5 +echo $ECHO_N "checking for inline... $ECHO_C" >&6 +if test "${ac_cv_c_inline+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifndef __cplusplus typedef int foo_t; @@ -3254,16 +2403,41 @@ $ac_kw foo_t foo () {return 0; } #endif _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_inline=$ac_kw +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_c_inline=$ac_kw; break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$ac_cv_c_inline" != no && break +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 -$as_echo "$ac_cv_c_inline" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&6 + case $ac_cv_c_inline in inline | yes) ;; @@ -3295,15 +2469,15 @@ ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 -$as_echo_n "checking how to run the C preprocessor... " >&6; } +echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 +echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if ${ac_cv_prog_CPP+:} false; then : - $as_echo_n "(cached) " >&6 + if test "${ac_cv_prog_CPP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" @@ -3317,7 +2491,11 @@ do # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include @@ -3326,34 +2504,78 @@ do #endif Syntax error _ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + : else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.i conftest.$ac_ext +rm -f conftest.err conftest.$ac_ext - # OK, works on sane cases. Now check whether nonexistent headers + # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + # Passes both tests. ac_preproc_ok=: break fi -rm -f conftest.err conftest.i conftest.$ac_ext +rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then break fi @@ -3365,8 +2587,8 @@ fi else ac_cv_prog_CPP=$CPP fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 -$as_echo "$CPP" >&6; } +echo "$as_me:$LINENO: result: $CPP" >&5 +echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do @@ -3376,7 +2598,11 @@ do # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include @@ -3385,40 +2611,85 @@ do #endif Syntax error _ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + : else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.i conftest.$ac_ext +rm -f conftest.err conftest.$ac_ext - # OK, works on sane cases. Now check whether nonexistent headers + # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + # Broken: success on invalid input. +continue +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + # Passes both tests. ac_preproc_ok=: break fi -rm -f conftest.err conftest.i conftest.$ac_ext +rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + : else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } + { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&5 +echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } fi ac_ext=c @@ -3428,142 +2699,31 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -$as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if ${ac_cv_path_GREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$GREP"; then - ac_path_GREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in grep ggrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in -*GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_GREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_GREP=$GREP -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -$as_echo "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -$as_echo_n "checking for egrep... " >&6; } -if ${ac_cv_path_EGREP+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for egrep" >&5 +echo $ECHO_N "checking for egrep... $ECHO_C" >&6 +if test "${ac_cv_prog_egrep+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in egrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in -*GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count + if echo a | (grep -E '(a|b)') >/dev/null 2>&1 + then ac_cv_prog_egrep='grep -E' + else ac_cv_prog_egrep='egrep' fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then - as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_EGREP=$EGREP fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -$as_echo "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" +echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 +echo "${ECHO_T}$ac_cv_prog_egrep" >&6 + EGREP=$ac_cv_prog_egrep -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 -$as_echo_n "checking for ANSI C header files... " >&6; } -if ${ac_cv_header_stdc+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for ANSI C header files" >&5 +echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 +if test "${ac_cv_header_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include @@ -3578,23 +2738,51 @@ main () return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 ac_cv_header_stdc=yes else - ac_cv_header_stdc=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_stdc=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then : - + $EGREP "memchr" >/dev/null 2>&1; then + : else ac_cv_header_stdc=no fi @@ -3604,14 +2792,18 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then : - + $EGREP "free" >/dev/null 2>&1; then + : else ac_cv_header_stdc=no fi @@ -3621,13 +2813,16 @@ fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then : + if test "$cross_compiling" = yes; then : else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include -#include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) @@ -3647,39 +2842,109 @@ main () for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) - return 2; - return 0; + exit(2); + exit (0); } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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 + : else - ac_cv_header_stdc=no + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +ac_cv_header_stdc=no fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi - fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 -$as_echo "$ac_cv_header_stdc" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 +echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then -$as_echo "#define STDC_HEADERS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define STDC_HEADERS 1 +_ACEOF fi # On IRIX 5.3, sys/types and inttypes.h are conflicting. + + + + + + + + + for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default -" -if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+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. */ +$ac_includes_default + +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + eval "$as_ac_Header=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_Header=no" +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -3688,13 +2953,17 @@ done - { $as_echo "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5 -$as_echo_n "checking dirent.h... " >&6; } -if ${tcl_cv_dirent_h+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking dirent.h" >&5 +echo $ECHO_N "checking dirent.h... $ECHO_C" >&6 +if test "${tcl_cv_dirent_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include @@ -3724,352 +2993,1596 @@ closedir(d); return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_dirent_h=yes else - tcl_cv_dirent_h=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_dirent_h=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5 -$as_echo "$tcl_cv_dirent_h" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_dirent_h" >&5 +echo "${ECHO_T}$tcl_cv_dirent_h" >&6 if test $tcl_cv_dirent_h = no; then -$as_echo "#define NO_DIRENT_H 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define NO_DIRENT_H 1 +_ACEOF fi - ac_fn_c_check_header_mongrel "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default" -if test "x$ac_cv_header_float_h" = xyes; then : - + if test "${ac_cv_header_float_h+set}" = set; then + echo "$as_me:$LINENO: checking for float.h" >&5 +echo $ECHO_N "checking for float.h... $ECHO_C" >&6 +if test "${ac_cv_header_float_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 +echo "${ECHO_T}$ac_cv_header_float_h" >&6 else + # Is the header compilable? +echo "$as_me:$LINENO: checking float.h usability" >&5 +echo $ECHO_N "checking float.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -$as_echo "#define NO_FLOAT_H 1" >>confdefs.h - +ac_header_compiler=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 +# Is the header present? +echo "$as_me:$LINENO: checking float.h presence" >&5 +echo $ECHO_N "checking float.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default" -if test "x$ac_cv_header_values_h" = xyes; then : + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: float.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: float.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: float.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: float.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: float.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: float.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: float.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: float.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: float.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: float.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for float.h" >&5 +echo $ECHO_N "checking for float.h... $ECHO_C" >&6 +if test "${ac_cv_header_float_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - -$as_echo "#define NO_VALUES_H 1" >>confdefs.h + ac_cv_header_float_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5 +echo "${ECHO_T}$ac_cv_header_float_h" >&6 fi +if test $ac_cv_header_float_h = yes; then + : +else +cat >>confdefs.h <<\_ACEOF +#define NO_FLOAT_H 1 +_ACEOF - ac_fn_c_check_header_mongrel "$LINENO" "limits.h" "ac_cv_header_limits_h" "$ac_includes_default" -if test "x$ac_cv_header_limits_h" = xyes; then : +fi -$as_echo "#define HAVE_LIMITS_H 1" >>confdefs.h + if test "${ac_cv_header_values_h+set}" = set; then + echo "$as_me:$LINENO: checking for values.h" >&5 +echo $ECHO_N "checking for values.h... $ECHO_C" >&6 +if test "${ac_cv_header_values_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 +echo "${ECHO_T}$ac_cv_header_values_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking values.h usability" >&5 +echo $ECHO_N "checking values.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -$as_echo "#define NO_LIMITS_H 1" >>confdefs.h +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 +# Is the header present? +echo "$as_me:$LINENO: checking values.h presence" >&5 +echo $ECHO_N "checking values.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 - ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" -if test "x$ac_cv_header_stdlib_h" = xyes; then : - tcl_ok=1 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: values.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: values.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: values.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: values.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: values.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: values.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: values.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: values.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: values.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: values.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for values.h" >&5 +echo $ECHO_N "checking for values.h... $ECHO_C" >&6 +if test "${ac_cv_header_values_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - tcl_ok=0 + ac_cv_header_values_h=$ac_header_preproc fi +echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5 +echo "${ECHO_T}$ac_cv_header_values_h" >&6 +fi +if test $ac_cv_header_values_h = yes; then + : +else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - +cat >>confdefs.h <<\_ACEOF +#define NO_VALUES_H 1 _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtol" >/dev/null 2>&1; then : -else - tcl_ok=0 fi -rm -f conftest* - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include + if test "${ac_cv_header_limits_h+set}" = set; then + echo "$as_me:$LINENO: checking for limits.h" >&5 +echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 +if test "${ac_cv_header_limits_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 +echo "${ECHO_T}$ac_cv_header_limits_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking limits.h usability" >&5 +echo $ECHO_N "checking limits.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtoul" >/dev/null 2>&1; then : - +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes else - tcl_ok=0 + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no fi -rm -f conftest* +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +# Is the header present? +echo "$as_me:$LINENO: checking limits.h presence" >&5 +echo $ECHO_N "checking limits.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include - +#include _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtod" >/dev/null 2>&1; then : - +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - tcl_ok=0 + ac_cpp_err=yes fi -rm -f conftest* - - if test $tcl_ok = 0; then +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -$as_echo "#define NO_STDLIB_H 1" >>confdefs.h + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 - fi - ac_fn_c_check_header_mongrel "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default" -if test "x$ac_cv_header_string_h" = xyes; then : - tcl_ok=1 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: limits.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: limits.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: limits.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: limits.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: limits.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: limits.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: limits.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: limits.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: limits.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: limits.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for limits.h" >&5 +echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 +if test "${ac_cv_header_limits_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - tcl_ok=0 + ac_cv_header_limits_h=$ac_header_preproc fi +echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 +echo "${ECHO_T}$ac_cv_header_limits_h" >&6 +fi +if test $ac_cv_header_limits_h = yes; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - +cat >>confdefs.h <<\_ACEOF +#define HAVE_LIMITS_H 1 _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strstr" >/dev/null 2>&1; then : else - tcl_ok=0 -fi -rm -f conftest* - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include +cat >>confdefs.h <<\_ACEOF +#define NO_LIMITS_H 1 _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strerror" >/dev/null 2>&1; then : -else - tcl_ok=0 fi -rm -f conftest* - - - # See also memmove check below for a place where NO_STRING_H can be - # set and why. - - if test $tcl_ok = 0; then - -$as_echo "#define NO_STRING_H 1" >>confdefs.h - - fi - ac_fn_c_check_header_mongrel "$LINENO" "sys/wait.h" "ac_cv_header_sys_wait_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_wait_h" = xyes; then : + if test "${ac_cv_header_stdlib_h+set}" = set; then + echo "$as_me:$LINENO: checking for stdlib.h" >&5 +echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 +if test "${ac_cv_header_stdlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 else + # Is the header compilable? +echo "$as_me:$LINENO: checking stdlib.h usability" >&5 +echo $ECHO_N "checking stdlib.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -$as_echo "#define NO_SYS_WAIT_H 1" >>confdefs.h - +ac_header_compiler=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 - - ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" -if test "x$ac_cv_header_dlfcn_h" = xyes; then : - +# Is the header present? +echo "$as_me:$LINENO: checking stdlib.h presence" >&5 +echo $ECHO_N "checking stdlib.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -$as_echo "#define NO_DLFCN_H 1" >>confdefs.h + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: stdlib.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: stdlib.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: stdlib.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: stdlib.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: stdlib.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: stdlib.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: stdlib.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: stdlib.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: stdlib.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: stdlib.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for stdlib.h" >&5 +echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 +if test "${ac_cv_header_stdlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_stdlib_h=$ac_header_preproc fi +echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6 +fi +if test $ac_cv_header_stdlib_h = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi - # OS/390 lacks sys/param.h (and doesn't need it, by chance). - for ac_header in sys/param.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/param.h" "ac_cv_header_sys_param_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_param_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_PARAM_H 1 + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtol" >/dev/null 2>&1; then + : +else + tcl_ok=0 fi +rm -f conftest* -done - + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtoul" >/dev/null 2>&1; then + : +else + tcl_ok=0 +fi +rm -f conftest* -#-------------------------------------------------------------------- -# Determines the correct executable file extension (.exe) -#-------------------------------------------------------------------- + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtod" >/dev/null 2>&1; then + : +else + tcl_ok=0 +fi +rm -f conftest* + if test $tcl_ok = 0; then -#------------------------------------------------------------------------ -# If we're using GCC, see if the compiler understands -pipe. If so, use it. -# It makes compiling go faster. (This is only a performance feature.) -#------------------------------------------------------------------------ +cat >>confdefs.h <<\_ACEOF +#define NO_STDLIB_H 1 +_ACEOF -if test -z "$no_pipe" && test -n "$GCC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5 -$as_echo_n "checking if the compiler understands -pipe... " >&6; } -if ${tcl_cv_cc_pipe+:} false; then : - $as_echo_n "(cached) " >&6 + fi + if test "${ac_cv_header_string_h+set}" = set; then + echo "$as_me:$LINENO: checking for string.h" >&5 +echo $ECHO_N "checking for string.h... $ECHO_C" >&6 +if test "${ac_cv_header_string_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 +echo "${ECHO_T}$ac_cv_header_string_h" >&6 else - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + # Is the header compilable? +echo "$as_me:$LINENO: checking string.h usability" >&5 +echo $ECHO_N "checking string.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -int -main () -{ +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 - ; - return 0; -} +# Is the header present? +echo "$as_me:$LINENO: checking string.h presence" >&5 +echo $ECHO_N "checking string.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_cc_pipe=yes +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - tcl_cv_cc_pipe=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS=$hold_cflags -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5 -$as_echo "$tcl_cv_cc_pipe" >&6; } - if test $tcl_cv_cc_pipe = yes; then - CFLAGS="$CFLAGS -pipe" - fi + ac_cpp_err=yes fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -#------------------------------------------------------------------------ -# Threads support -#------------------------------------------------------------------------ + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: string.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: string.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: string.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: string.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: string.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: string.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: string.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: string.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: string.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: string.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for string.h" >&5 +echo $ECHO_N "checking for string.h... $ECHO_C" >&6 +if test "${ac_cv_header_string_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_string_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5 +echo "${ECHO_T}$ac_cv_header_string_h" >&6 - # Check whether --enable-threads was given. -if test "${enable_threads+set}" = set; then : - enableval=$enable_threads; tcl_ok=$enableval +fi +if test $ac_cv_header_string_h = yes; then + tcl_ok=1 else - tcl_ok=yes + tcl_ok=0 fi - if test "${TCL_THREADS}" = 1; then - tcl_threaded_core=1; - fi + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include - if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then - TCL_THREADS=1 - # USE_THREAD_ALLOC tells us to try the special thread-based - # allocator that significantly reduces lock contention +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strstr" >/dev/null 2>&1; then + : +else + tcl_ok=0 +fi +rm -f conftest* -$as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strerror" >/dev/null 2>&1; then + : +else + tcl_ok=0 +fi +rm -f conftest* -$as_echo "#define _REENTRANT 1" >>confdefs.h - if test "`uname -s`" = "SunOS" ; then + # See also memmove check below for a place where NO_STRING_H can be + # set and why. -$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + if test $tcl_ok = 0; then - fi +cat >>confdefs.h <<\_ACEOF +#define NO_STRING_H 1 +_ACEOF -$as_echo "#define _THREAD_SAFE 1" >>confdefs.h + fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5 -$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; } -if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then : - $as_echo_n "(cached) " >&6 + if test "${ac_cv_header_sys_wait_h+set}" = set; then + echo "$as_me:$LINENO: checking for sys/wait.h" >&5 +echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 +if test "${ac_cv_header_sys_wait_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 +echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthread $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + # Is the header compilable? +echo "$as_me:$LINENO: checking sys/wait.h usability" >&5 +echo $ECHO_N "checking sys/wait.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char pthread_mutex_init (); -int -main () -{ -return pthread_mutex_init (); - ; - return 0; -} +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking sys/wait.h presence" >&5 +echo $ECHO_N "checking sys/wait.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_pthread_pthread_mutex_init=yes +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - ac_cv_lib_pthread_pthread_mutex_init=no + ac_cpp_err=yes fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 -$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; } -if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then : - tcl_ok=yes +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: sys/wait.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: sys/wait.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: sys/wait.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/wait.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: sys/wait.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/wait.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: sys/wait.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for sys/wait.h" >&5 +echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6 +if test "${ac_cv_header_sys_wait_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - tcl_ok=no + ac_cv_header_sys_wait_h=$ac_header_preproc fi +echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5 +echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6 - if test "$tcl_ok" = "no"; then - # Check a little harder for __pthread_mutex_init in the same - # library, as some systems hide it there until pthread.h is - # defined. We could alternatively do an AC_TRY_COMPILE with - # pthread.h, but that will work with libpthread really doesn't - # exist, like AIX 4.2. [Bug: 4359] - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5 -$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; } -if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then : - $as_echo_n "(cached) " >&6 +fi +if test $ac_cv_header_sys_wait_h = yes; then + : else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthread $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" +cat >>confdefs.h <<\_ACEOF +#define NO_SYS_WAIT_H 1 +_ACEOF + +fi + + + if test "${ac_cv_header_dlfcn_h+set}" = set; then + echo "$as_me:$LINENO: checking for dlfcn.h" >&5 +echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 +if test "${ac_cv_header_dlfcn_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 +echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking dlfcn.h usability" >&5 +echo $ECHO_N "checking dlfcn.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking dlfcn.h presence" >&5 +echo $ECHO_N "checking dlfcn.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: dlfcn.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: dlfcn.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: dlfcn.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: dlfcn.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: dlfcn.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: dlfcn.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: dlfcn.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for dlfcn.h" >&5 +echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6 +if test "${ac_cv_header_dlfcn_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_dlfcn_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5 +echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6 + +fi +if test $ac_cv_header_dlfcn_h = yes; then + : +else + +cat >>confdefs.h <<\_ACEOF +#define NO_DLFCN_H 1 +_ACEOF + +fi + + + + # OS/390 lacks sys/param.h (and doesn't need it, by chance). + +for ac_header in sys/param.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + +#-------------------------------------------------------------------- +# Determines the correct executable file extension (.exe) +#-------------------------------------------------------------------- + + + +#------------------------------------------------------------------------ +# If we're using GCC, see if the compiler understands -pipe. If so, use it. +# It makes compiling go faster. (This is only a performance feature.) +#------------------------------------------------------------------------ + +if test -z "$no_pipe" && test -n "$GCC"; then + echo "$as_me:$LINENO: checking if the compiler understands -pipe" >&5 +echo $ECHO_N "checking if the compiler understands -pipe... $ECHO_C" >&6 +if test "${tcl_cv_cc_pipe+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_cc_pipe=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_pipe=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +echo "$as_me:$LINENO: result: $tcl_cv_cc_pipe" >&5 +echo "${ECHO_T}$tcl_cv_cc_pipe" >&6 + if test $tcl_cv_cc_pipe = yes; then + CFLAGS="$CFLAGS -pipe" + fi +fi + +#------------------------------------------------------------------------ +# Threads support +#------------------------------------------------------------------------ + + + # Check whether --enable-threads or --disable-threads was given. +if test "${enable_threads+set}" = set; then + enableval="$enable_threads" + tcl_ok=$enableval +else + tcl_ok=yes +fi; + + if test "${TCL_THREADS}" = 1; then + tcl_threaded_core=1; + fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + TCL_THREADS=1 + # USE_THREAD_ALLOC tells us to try the special thread-based + # allocator that significantly reduces lock contention + +cat >>confdefs.h <<\_ACEOF +#define USE_THREAD_ALLOC 1 +_ACEOF + + +cat >>confdefs.h <<\_ACEOF +#define _REENTRANT 1 +_ACEOF + + if test "`uname -s`" = "SunOS" ; then + +cat >>confdefs.h <<\_ACEOF +#define _POSIX_PTHREAD_SEMANTICS 1 +_ACEOF + + fi + +cat >>confdefs.h <<\_ACEOF +#define _THREAD_SAFE 1 +_ACEOF + + echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthread" >&5 +echo $ECHO_N "checking for pthread_mutex_init in -lpthread... $ECHO_C" >&6 +if test "${ac_cv_lib_pthread_pthread_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char pthread_mutex_init (); +int +main () +{ +pthread_mutex_init (); + ; + 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 + ac_cv_lib_pthread_pthread_mutex_init=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_pthread_pthread_mutex_init=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_lib_pthread_pthread_mutex_init" >&6 +if test $ac_cv_lib_pthread_pthread_mutex_init = yes; then + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "no"; then + # Check a little harder for __pthread_mutex_init in the same + # library, as some systems hide it there until pthread.h is + # defined. We could alternatively do an AC_TRY_COMPILE with + # pthread.h, but that will work with libpthread really doesn't + # exist, like AIX 4.2. [Bug: 4359] + echo "$as_me:$LINENO: checking for __pthread_mutex_init in -lpthread" >&5 +echo $ECHO_N "checking for __pthread_mutex_init in -lpthread... $ECHO_C" >&6 +if test "${ac_cv_lib_pthread___pthread_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char __pthread_mutex_init (); int main () { -return __pthread_mutex_init (); +__pthread_mutex_init (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_pthread___pthread_mutex_init=yes else - ac_cv_lib_pthread___pthread_mutex_init=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_pthread___pthread_mutex_init=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 -$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; } -if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_lib_pthread___pthread_mutex_init" >&6 +if test $ac_cv_lib_pthread___pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no @@ -4081,43 +4594,71 @@ fi # The space is needed THREADS_LIBS=" -lpthread" else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5 -$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; } -if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5 +echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6 +if test "${ac_cv_lib_pthreads_pthread_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { -return pthread_mutex_init (); +pthread_mutex_init (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_pthreads_pthread_mutex_init=yes else - ac_cv_lib_pthreads_pthread_mutex_init=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_pthreads_pthread_mutex_init=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 -$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; } -if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_lib_pthreads_pthread_mutex_init" >&6 +if test $ac_cv_lib_pthreads_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no @@ -4127,86 +4668,142 @@ fi # The space is needed THREADS_LIBS=" -lpthreads" else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5 -$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; } -if ${ac_cv_lib_c_pthread_mutex_init+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc" >&5 +echo $ECHO_N "checking for pthread_mutex_init in -lc... $ECHO_C" >&6 +if test "${ac_cv_lib_c_pthread_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { -return pthread_mutex_init (); +pthread_mutex_init (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_c_pthread_mutex_init=yes else - ac_cv_lib_c_pthread_mutex_init=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_c_pthread_mutex_init=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5 -$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; } -if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_c_pthread_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_lib_c_pthread_mutex_init" >&6 +if test $ac_cv_lib_c_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no fi if test "$tcl_ok" = "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5 -$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; } -if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc_r" >&5 +echo $ECHO_N "checking for pthread_mutex_init in -lc_r... $ECHO_C" >&6 +if test "${ac_cv_lib_c_r_pthread_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char pthread_mutex_init (); int main () { -return pthread_mutex_init (); +pthread_mutex_init (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_c_r_pthread_mutex_init=yes else - ac_cv_lib_c_r_pthread_mutex_init=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_c_r_pthread_mutex_init=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 -$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; } -if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_lib_c_r_pthread_mutex_init" >&6 +if test $ac_cv_lib_c_r_pthread_mutex_init = yes; then tcl_ok=yes else tcl_ok=no @@ -4217,8 +4814,8 @@ fi THREADS_LIBS=" -pthread" else TCL_THREADS=0 - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 -$as_echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} + { echo "$as_me:$LINENO: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5 +echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;} fi fi fi @@ -4229,13 +4826,104 @@ $as_echo "$as_me: WARNING: Don't know how to find pthread lib on your system - y ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" - for ac_func in pthread_attr_setstacksize pthread_atfork -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + + +for ac_func in pthread_attr_setstacksize pthread_atfork +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + 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 + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi @@ -4246,22 +4934,24 @@ done TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5 -$as_echo_n "checking for building with threads... " >&6; } + echo "$as_me:$LINENO: checking for building with threads" >&5 +echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 if test "${TCL_THREADS}" = 1; then -$as_echo "#define TCL_THREADS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_THREADS 1 +_ACEOF if test "${tcl_threaded_core}" = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (threaded core)" >&5 -$as_echo "yes (threaded core)" >&6; } + echo "$as_me:$LINENO: result: yes (threaded core)" >&5 +echo "${ECHO_T}yes (threaded core)" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 fi else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi @@ -4273,11 +4963,11 @@ $as_echo "no" >&6; } -# Check whether --with-encoding was given. -if test "${with_encoding+set}" = set; then : - withval=$with_encoding; with_tcencoding=${withval} -fi - +# Check whether --with-encoding or --without-encoding was given. +if test "${with_encoding+set}" = set; then + withval="$with_encoding" + with_tcencoding=${withval} +fi; if test x"${with_tcencoding}" != x ; then @@ -4287,7 +4977,9 @@ _ACEOF else -$as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_CFGVAL_ENCODING "iso8859-1" +_ACEOF fi @@ -4304,44 +4996,161 @@ $as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h # right (and it must appear before "-lm"). #-------------------------------------------------------------------- - ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin" -if test "x$ac_cv_func_sin" = xyes; then : + echo "$as_me:$LINENO: checking for sin" >&5 +echo $ECHO_N "checking for sin... $ECHO_C" >&6 +if test "${ac_cv_func_sin+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. */ +/* Define sin to an innocuous variant, in case declares sin. + For example, HP-UX 11i declares gettimeofday. */ +#define sin innocuous_sin + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char sin (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef sin + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char sin (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_sin) || defined (__stub___sin) +choke me +#else +char (*f) () = sin; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != sin; + ; + 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 + ac_cv_func_sin=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_sin=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_sin" >&5 +echo "${ECHO_T}$ac_cv_func_sin" >&6 +if test $ac_cv_func_sin = yes; then MATH_LIBS="" else MATH_LIBS="-lm" fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lieee" >&5 -$as_echo_n "checking for main in -lieee... " >&6; } -if ${ac_cv_lib_ieee_main+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for main in -lieee" >&5 +echo $ECHO_N "checking for main in -lieee... $ECHO_C" >&6 +if test "${ac_cv_lib_ieee_main+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lieee $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { -return main (); +main (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_ieee_main=yes else - ac_cv_lib_ieee_main=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_ieee_main=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ieee_main" >&5 -$as_echo "$ac_cv_lib_ieee_main" >&6; } -if test "x$ac_cv_lib_ieee_main" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_ieee_main" >&5 +echo "${ECHO_T}$ac_cv_lib_ieee_main" >&6 +if test $ac_cv_lib_ieee_main = yes; then MATH_LIBS="-lieee $MATH_LIBS" fi @@ -4351,45 +5160,211 @@ fi # needs net/errno.h to define the socket-related error codes. #-------------------------------------------------------------------- - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5 -$as_echo_n "checking for main in -linet... " >&6; } -if ${ac_cv_lib_inet_main+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for main in -linet" >&5 +echo $ECHO_N "checking for main in -linet... $ECHO_C" >&6 +if test "${ac_cv_lib_inet_main+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { -return main (); +main (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_inet_main=yes else - ac_cv_lib_inet_main=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_inet_main=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5 -$as_echo "$ac_cv_lib_inet_main" >&6; } -if test "x$ac_cv_lib_inet_main" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_inet_main" >&5 +echo "${ECHO_T}$ac_cv_lib_inet_main" >&6 +if test $ac_cv_lib_inet_main = yes; then LIBS="$LIBS -linet" fi - ac_fn_c_check_header_mongrel "$LINENO" "net/errno.h" "ac_cv_header_net_errno_h" "$ac_includes_default" -if test "x$ac_cv_header_net_errno_h" = xyes; then : + if test "${ac_cv_header_net_errno_h+set}" = set; then + echo "$as_me:$LINENO: checking for net/errno.h" >&5 +echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 +if test "${ac_cv_header_net_errno_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 +echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking net/errno.h usability" >&5 +echo $ECHO_N "checking net/errno.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking net/errno.h presence" >&5 +echo $ECHO_N "checking net/errno.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: net/errno.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: net/errno.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: net/errno.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: net/errno.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: net/errno.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: net/errno.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: net/errno.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: net/errno.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: net/errno.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: net/errno.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for net/errno.h" >&5 +echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6 +if test "${ac_cv_header_net_errno_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_net_errno_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5 +echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6 + +fi +if test $ac_cv_header_net_errno_h = yes; then -$as_echo "#define HAVE_NET_ERRNO_H 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_NET_ERRNO_H 1 +_ACEOF fi @@ -4414,115 +5389,527 @@ fi #-------------------------------------------------------------------- tcl_checkBoth=0 - ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" -if test "x$ac_cv_func_connect" = xyes; then : - tcl_checkSocket=0 + echo "$as_me:$LINENO: checking for connect" >&5 +echo $ECHO_N "checking for connect... $ECHO_C" >&6 +if test "${ac_cv_func_connect+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - tcl_checkSocket=1 -fi + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define connect to an innocuous variant, in case declares connect. + For example, HP-UX 11i declares gettimeofday. */ +#define connect innocuous_connect - if test "$tcl_checkSocket" = 1; then - ac_fn_c_check_func "$LINENO" "setsockopt" "ac_cv_func_setsockopt" -if test "x$ac_cv_func_setsockopt" = xyes; then : +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char connect (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5 -$as_echo_n "checking for setsockopt in -lsocket... " >&6; } -if ${ac_cv_lib_socket_setsockopt+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lsocket $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +#undef connect + +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" +{ #endif -char setsockopt (); +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char connect (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_connect) || defined (__stub___connect) +choke me +#else +char (*f) () = connect; +#endif +#ifdef __cplusplus +} +#endif + int main () { -return setsockopt (); +return f != connect; ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_socket_setsockopt=yes +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 + ac_cv_func_connect=yes else - ac_cv_lib_socket_setsockopt=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_connect=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5 -$as_echo "$ac_cv_lib_socket_setsockopt" >&6; } -if test "x$ac_cv_lib_socket_setsockopt" = xyes; then : - LIBS="$LIBS -lsocket" +echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5 +echo "${ECHO_T}$ac_cv_func_connect" >&6 +if test $ac_cv_func_connect = yes; then + tcl_checkSocket=0 else - tcl_checkBoth=1 -fi - + tcl_checkSocket=1 fi - fi - if test "$tcl_checkBoth" = 1; then - tk_oldLibs=$LIBS - LIBS="$LIBS -lsocket -lnsl" - ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept" -if test "x$ac_cv_func_accept" = xyes; then : - tcl_checkNsl=0 + if test "$tcl_checkSocket" = 1; then + echo "$as_me:$LINENO: checking for setsockopt" >&5 +echo $ECHO_N "checking for setsockopt... $ECHO_C" >&6 +if test "${ac_cv_func_setsockopt+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - LIBS=$tk_oldLibs -fi + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define setsockopt to an innocuous variant, in case declares setsockopt. + For example, HP-UX 11i declares gettimeofday. */ +#define setsockopt innocuous_setsockopt - fi - ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" -if test "x$ac_cv_func_gethostbyname" = xyes; then : +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char setsockopt (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 -$as_echo_n "checking for gethostbyname in -lnsl... " >&6; } -if ${ac_cv_lib_nsl_gethostbyname+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lnsl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +#undef setsockopt + +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" +{ #endif -char gethostbyname (); +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char setsockopt (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_setsockopt) || defined (__stub___setsockopt) +choke me +#else +char (*f) () = setsockopt; +#endif +#ifdef __cplusplus +} +#endif + int main () { -return gethostbyname (); +return f != setsockopt; ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_nsl_gethostbyname=yes +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 + ac_cv_func_setsockopt=yes else - ac_cv_lib_nsl_gethostbyname=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_setsockopt=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_setsockopt" >&5 +echo "${ECHO_T}$ac_cv_func_setsockopt" >&6 +if test $ac_cv_func_setsockopt = yes; then + : +else + echo "$as_me:$LINENO: checking for setsockopt in -lsocket" >&5 +echo $ECHO_N "checking for setsockopt in -lsocket... $ECHO_C" >&6 +if test "${ac_cv_lib_socket_setsockopt+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char setsockopt (); +int +main () +{ +setsockopt (); + ; + 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 + ac_cv_lib_socket_setsockopt=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_socket_setsockopt=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_socket_setsockopt" >&5 +echo "${ECHO_T}$ac_cv_lib_socket_setsockopt" >&6 +if test $ac_cv_lib_socket_setsockopt = yes; then + LIBS="$LIBS -lsocket" +else + tcl_checkBoth=1 +fi + +fi + + fi + if test "$tcl_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + echo "$as_me:$LINENO: checking for accept" >&5 +echo $ECHO_N "checking for accept... $ECHO_C" >&6 +if test "${ac_cv_func_accept+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. */ +/* Define accept to an innocuous variant, in case declares accept. + For example, HP-UX 11i declares gettimeofday. */ +#define accept innocuous_accept + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char accept (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef accept + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char accept (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_accept) || defined (__stub___accept) +choke me +#else +char (*f) () = accept; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != accept; + ; + 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 + ac_cv_func_accept=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_accept=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_accept" >&5 +echo "${ECHO_T}$ac_cv_func_accept" >&6 +if test $ac_cv_func_accept = yes; then + tcl_checkNsl=0 +else + LIBS=$tk_oldLibs +fi + + fi + echo "$as_me:$LINENO: checking for gethostbyname" >&5 +echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6 +if test "${ac_cv_func_gethostbyname+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. */ +/* Define gethostbyname to an innocuous variant, in case declares gethostbyname. + For example, HP-UX 11i declares gettimeofday. */ +#define gethostbyname innocuous_gethostbyname + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char gethostbyname (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef gethostbyname + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gethostbyname (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) +choke me +#else +char (*f) () = gethostbyname; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != gethostbyname; + ; + 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 + ac_cv_func_gethostbyname=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_gethostbyname=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5 +echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6 +if test $ac_cv_func_gethostbyname = yes; then + : +else + echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5 +echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6 +if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lnsl $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gethostbyname (); +int +main () +{ +gethostbyname (); + ; + 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 + ac_cv_lib_nsl_gethostbyname=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_nsl_gethostbyname=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 -$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; } -if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5 +echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6 +if test $ac_cv_lib_nsl_gethostbyname = yes; then LIBS="$LIBS -lnsl" fi @@ -4534,15 +5921,15 @@ fi LIBS="$LIBS$THREADS_LIBS" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 -$as_echo_n "checking how to build libraries... " >&6; } - # Check whether --enable-shared was given. -if test "${enable_shared+set}" = set; then : - enableval=$enable_shared; tcl_ok=$enableval + echo "$as_me:$LINENO: checking how to build libraries" >&5 +echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 + # Check whether --enable-shared or --disable-shared was given. +if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + tcl_ok=$enableval else tcl_ok=yes -fi - +fi; if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -4552,15 +5939,17 @@ fi fi if test "$tcl_ok" = "yes" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5 -$as_echo "shared" >&6; } + echo "$as_me:$LINENO: result: shared" >&5 +echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5 -$as_echo "static" >&6; } + echo "$as_me:$LINENO: result: static" >&5 +echo "${ECHO_T}static" >&6 SHARED_BUILD=0 -$as_echo "#define STATIC_BUILD 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define STATIC_BUILD 1 +_ACEOF fi @@ -4572,10 +5961,10 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h #-------------------------------------------------------------------- - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 -$as_echo_n "checking for tclsh... " >&6; } - if ${ac_cv_path_tclsh+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for tclsh" >&5 +echo $ECHO_N "checking for tclsh... $ECHO_C" >&6 + if test "${ac_cv_path_tclsh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else search_path=`echo ${PATH} | sed -e 's/:/ /g'` @@ -4596,13 +5985,13 @@ fi if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 -$as_echo "$TCLSH_PROG" >&6; } + echo "$as_me:$LINENO: result: $TCLSH_PROG" >&5 +echo "${ECHO_T}$TCLSH_PROG" >&6 else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 -$as_echo "No tclsh found on PATH" >&6; } + echo "$as_me:$LINENO: result: No tclsh found on PATH" >&5 +echo "${ECHO_T}No tclsh found on PATH" >&6 fi @@ -4615,113 +6004,378 @@ fi #------------------------------------------------------------------------ zlib_ok=yes -ac_fn_c_check_header_mongrel "$LINENO" "zlib.h" "ac_cv_header_zlib_h" "$ac_includes_default" -if test "x$ac_cv_header_zlib_h" = xyes; then : +if test "${ac_cv_header_zlib_h+set}" = set; then + echo "$as_me:$LINENO: checking for zlib.h" >&5 +echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 +if test "${ac_cv_header_zlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking zlib.h usability" >&5 +echo $ECHO_N "checking zlib.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - ac_fn_c_check_type "$LINENO" "gz_header" "ac_cv_type_gz_header" "#include -" -if test "x$ac_cv_type_gz_header" = xyes; then : +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 +# Is the header present? +echo "$as_me:$LINENO: checking zlib.h presence" >&5 +echo $ECHO_N "checking zlib.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - zlib_ok=no + ac_cpp_err=yes fi - +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - zlib_ok=no + ac_header_preproc=no fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: zlib.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: zlib.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: zlib.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: zlib.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: zlib.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: zlib.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: zlib.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: zlib.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for zlib.h" >&5 +echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6 +if test "${ac_cv_header_zlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_zlib_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_zlib_h" >&6 -if test $zlib_ok = yes; then : +fi +if test $ac_cv_header_zlib_h = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing deflateSetHeader" >&5 -$as_echo_n "checking for library containing deflateSetHeader... " >&6; } -if ${ac_cv_search_deflateSetHeader+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for gz_header" >&5 +echo $ECHO_N "checking for gz_header... $ECHO_C" >&6 +if test "${ac_cv_type_gz_header+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - ac_func_search_save_LIBS=$LIBS -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +#include -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char deflateSetHeader (); int main () { -return deflateSetHeader (); +if ((gz_header *) 0) + return 0; +if (sizeof (gz_header)) + return 0; ; return 0; } _ACEOF -for ac_lib in '' z; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_deflateSetHeader=$ac_res +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_gz_header=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_gz_header=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if ${ac_cv_search_deflateSetHeader+:} false; then : - break +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -done -if ${ac_cv_search_deflateSetHeader+:} false; then : - +echo "$as_me:$LINENO: result: $ac_cv_type_gz_header" >&5 +echo "${ECHO_T}$ac_cv_type_gz_header" >&6 +if test $ac_cv_type_gz_header = yes; then + : else - ac_cv_search_deflateSetHeader=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS + zlib_ok=no fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_deflateSetHeader" >&5 -$as_echo "$ac_cv_search_deflateSetHeader" >&6; } -ac_res=$ac_cv_search_deflateSetHeader -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" else - zlib_ok=no - -fi - + zlib_ok=no fi -if test $zlib_ok = no; then : - ZLIB_OBJS=\${ZLIB_OBJS} - - ZLIB_SRCS=\${ZLIB_SRCS} - - ZLIB_INCLUDE=-I\${ZLIB_DIR} - - -fi -$as_echo "#define HAVE_ZLIB 1" >>confdefs.h +if test $zlib_ok = yes; then + echo "$as_me:$LINENO: checking for library containing deflateSetHeader" >&5 +echo $ECHO_N "checking for library containing deflateSetHeader... $ECHO_C" >&6 +if test "${ac_cv_search_deflateSetHeader+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_func_search_save_LIBS=$LIBS +ac_cv_search_deflateSetHeader=no +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ -#-------------------------------------------------------------------- -# The statements below define a collection of compile flags. This -# macro depends on the value of SHARED_BUILD, and should be called -# after SC_ENABLE_SHARED checks the configure switches. +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char deflateSetHeader (); +int +main () +{ +deflateSetHeader (); + ; + 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 + ac_cv_search_deflateSetHeader="none required" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test "$ac_cv_search_deflateSetHeader" = no; then + for ac_lib in z; do + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char deflateSetHeader (); +int +main () +{ +deflateSetHeader (); + ; + 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 + ac_cv_search_deflateSetHeader="-l$ac_lib" +break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done +fi +LIBS=$ac_func_search_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_search_deflateSetHeader" >&5 +echo "${ECHO_T}$ac_cv_search_deflateSetHeader" >&6 +if test "$ac_cv_search_deflateSetHeader" != no; then + test "$ac_cv_search_deflateSetHeader" = "none required" || LIBS="$ac_cv_search_deflateSetHeader $LIBS" + +else + + zlib_ok=no + +fi + +fi + +if test $zlib_ok = no; then + + ZLIB_OBJS=\${ZLIB_OBJS} + + ZLIB_SRCS=\${ZLIB_SRCS} + + ZLIB_INCLUDE=-I\${ZLIB_DIR} + + +fi + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_ZLIB 1 +_ACEOF + + +#-------------------------------------------------------------------- +# The statements below define a collection of compile flags. This +# macro depends on the value of SHARED_BUILD, and should be called +# after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_RANLIB+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_RANLIB+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -4731,37 +6385,35 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 -$as_echo "$RANLIB" >&6; } + echo "$as_me:$LINENO: result: $RANLIB" >&5 +echo "${ECHO_T}$RANLIB" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. @@ -4771,38 +6423,28 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done + test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 -$as_echo "$ac_ct_RANLIB" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 +echo "${ECHO_T}$ac_ct_RANLIB" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_RANLIB" = x; then - RANLIB=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - RANLIB=$ac_ct_RANLIB - fi + RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi @@ -4811,47 +6453,52 @@ fi # Step 0.a: Enable 64 bit support? - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 -$as_echo_n "checking if 64bit support is requested... " >&6; } - # Check whether --enable-64bit was given. -if test "${enable_64bit+set}" = set; then : - enableval=$enable_64bit; do64bit=$enableval + echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 +echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 + # Check whether --enable-64bit or --disable-64bit was given. +if test "${enable_64bit+set}" = set; then + enableval="$enable_64bit" + do64bit=$enableval else do64bit=no -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 -$as_echo "$do64bit" >&6; } +fi; + echo "$as_me:$LINENO: result: $do64bit" >&5 +echo "${ECHO_T}$do64bit" >&6 # Step 0.b: Enable Solaris 64 bit VIS support? - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5 -$as_echo_n "checking if 64bit Sparc VIS support is requested... " >&6; } - # Check whether --enable-64bit-vis was given. -if test "${enable_64bit_vis+set}" = set; then : - enableval=$enable_64bit_vis; do64bitVIS=$enableval + echo "$as_me:$LINENO: checking if 64bit Sparc VIS support is requested" >&5 +echo $ECHO_N "checking if 64bit Sparc VIS support is requested... $ECHO_C" >&6 + # Check whether --enable-64bit-vis or --disable-64bit-vis was given. +if test "${enable_64bit_vis+set}" = set; then + enableval="$enable_64bit_vis" + do64bitVIS=$enableval else do64bitVIS=no -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5 -$as_echo "$do64bitVIS" >&6; } +fi; + echo "$as_me:$LINENO: result: $do64bitVIS" >&5 +echo "${ECHO_T}$do64bitVIS" >&6 # Force 64bit on with VIS - if test "$do64bitVIS" = "yes"; then : + if test "$do64bitVIS" = "yes"; then do64bit=yes fi + # Step 0.c: Check if visibility support is available. Do this here so # that platform specific alternatives can be used below if this fails. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5 -$as_echo_n "checking if compiler supports visibility \"hidden\"... " >&6; } -if ${tcl_cv_cc_visibility_hidden+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5 +echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6 +if test "${tcl_cv_cc_visibility_hidden+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ extern __attribute__((__visibility__("hidden"))) void f(void); @@ -4864,50 +6511,79 @@ f(); return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_cc_visibility_hidden=yes else - tcl_cv_cc_visibility_hidden=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_visibility_hidden=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5 -$as_echo "$tcl_cv_cc_visibility_hidden" >&6; } - if test $tcl_cv_cc_visibility_hidden = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 +echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 + if test $tcl_cv_cc_visibility_hidden = yes; then -$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE extern __attribute__((__visibility__("hidden"))) +_ACEOF -$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_HIDDEN 1 +_ACEOF fi + # Step 0.d: Disable -rpath support? - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5 -$as_echo_n "checking if rpath support is requested... " >&6; } - # Check whether --enable-rpath was given. -if test "${enable_rpath+set}" = set; then : - enableval=$enable_rpath; doRpath=$enableval + echo "$as_me:$LINENO: checking if rpath support is requested" >&5 +echo $ECHO_N "checking if rpath support is requested... $ECHO_C" >&6 + # Check whether --enable-rpath or --disable-rpath was given. +if test "${enable_rpath+set}" = set; then + enableval="$enable_rpath" + doRpath=$enableval else doRpath=yes -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5 -$as_echo "$doRpath" >&6; } +fi; + echo "$as_me:$LINENO: result: $doRpath" >&5 +echo "${ECHO_T}$doRpath" >&6 # Step 1: set the variable "system" to hold the name and version number # for the system. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 -$as_echo_n "checking system version... " >&6; } -if ${tcl_cv_sys_version+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking system version" >&5 +echo $ECHO_N "checking system version... $ECHO_C" >&6 +if test "${tcl_cv_sys_version+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then @@ -4915,8 +6591,8 @@ else else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 -$as_echo "$as_me: WARNING: can't find uname command" >&2;} + { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 +echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird @@ -4932,51 +6608,79 @@ $as_echo "$as_me: WARNING: can't find uname command" >&2;} fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 -$as_echo "$tcl_cv_sys_version" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 +echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 -$as_echo_n "checking for dlopen in -ldl... " >&6; } -if ${ac_cv_lib_dl_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 +echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 +if test "${ac_cv_lib_dl_dlopen+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char dlopen (); int main () { -return dlopen (); +dlopen (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_dl_dlopen=yes else - ac_cv_lib_dl_dlopen=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_dl_dlopen=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 -$as_echo "$ac_cv_lib_dl_dlopen" >&6; } -if test "x$ac_cv_lib_dl_dlopen" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 +echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 +if test $ac_cv_lib_dl_dlopen = yes; then have_dl=yes else have_dl=no @@ -5002,7 +6706,7 @@ fi ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g - if test "$GCC" = yes; then : + if test "$GCC" = yes; then CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall" @@ -5013,13 +6717,14 @@ else CFLAGS_WARNING="" fi + if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_AR+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_AR+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. @@ -5029,37 +6734,35 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 -$as_echo "$AR" >&6; } + echo "$as_me:$LINENO: result: $AR" >&5 +echo "${ECHO_T}$AR" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_AR+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_AR+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. @@ -5069,38 +6772,27 @@ for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 -$as_echo "$ac_ct_AR" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 +echo "${ECHO_T}$ac_ct_AR" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_AR" = x; then - AR="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - AR=$ac_ct_AR - fi + AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi @@ -5110,12 +6802,13 @@ fi PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" - if test x"${SHLIB_VERSION}" = x; then : + if test x"${SHLIB_VERSION}" = x; then SHLIB_VERSION="1.0" fi + case $system in AIX-*) - if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then : + if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then # AIX requires the _r compiler when gcc isn't being used case "${CC}" in @@ -5127,10 +6820,11 @@ fi CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` ;; esac - { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5 -$as_echo "Using $CC for compiling with threads" >&6; } + echo "$as_me:$LINENO: result: Using $CC for compiling with threads" >&5 +echo "${ECHO_T}Using $CC for compiling with threads" >&6 fi + LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_SUFFIX=".so" @@ -5143,12 +6837,12 @@ fi LDAIX_SRC='$(UNIX_DIR)/ldAix' # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = yes; then : + if test "$do64bit" = yes; then - if test "$GCC" = yes; then : + if test "$GCC" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 -$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 +echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} else @@ -5161,15 +6855,17 @@ else fi + fi - if test "`uname -m`" = ia64; then : + + if test "`uname -m`" = ia64; then # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" - if test "$GCC" = yes; then : + if test "$GCC" = yes; then CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' @@ -5178,11 +6874,12 @@ else CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else - if test "$GCC" = yes; then : + if test "$GCC" = yes; then SHLIB_LD='${CC} -shared -Wl,-bexpall' @@ -5192,12 +6889,14 @@ else LDFLAGS="$LDFLAGS -brtl" fi + SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi + ;; BeOS*) SHLIB_CFLAGS="-fPIC" @@ -5211,43 +6910,71 @@ fi # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5 -$as_echo_n "checking for inet_ntoa in -lbind... " >&6; } -if ${ac_cv_lib_bind_inet_ntoa+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for inet_ntoa in -lbind" >&5 +echo $ECHO_N "checking for inet_ntoa in -lbind... $ECHO_C" >&6 +if test "${ac_cv_lib_bind_inet_ntoa+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { -return inet_ntoa (); +inet_ntoa (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_bind_inet_ntoa=yes else - ac_cv_lib_bind_inet_ntoa=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_bind_inet_ntoa=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5 -$as_echo "$ac_cv_lib_bind_inet_ntoa" >&6; } -if test "x$ac_cv_lib_bind_inet_ntoa" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_bind_inet_ntoa" >&5 +echo "${ECHO_T}$ac_cv_lib_bind_inet_ntoa" >&6 +if test $ac_cv_lib_bind_inet_ntoa = yes; then LIBS="$LIBS -lbind -lsocket" fi @@ -5284,12 +7011,16 @@ fi TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5 -$as_echo_n "checking for Cygwin version of gcc... " >&6; } -if ${ac_cv_cygwin+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 +echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 +if test "${ac_cv_cygwin+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __CYGWIN__ @@ -5304,21 +7035,49 @@ main () return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 ac_cv_cygwin=no else - ac_cv_cygwin=yes + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_cygwin=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5 -$as_echo "$ac_cv_cygwin" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5 +echo "${ECHO_T}$ac_cv_cygwin" >&6 if test "$ac_cv_cygwin" = "no"; then - as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5 + { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5 +echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} + { (exit 1); exit 1; }; } fi if test "x${TCL_THREADS}" = "x0"; then - as_fn_error $? "CYGWIN compile is only supported with --enable-threads" "$LINENO" 5 + { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5 +echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} + { (exit 1); exit 1; }; } fi do64bit_ok=yes if test "x${SHARED_BUILD}" = "x1"; then @@ -5348,43 +7107,71 @@ $as_echo "$ac_cv_cygwin" >&6; } SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-lroot" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5 -$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; } -if ${ac_cv_lib_network_inet_ntoa+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5 +echo $ECHO_N "checking for inet_ntoa in -lnetwork... $ECHO_C" >&6 +if test "${ac_cv_lib_network_inet_ntoa+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char inet_ntoa (); int main () { -return inet_ntoa (); +inet_ntoa (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_network_inet_ntoa=yes else - ac_cv_lib_network_inet_ntoa=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_network_inet_ntoa=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5 -$as_echo "$ac_cv_lib_network_inet_ntoa" >&6; } -if test "x$ac_cv_lib_network_inet_ntoa" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_network_inet_ntoa" >&5 +echo "${ECHO_T}$ac_cv_lib_network_inet_ntoa" >&6 +if test $ac_cv_lib_network_inet_ntoa = yes; then LIBS="$LIBS -lnetwork" fi @@ -5392,14 +7179,18 @@ fi HP-UX-*.11.*) # Use updated header definitions where possible -$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _XOPEN_SOURCE_EXTENDED 1 +_ACEOF -$as_echo "#define _XOPEN_SOURCE 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _XOPEN_SOURCE 1 +_ACEOF LIBS="$LIBS -lxnet" # Use the XOPEN network library - if test "`uname -m`" = ia64; then : + if test "`uname -m`" = ia64; then SHLIB_SUFFIX=".so" @@ -5408,49 +7199,78 @@ else SHLIB_SUFFIX=".sl" fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 -$as_echo_n "checking for shl_load in -ldld... " >&6; } -if ${ac_cv_lib_dld_shl_load+:} false; then : - $as_echo_n "(cached) " >&6 + + echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 +echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 +if test "${ac_cv_lib_dld_shl_load+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char shl_load (); int main () { -return shl_load (); +shl_load (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_dld_shl_load=yes else - ac_cv_lib_dld_shl_load=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_dld_shl_load=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 -$as_echo "$ac_cv_lib_dld_shl_load" >&6; } -if test "x$ac_cv_lib_dld_shl_load" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 +echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 +if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi - if test "$tcl_ok" = yes; then : + if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" @@ -5462,7 +7282,8 @@ fi LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi - if test "$GCC" = yes; then : + + if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} @@ -5473,28 +7294,30 @@ else fi + # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = "yes"; then : + if test "$do64bit" = "yes"; then - if test "$GCC" = yes; then : + if test "$GCC" = yes; then case `${CC} -dumpmachine` in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 -$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 +echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} ;; esac @@ -5506,52 +7329,82 @@ else fi -fi ;; + +fi + ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 -$as_echo_n "checking for shl_load in -ldld... " >&6; } -if ${ac_cv_lib_dld_shl_load+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 +echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 +if test "${ac_cv_lib_dld_shl_load+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ char shl_load (); int main () { -return shl_load (); +shl_load (); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 ac_cv_lib_dld_shl_load=yes else - ac_cv_lib_dld_shl_load=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_dld_shl_load=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 -$as_echo "$ac_cv_lib_dld_shl_load" >&6; } -if test "x$ac_cv_lib_dld_shl_load" = xyes; then : +echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 +echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 +if test $ac_cv_lib_dld_shl_load = yes; then tcl_ok=yes else tcl_ok=no fi - if test "$tcl_ok" = yes; then : + if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" @@ -5563,24 +7416,28 @@ fi LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" -fi ;; +fi + ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - case " $LIBOBJS " in + case $LIBOBJS in + "mkstemp.$ac_objext" | \ + *" mkstemp.$ac_objext" | \ + "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" - ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi + ;; IRIX-6.*) SHLIB_CFLAGS="" @@ -5588,18 +7445,21 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - case " $LIBOBJS " in + case $LIBOBJS in + "mkstemp.$ac_objext" | \ + *" mkstemp.$ac_objext" | \ + "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" - ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi - if test "$GCC" = yes; then : + + if test "$GCC" = yes; then CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" @@ -5618,6 +7478,7 @@ else LDFLAGS="$LDFLAGS -n32" fi + ;; IRIX64-6.*) SHLIB_CFLAGS="" @@ -5625,26 +7486,29 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - case " $LIBOBJS " in + case $LIBOBJS in + "mkstemp.$ac_objext" | \ + *" mkstemp.$ac_objext" | \ + "mkstemp.$ac_objext "* | \ *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" - ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi + # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = yes; then : + if test "$do64bit" = yes; then - if test "$GCC" = yes; then : + if test "$GCC" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 -$as_echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported by gcc" >&5 +echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else @@ -5655,7 +7519,9 @@ else fi + fi + ;; Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" @@ -5671,25 +7537,31 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - if test "`uname -m`" = "alpha"; then : + if test "`uname -m`" = "alpha"; then CFLAGS="$CFLAGS -mieee" fi - if test $do64bit = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5 -$as_echo_n "checking if compiler accepts -m64 flag... " >&6; } -if ${tcl_cv_cc_m64+:} false; then : - $as_echo_n "(cached) " >&6 + if test $do64bit = yes; then + + echo "$as_me:$LINENO: checking if compiler accepts -m64 flag" >&5 +echo $ECHO_N "checking if compiler accepts -m64 flag... $ECHO_C" >&6 +if test "${tcl_cv_cc_m64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -5700,35 +7572,62 @@ main () return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_cc_m64=yes else - tcl_cv_cc_m64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_m64=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5 -$as_echo "$tcl_cv_cc_m64" >&6; } - if test $tcl_cv_cc_m64 = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_cc_m64" >&5 +echo "${ECHO_T}$tcl_cv_cc_m64" >&6 + if test $tcl_cv_cc_m64 = yes; then CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi + fi + # The combo of gcc + glibc has a bug related to inlining of # functions like strtod(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. - if test x"${USE_COMPAT}" != x; then : + if test x"${USE_COMPAT}" != x; then CFLAGS="$CFLAGS -fno-inline" fi + ;; Lynx*) SHLIB_CFLAGS="-fPIC" @@ -5738,11 +7637,12 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi + ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" @@ -5781,10 +7681,11 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" @@ -5801,7 +7702,7 @@ fi CFLAGS_OPTIMIZE="-O2" ;; esac - if test "${TCL_THREADS}" = "1"; then : + if test "${TCL_THREADS}" = "1"; then # On OpenBSD: Compile with -pthread # Don't link with -lpthread @@ -5809,6 +7710,7 @@ fi CFLAGS="$CFLAGS -pthread" fi + # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots @@ -5821,12 +7723,13 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - if test "${TCL_THREADS}" = "1"; then : + if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` @@ -5834,6 +7737,7 @@ fi LDFLAGS="$LDFLAGS -pthread" fi + ;; FreeBSD-*) # This configuration from FreeBSD Ports. @@ -5844,18 +7748,20 @@ fi DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi - if test "${TCL_THREADS}" = "1"; then : + + if test "${TCL_THREADS}" = "1"; then # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi + case $system in FreeBSD-3.*) # Version numbers are dot-stripped by system policy. @@ -5878,19 +7784,23 @@ fi CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" - if test $do64bit = yes; then : + if test $do64bit = yes; then case `arch` in ppc) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5 -$as_echo_n "checking if compiler accepts -arch ppc64 flag... " >&6; } -if ${tcl_cv_cc_arch_ppc64+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if compiler accepts -arch ppc64 flag" >&5 +echo $ECHO_N "checking if compiler accepts -arch ppc64 flag... $ECHO_C" >&6 +if test "${tcl_cv_cc_arch_ppc64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -5901,33 +7811,62 @@ main () return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_cc_arch_ppc64=yes else - tcl_cv_cc_arch_ppc64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_arch_ppc64=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 -$as_echo "$tcl_cv_cc_arch_ppc64" >&6; } - if test $tcl_cv_cc_arch_ppc64 = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_ppc64" >&5 +echo "${ECHO_T}$tcl_cv_cc_arch_ppc64" >&6 + if test $tcl_cv_cc_arch_ppc64 = yes; then CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes -fi;; +fi +;; i386) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5 -$as_echo_n "checking if compiler accepts -arch x86_64 flag... " >&6; } -if ${tcl_cv_cc_arch_x86_64+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if compiler accepts -arch x86_64 flag" >&5 +echo $ECHO_N "checking if compiler accepts -arch x86_64 flag... $ECHO_C" >&6 +if test "${tcl_cv_cc_arch_x86_64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -5938,48 +7877,79 @@ main () return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_cc_arch_x86_64=yes else - tcl_cv_cc_arch_x86_64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_arch_x86_64=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5 -$as_echo "$tcl_cv_cc_arch_x86_64" >&6; } - if test $tcl_cv_cc_arch_x86_64 = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_x86_64" >&5 +echo "${ECHO_T}$tcl_cv_cc_arch_x86_64" >&6 + if test $tcl_cv_cc_arch_x86_64 = yes; then CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes -fi;; +fi +;; *) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 -$as_echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; + { echo "$as_me:$LINENO: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 +echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac else # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ - && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then : + && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then fat_32_64=yes fi + fi + SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 -$as_echo_n "checking if ld accepts -single_module flag... " >&6; } -if ${tcl_cv_ld_single_module+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5 +echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6 +if test "${tcl_cv_ld_single_module+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -5990,41 +7960,71 @@ int i; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_ld_single_module=yes else - tcl_cv_ld_single_module=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_ld_single_module=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5 -$as_echo "$tcl_cv_ld_single_module" >&6; } - if test $tcl_cv_ld_single_module = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5 +echo "${ECHO_T}$tcl_cv_ld_single_module" >&6 + if test $tcl_cv_ld_single_module = yes; then SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi + SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" DL_LIBS="" # Don't use -prebind when building for Mac OS X 10.4 or later only: if test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int($2)}'`" -lt 4 -a \ - "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then : + "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then LDFLAGS="$LDFLAGS -prebind" fi + LDFLAGS="$LDFLAGS -headerpad_max_install_names" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5 -$as_echo_n "checking if ld accepts -search_paths_first flag... " >&6; } -if ${tcl_cv_ld_search_paths_first+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5 +echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6 +if test "${tcl_cv_ld_search_paths_first+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -6035,58 +8035,88 @@ int i; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_ld_search_paths_first=yes else - tcl_cv_ld_search_paths_first=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_ld_search_paths_first=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5 -$as_echo "$tcl_cv_ld_search_paths_first" >&6; } - if test $tcl_cv_ld_search_paths_first = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5 +echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 + if test $tcl_cv_ld_search_paths_first = yes; then LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi - if test "$tcl_cv_cc_visibility_hidden" != yes; then : + if test "$tcl_cv_cc_visibility_hidden" != yes; then -$as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h + +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE __private_extern__ +_ACEOF fi + CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" -$as_echo "#define MAC_OSX_TCL 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define MAC_OSX_TCL 1 +_ACEOF PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5 -$as_echo_n "checking whether to use CoreFoundation... " >&6; } - # Check whether --enable-corefoundation was given. -if test "${enable_corefoundation+set}" = set; then : - enableval=$enable_corefoundation; tcl_corefoundation=$enableval + echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5 +echo $ECHO_N "checking whether to use CoreFoundation... $ECHO_C" >&6 + # Check whether --enable-corefoundation or --disable-corefoundation was given. +if test "${enable_corefoundation+set}" = set; then + enableval="$enable_corefoundation" + tcl_corefoundation=$enableval else tcl_corefoundation=yes -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5 -$as_echo "$tcl_corefoundation" >&6; } - if test $tcl_corefoundation = yes; then : +fi; + echo "$as_me:$LINENO: result: $tcl_corefoundation" >&5 +echo "${ECHO_T}$tcl_corefoundation" >&6 + if test $tcl_corefoundation = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CoreFoundation.framework" >&5 -$as_echo_n "checking for CoreFoundation.framework... " >&6; } -if ${tcl_cv_lib_corefoundation+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for CoreFoundation.framework" >&5 +echo $ECHO_N "checking for CoreFoundation.framework... $ECHO_C" >&6 +if test "${tcl_cv_lib_corefoundation+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_libs=$LIBS - if test "$fat_32_64" = yes; then : + if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit @@ -6096,8 +8126,13 @@ else eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done fi + LIBS="$LIBS -framework CoreFoundation" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -6108,45 +8143,77 @@ CFBundleRef b = CFBundleGetMainBundle(); return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_lib_corefoundation=yes else - tcl_cv_lib_corefoundation=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_lib_corefoundation=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test "$fat_32_64" = yes; then : +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi + LIBS=$hold_libs fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5 -$as_echo "$tcl_cv_lib_corefoundation" >&6; } - if test $tcl_cv_lib_corefoundation = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation" >&5 +echo "${ECHO_T}$tcl_cv_lib_corefoundation" >&6 + if test $tcl_cv_lib_corefoundation = yes; then LIBS="$LIBS -framework CoreFoundation" -$as_echo "#define HAVE_COREFOUNDATION 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_COREFOUNDATION 1 +_ACEOF else tcl_corefoundation=no fi - if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit CoreFoundation" >&5 -$as_echo_n "checking for 64-bit CoreFoundation... " >&6; } -if ${tcl_cv_lib_corefoundation_64+:} false; then : - $as_echo_n "(cached) " >&6 + if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then + + echo "$as_me:$LINENO: checking for 64-bit CoreFoundation" >&5 +echo $ECHO_N "checking for 64-bit CoreFoundation... $ECHO_C" >&6 +if test "${tcl_cv_lib_corefoundation_64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -6157,31 +8224,60 @@ CFBundleRef b = CFBundleGetMainBundle(); return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_lib_corefoundation_64=yes else - tcl_cv_lib_corefoundation_64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_lib_corefoundation_64=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5 -$as_echo "$tcl_cv_lib_corefoundation_64" >&6; } - if test $tcl_cv_lib_corefoundation_64 = no; then : +echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation_64" >&5 +echo "${ECHO_T}$tcl_cv_lib_corefoundation_64" >&6 + if test $tcl_cv_lib_corefoundation_64 = no; then -$as_echo "#define NO_COREFOUNDATION_64 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define NO_COREFOUNDATION_64 1 +_ACEOF LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" fi + fi + fi + ;; NEXTSTEP-*) SHLIB_CFLAGS="" @@ -6197,7 +8293,9 @@ fi SHLIB_LD_LIBS="" CFLAGS_OPTIMIZE="" # Optimizer is buggy -$as_echo "#define _OE_SOCKETS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _OE_SOCKETS 1 +_ACEOF ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) @@ -6215,13 +8313,14 @@ $as_echo "#define _OE_SOCKETS 1" >>confdefs.h OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" - if test "$SHARED_BUILD" = 1; then : + if test "$SHARED_BUILD" = 1; then SHLIB_LD="ld -shared" else SHLIB_LD="ld -non_shared" fi + SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -6232,7 +8331,7 @@ fi OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" - if test "$SHARED_BUILD" = 1; then : + if test "$SHARED_BUILD" = 1; then SHLIB_LD='ld -shared -expect_unresolved "*"' @@ -6241,27 +8340,30 @@ else SHLIB_LD='ld -non_shared -expect_unresolved "*"' fi + SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - if test $doRpath = yes; then : + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi - if test "$GCC" = yes; then : + + if test "$GCC" = yes; then CFLAGS="$CFLAGS -mieee" else CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi + # see pthread_intro(3) for pthread support on osf1, k.furukawa - if test "${TCL_THREADS}" = 1; then : + if test "${TCL_THREADS}" = 1; then CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` - if test "$GCC" = yes; then : + if test "$GCC" = yes; then LIBS="$LIBS -lpthread -lmach -lexc" @@ -6272,7 +8374,9 @@ else fi + fi + ;; QNX-6*) # QNX RTP @@ -6291,7 +8395,7 @@ fi # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. - if test "$GCC" = yes; then : + if test "$GCC" = yes; then SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" @@ -6302,6 +8406,7 @@ else LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi + SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" @@ -6346,17 +8451,21 @@ fi # won't define thread-safe library routines. -$as_echo "#define _REENTRANT 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _REENTRANT 1 +_ACEOF -$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _POSIX_PTHREAD_SEMANTICS 1 +_ACEOF SHLIB_CFLAGS="-KPIC" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" - if test "$GCC" = yes; then : + if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' @@ -6369,32 +8478,37 @@ else LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi + ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. -$as_echo "#define _REENTRANT 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _REENTRANT 1 +_ACEOF -$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _POSIX_PTHREAD_SEMANTICS 1 +_ACEOF SHLIB_CFLAGS="-KPIC" # Check to enable 64-bit flags for compiler/linker - if test "$do64bit" = yes; then : + if test "$do64bit" = yes; then arch=`isainfo` - if test "$arch" = "sparcv9 sparc"; then : + if test "$arch" = "sparcv9 sparc"; then - if test "$GCC" = yes; then : + if test "$GCC" = yes; then - if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then : + if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 -$as_echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 +echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} else @@ -6405,10 +8519,11 @@ else fi + else do64bit_ok=yes - if test "$do64bitVIS" = yes; then : + if test "$do64bitVIS" = yes; then CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" @@ -6419,15 +8534,17 @@ else LDFLAGS_ARCH="-xarch=v9" fi + # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi + else - if test "$arch" = "amd64 i386"; then : + if test "$arch" = "amd64 i386"; then - if test "$GCC" = yes; then : + if test "$GCC" = yes; then case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) @@ -6435,8 +8552,8 @@ else CFLAGS="$CFLAGS -m64" LDFLAGS="$LDFLAGS -m64";; *) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 -$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 +echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac else @@ -6453,32 +8570,169 @@ else fi + else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 -$as_echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported for $arch" >&5 +echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} fi + fi + fi + #-------------------------------------------------------------------- # On Solaris 5.x i386 with the sunpro compiler we need to link # with sunmath to get floating point rounding control #-------------------------------------------------------------------- - if test "$GCC" = yes; then : + if test "$GCC" = yes; then use_sunmath=no else arch=`isainfo` - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -lsunmath for fp rounding control" >&5 -$as_echo_n "checking whether to use -lsunmath for fp rounding control... " >&6; } - if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then : + echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 +echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 + if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 MATH_LIBS="-lsunmath $MATH_LIBS" - ac_fn_c_check_header_mongrel "$LINENO" "sunmath.h" "ac_cv_header_sunmath_h" "$ac_includes_default" -if test "x$ac_cv_header_sunmath_h" = xyes; then : + if test "${ac_cv_header_sunmath_h+set}" = set; then + echo "$as_me:$LINENO: checking for sunmath.h" >&5 +echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 +if test "${ac_cv_header_sunmath_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 +echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking sunmath.h usability" >&5 +echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking sunmath.h presence" >&5 +echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for sunmath.h" >&5 +echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 +if test "${ac_cv_header_sunmath_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_sunmath_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 +echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 fi @@ -6487,24 +8741,26 @@ fi else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 use_sunmath=no fi + fi + SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" - if test "$GCC" = yes; then : + if test "$GCC" = yes; then SHLIB_LD='${CC} -shared' CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - if test "$do64bit_ok" = yes; then : + if test "$do64bit_ok" = yes; then - if test "$arch" = "sparcv9 sparc"; then : + if test "$arch" = "sparcv9 sparc"; then # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. @@ -6515,22 +8771,26 @@ fi #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" else - if test "$arch" = "amd64 i386"; then : + if test "$arch" = "amd64 i386"; then SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" fi + fi + fi + else - if test "$use_sunmath" = yes; then : + if test "$use_sunmath" = yes; then textmode=textoff else textmode=text fi + case $system in SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; @@ -6541,6 +8801,7 @@ fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' fi + ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" @@ -6551,15 +8812,19 @@ fi DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5 -$as_echo_n "checking for ld accepts -Bexport flag... " >&6; } -if ${tcl_cv_ld_Bexport+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for ld accepts -Bexport flag" >&5 +echo $ECHO_N "checking for ld accepts -Bexport flag... $ECHO_C" >&6 +if test "${tcl_cv_ld_Bexport+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -6570,63 +8835,93 @@ int i; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_ld_Bexport=yes else - tcl_cv_ld_Bexport=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_ld_Bexport=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext LDFLAGS=$hold_ldflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 -$as_echo "$tcl_cv_ld_Bexport" >&6; } - if test $tcl_cv_ld_Bexport = yes; then : +echo "$as_me:$LINENO: result: $tcl_cv_ld_Bexport" >&5 +echo "${ECHO_T}$tcl_cv_ld_Bexport" >&6 + if test $tcl_cv_ld_Bexport = yes; then LDFLAGS="$LDFLAGS -Wl,-Bexport" fi + CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac - if test "$do64bit" = yes -a "$do64bit_ok" = no; then : + if test "$do64bit" = yes -a "$do64bit_ok" = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 -$as_echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} + { echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 +echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} fi - if test "$do64bit" = yes -a "$do64bit_ok" = yes; then : + if test "$do64bit" = yes -a "$do64bit_ok" = yes; then -$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h + +cat >>confdefs.h <<\_ACEOF +#define TCL_CFG_DO64BIT 1 +_ACEOF fi + # Step 4: disable dynamic loading if requested via a command-line switch. - # Check whether --enable-load was given. -if test "${enable_load+set}" = set; then : - enableval=$enable_load; tcl_ok=$enableval + # Check whether --enable-load or --disable-load was given. +if test "${enable_load+set}" = set; then + enableval="$enable_load" + tcl_ok=$enableval else tcl_ok=yes -fi - - if test "$tcl_ok" = no; then : +fi; + if test "$tcl_ok" = no; then DL_OBJS="" fi - if test "x$DL_OBJS" != x; then : + + if test "x$DL_OBJS" != x; then BUILD_DLTEST="\$(DLTEST_TARGETS)" else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 -$as_echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} + { echo "$as_me:$LINENO: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 +echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" @@ -6638,13 +8933,14 @@ $as_echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared BUILD_DLTEST="" fi + LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. - if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then : + if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then case $system in AIX-*) ;; @@ -6658,29 +8954,35 @@ fi esac fi - if test "$tcl_cv_cc_visibility_hidden" != yes; then : + + if test "$tcl_cv_cc_visibility_hidden" != yes; then -$as_echo "#define MODULE_SCOPE extern" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE extern +_ACEOF fi - if test "$SHARED_LIB_SUFFIX" = ""; then : + + if test "$SHARED_LIB_SUFFIX" = ""; then SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' fi - if test "$UNSHARED_LIB_SUFFIX" = ""; then : + + if test "$UNSHARED_LIB_SUFFIX" = ""; then UNSHARED_LIB_SUFFIX='${VERSION}.a' fi + DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" - if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then : + 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}' - if test "${SHLIB_SUFFIX}" = ".dll"; then : + if test "${SHLIB_SUFFIX}" = ".dll"; then INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" @@ -6691,11 +8993,12 @@ else fi + else LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} - if test "$RANLIB" = ""; then : + if test "$RANLIB" = ""; then MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' @@ -6707,22 +9010,12 @@ else fi -fi - - if test "$RANLIB" = ""; then : - - MAKE_KIT_LIB='$(STLIB_LD) $@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS}' - INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)"' - -else - - MAKE_KIT_LIB='${STLIB_LD} $@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} ; ${RANLIB} $@' - INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(TCL_KIT_LIB_FILE))' fi + # Stub lib does not depend on shared/static configuration - if test "$RANLIB" = ""; then : + if test "$RANLIB" = ""; then MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' @@ -6734,25 +9027,31 @@ else fi + # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if # it is already set when tclConfig.sh had been loaded by Tk. - if test "x${TCL_LIBS}" = x; then : + if test "x${TCL_LIBS}" = x; then TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}" fi + # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 -$as_echo_n "checking for cast to union support... " >&6; } -if ${tcl_cv_cast_to_union+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for cast to union support" >&5 +echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 +if test "${tcl_cv_cast_to_union+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -6766,19 +9065,45 @@ main () return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_cast_to_union=yes else - tcl_cv_cast_to_union=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cast_to_union=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 -$as_echo "$tcl_cv_cast_to_union" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 +echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 if test "$tcl_cv_cast_to_union" = "yes"; then -$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_CAST_TO_UNION 1 +_ACEOF fi @@ -6824,36 +9149,38 @@ _ACEOF - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 -$as_echo_n "checking for build with symbols... " >&6; } - # Check whether --enable-symbols was given. -if test "${enable_symbols+set}" = set; then : - enableval=$enable_symbols; tcl_ok=$enableval + 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. +if test "${enable_symbols+set}" = set; then + enableval="$enable_symbols" + tcl_ok=$enableval else tcl_ok=no -fi - +fi; # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. DBGX="" if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' -$as_echo "#define NDEBUG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define NDEBUG 1 +_ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 -$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_CFG_OPTIMIZED 1 +_ACEOF else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' if test "$tcl_ok" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 -$as_echo "yes (standard debugging)" >&6; } + echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 +echo "${ECHO_T}yes (standard debugging)" >&6 fi fi @@ -6861,35 +9188,45 @@ $as_echo "yes (standard debugging)" >&6; } if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then -$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_MEM_DEBUG 1 +_ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then -$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_COMPILE_DEBUG 1 +_ACEOF -$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_COMPILE_STATS 1 +_ACEOF fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5 -$as_echo "enabled symbols mem compile debugging" >&6; } + echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 +echo "${ECHO_T}enabled symbols mem compile debugging" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 -$as_echo "enabled $tcl_ok debugging" >&6; } + echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 +echo "${ECHO_T}enabled $tcl_ok debugging" >&6 fi fi -$as_echo "#define TCL_TOMMATH 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_TOMMATH 1 +_ACEOF -$as_echo "#define MP_PREC 4" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define MP_PREC 4 +_ACEOF #-------------------------------------------------------------------- @@ -6897,14 +9234,18 @@ $as_echo "#define MP_PREC 4" >>confdefs.h #-------------------------------------------------------------------- - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5 -$as_echo_n "checking for required early compiler flags... " >&6; } + echo "$as_me:$LINENO: checking for required early compiler flags" >&5 +echo $ECHO_N "checking for required early compiler flags... $ECHO_C" >&6 tcl_flags="" - if ${tcl_cv_flag__isoc99_source+:} false; then : - $as_echo_n "(cached) " >&6 + if test "${tcl_cv_flag__isoc99_source+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -6915,10 +9256,38 @@ char *p = (char *)strtoll; char *q = (char *)strtoull; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_flag__isoc99_source=no else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include @@ -6930,28 +9299,58 @@ char *p = (char *)strtoll; char *q = (char *)strtoull; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_flag__isoc99_source=yes else - tcl_cv_flag__isoc99_source=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_flag__isoc99_source=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then -$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _ISOC99_SOURCE 1 +_ACEOF tcl_flags="$tcl_flags _ISOC99_SOURCE" fi - if ${tcl_cv_flag__largefile64_source+:} false; then : - $as_echo_n "(cached) " >&6 + if test "${tcl_cv_flag__largefile64_source+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -6962,10 +9361,38 @@ struct stat64 buf; int i = stat64("/", &buf); return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_flag__largefile64_source=no else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include @@ -6977,28 +9404,58 @@ struct stat64 buf; int i = stat64("/", &buf); return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_flag__largefile64_source=yes else - tcl_cv_flag__largefile64_source=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_flag__largefile64_source=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then -$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _LARGEFILE64_SOURCE 1 +_ACEOF tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" fi - if ${tcl_cv_flag__largefile_source64+:} false; then : - $as_echo_n "(cached) " >&6 + if test "${tcl_cv_flag__largefile_source64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -7009,10 +9466,38 @@ char *p = (char *)open64; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_flag__largefile_source64=no else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #define _LARGEFILE_SOURCE64 1 #include @@ -7024,42 +9509,72 @@ char *p = (char *)open64; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_flag__largefile_source64=yes else - tcl_cv_flag__largefile_source64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_flag__largefile_source64=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then -$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _LARGEFILE_SOURCE64 1 +_ACEOF tcl_flags="$tcl_flags _LARGEFILE_SOURCE64" fi if test "x${tcl_flags}" = "x" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 -$as_echo "none" >&6; } + echo "$as_me:$LINENO: result: none" >&5 +echo "${ECHO_T}none" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5 -$as_echo "${tcl_flags}" >&6; } + echo "$as_me:$LINENO: result: ${tcl_flags}" >&5 +echo "${ECHO_T}${tcl_flags}" >&6 fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5 -$as_echo_n "checking for 64-bit integer type... " >&6; } - if ${tcl_cv_type_64bit+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for 64-bit integer type" >&5 +echo $ECHO_N "checking for 64-bit integer type... $ECHO_C" >&6 + if test "${tcl_cv_type_64bit+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -7070,16 +9585,44 @@ __int64 value = (__int64) 0; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_type_64bit=__int64 else - tcl_type_64bit="long long" + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_type_64bit="long long" fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -7092,35 +9635,66 @@ switch (0) { return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_type_64bit=${tcl_type_64bit} +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then -$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_WIDE_INT_IS_LONG 1 +_ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5 -$as_echo "using long" >&6; } + echo "$as_me:$LINENO: result: using long" >&5 +echo "${ECHO_T}using long" >&6 else cat >>confdefs.h <<_ACEOF #define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} _ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5 -$as_echo "${tcl_cv_type_64bit}" >&6; } + echo "$as_me:$LINENO: result: ${tcl_cv_type_64bit}" >&5 +echo "${ECHO_T}${tcl_cv_type_64bit}" >&6 # Now check for auxiliary declarations - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 -$as_echo_n "checking for struct dirent64... " >&6; } -if ${tcl_cv_struct_dirent64+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for struct dirent64" >&5 +echo $ECHO_N "checking for struct dirent64... $ECHO_C" >&6 +if test "${tcl_cv_struct_dirent64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include @@ -7132,28 +9706,58 @@ struct dirent64 p; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_struct_dirent64=yes else - tcl_cv_struct_dirent64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_struct_dirent64=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 -$as_echo "$tcl_cv_struct_dirent64" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_struct_dirent64" >&5 +echo "${ECHO_T}$tcl_cv_struct_dirent64" >&6 if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then -$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_STRUCT_DIRENT64 1 +_ACEOF fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 -$as_echo_n "checking for struct stat64... " >&6; } -if ${tcl_cv_struct_stat64+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for struct stat64" >&5 +echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6 +if test "${tcl_cv_struct_stat64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -7165,40 +9769,161 @@ struct stat64 p; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_struct_stat64=yes else - tcl_cv_struct_stat64=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_struct_stat64=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5 -$as_echo "$tcl_cv_struct_stat64" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_struct_stat64" >&5 +echo "${ECHO_T}$tcl_cv_struct_stat64" >&6 if test "x${tcl_cv_struct_stat64}" = "xyes" ; then -$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_STRUCT_STAT64 1 +_ACEOF fi - for ac_func in open64 lseek64 -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + + +for ac_func in open64 lseek64 +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + 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 + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5 -$as_echo_n "checking for off64_t... " >&6; } - if ${tcl_cv_type_off64_t+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for off64_t" >&5 +echo $ECHO_N "checking for off64_t... $ECHO_C" >&6 + if test "${tcl_cv_type_off64_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include int @@ -7210,25 +9935,51 @@ off64_t offset; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_type_off64_t=yes else - tcl_cv_type_off64_t=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_type_off64_t=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then -$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_TYPE_OFF64_T 1 +_ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi fi @@ -7238,229 +9989,235 @@ $as_echo "no" >&6; } # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 -$as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if ${ac_cv_c_bigendian+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 +echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 +if test "${ac_cv_c_bigendian+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - ac_cv_c_bigendian=unknown - # See if we're dealing with a universal compiler. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifndef __APPLE_CC__ - not a universal capable compiler - #endif - typedef int dummy; - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - - # Check for potential -arch flags. It is not universal unless - # there are at least two -arch flags with different values. - ac_arch= - ac_prev= - for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do - if test -n "$ac_prev"; then - case $ac_word in - i?86 | x86_64 | ppc | ppc64) - if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then - ac_arch=$ac_word - else - ac_cv_c_bigendian=universal - break - fi - ;; - esac - ac_prev= - elif test "x$ac_word" = "x-arch"; then - ac_prev=arch - fi - done -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $ac_cv_c_bigendian = unknown; then - # See if sys/param.h defines the BYTE_ORDER macro. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + # See if sys/param.h defines the BYTE_ORDER macro. +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include - #include +#include int main () { -#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ - && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ - && LITTLE_ENDIAN) - bogus endian macros - #endif +#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN + bogus endian macros +#endif ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 # It does; now see whether it defined to BIG_ENDIAN or not. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include - #include +#include int main () { #if BYTE_ORDER != BIG_ENDIAN - not big endian - #endif + not big endian +#endif ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_bigendian=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_c_bigendian=yes else - ac_cv_c_bigendian=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -int -main () -{ -#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) - bogus endian macros - #endif +ac_cv_c_bigendian=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - ; - return 0; -} +# It does not; compile a test program. +if test "$cross_compiling" = yes; then + # try to guess the endianness by grepping values into an object file + ac_cv_c_bigendian=unknown + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - # It does; now see whether it defined to _BIG_ENDIAN or not. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include - +short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; +short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; +void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } +short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; +short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; +void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } int main () { -#ifndef _BIG_ENDIAN - not big endian - #endif - + _ascii (); _ebcdic (); ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes -else - ac_cv_c_bigendian=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # Compile a test program. - if test "$cross_compiling" = yes; then : - # Try to guess by grepping values from an object file. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -short int ascii_mm[] = - { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; - short int ascii_ii[] = - { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; - int use_ascii (int i) { - return ascii_mm[i] + ascii_ii[i]; - } - short int ebcdic_ii[] = - { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; - short int ebcdic_mm[] = - { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; - int use_ebcdic (int i) { - return ebcdic_mm[i] + ebcdic_ii[i]; - } - extern int foo; +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -int -main () -{ -return use_ascii (foo) == use_ebcdic (foo); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then - ac_cv_c_bigendian=yes - fi - if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then - if test "$ac_cv_c_bigendian" = unknown; then - ac_cv_c_bigendian=no - else - # finding both strings is unlikely to happen, but who knows? - ac_cv_c_bigendian=unknown - fi - fi fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -$ac_includes_default int main () { - - /* Are we little or big endian? From Harbison&Steele. */ - union - { - long int l; - char c[sizeof (long int)]; - } u; - u.l = 1; - return u.c[sizeof (long int) - 1] == 1; - - ; - return 0; + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long l; + char c[sizeof (long)]; + } u; + u.l = 1; + exit (u.c[sizeof (long) - 1] == 1); } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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 ac_cv_c_bigendian=no else - ac_cv_c_bigendian=yes + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +ac_cv_c_bigendian=yes fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi - - fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 -$as_echo "$ac_cv_c_bigendian" >&6; } - case $ac_cv_c_bigendian in #( - yes) - $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h -;; #( - no) - ;; #( - universal) - -$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 +echo "${ECHO_T}$ac_cv_c_bigendian" >&6 +case $ac_cv_c_bigendian in + yes) - ;; #( - *) - as_fn_error $? "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; - esac +cat >>confdefs.h <<\_ACEOF +#define WORDS_BIGENDIAN 1 +_ACEOF + ;; + no) + ;; + *) + { { echo "$as_me:$LINENO: error: unknown endianness +presetting ac_cv_c_bigendian=no (or yes) will help" >&5 +echo "$as_me: error: unknown endianness +presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} + { (exit 1); exit 1; }; } ;; +esac #-------------------------------------------------------------------- @@ -7469,2361 +10226,7837 @@ $as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h #-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. + for ac_func in getcwd -do : - ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd" -if test "x$ac_cv_func_getcwd" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETCWD 1 +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func -else - -$as_echo "#define USEGETWD 1" >>confdefs.h +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -fi -done +#ifdef __STDC__ +# include +#else +# include +#endif -# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really -# define USEGETWD even if the posix getcwd exists. Add a test ? +#undef $ac_func -ac_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp" -if test "x$ac_cv_func_mkstemp" = xyes; then : - $as_echo "#define HAVE_MKSTEMP 1" >>confdefs.h +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif +int +main () +{ +return f != $ac_func; + ; + 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 + eval "$as_ac_var=yes" else - case " $LIBOBJS " in - *" mkstemp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" - ;; -esac + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +eval "$as_ac_var=no" fi - -ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir" -if test "x$ac_cv_func_opendir" = xyes; then : - $as_echo "#define HAVE_OPENDIR 1" >>confdefs.h - -else - case " $LIBOBJS " in - *" opendir.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS opendir.$ac_objext" - ;; -esac - +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi - -ac_fn_c_check_func "$LINENO" "strtol" "ac_cv_func_strtol" -if test "x$ac_cv_func_strtol" = xyes; then : - $as_echo "#define HAVE_STRTOL 1" >>confdefs.h +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF else - case " $LIBOBJS " in - *" strtol.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strtol.$ac_objext" - ;; -esac + +cat >>confdefs.h <<\_ACEOF +#define USEGETWD 1 +_ACEOF fi +done -ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid" -if test "x$ac_cv_func_waitpid" = xyes; then : - $as_echo "#define HAVE_WAITPID 1" >>confdefs.h +# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really +# define USEGETWD even if the posix getcwd exists. Add a test ? -else - case " $LIBOBJS " in - *" waitpid.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS waitpid.$ac_objext" - ;; -esac -fi -ac_fn_c_check_func "$LINENO" "strerror" "ac_cv_func_strerror" -if test "x$ac_cv_func_strerror" = xyes; then : -else +for ac_func in mkstemp opendir strtol waitpid +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func -$as_echo "#define NO_STRERROR 1" >>confdefs.h +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -fi +#ifdef __STDC__ +# include +#else +# include +#endif -ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" -if test "x$ac_cv_func_getwd" = xyes; then : +#undef $ac_func -else +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif -$as_echo "#define NO_GETWD 1" >>confdefs.h +int +main () +{ +return f != $ac_func; + ; + 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 + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +eval "$as_ac_var=no" fi - -ac_fn_c_check_func "$LINENO" "wait3" "ac_cv_func_wait3" -if test "x$ac_cv_func_wait3" = xyes; then : +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF else - -$as_echo "#define NO_WAIT3 1" >>confdefs.h + case $LIBOBJS in + "$ac_func.$ac_objext" | \ + *" $ac_func.$ac_objext" | \ + "$ac_func.$ac_objext "* | \ + *" $ac_func.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS $ac_func.$ac_objext" ;; +esac fi +done -ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname" -if test "x$ac_cv_func_uname" = xyes; then : +echo "$as_me:$LINENO: checking for strerror" >&5 +echo $ECHO_N "checking for strerror... $ECHO_C" >&6 +if test "${ac_cv_func_strerror+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. */ +/* Define strerror to an innocuous variant, in case declares strerror. + For example, HP-UX 11i declares gettimeofday. */ +#define strerror innocuous_strerror -$as_echo "#define NO_UNAME 1" >>confdefs.h +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strerror (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -fi +#ifdef __STDC__ +# include +#else +# include +#endif +#undef strerror -if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ - test "`uname -r | awk -F. '{print $1}'`" -lt 7; then - # prior to Darwin 7, realpath is not threadsafe, so don't - # use it when threads are enabled, c.f. bug # 711232 - ac_cv_func_realpath=no -fi -ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath" -if test "x$ac_cv_func_realpath" = xyes; then : +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strerror (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strerror) || defined (__stub___strerror) +choke me +#else +char (*f) () = strerror; +#endif +#ifdef __cplusplus +} +#endif +int +main () +{ +return f != strerror; + ; + 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 + ac_cv_func_strerror=yes else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -$as_echo "#define NO_REALPATH 1" >>confdefs.h - +ac_cv_func_strerror=no fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_strerror" >&5 +echo "${ECHO_T}$ac_cv_func_strerror" >&6 +if test $ac_cv_func_strerror = yes; then + : +else - - - NEED_FAKE_RFC2553=0 - for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +cat >>confdefs.h <<\_ACEOF +#define NO_STRERROR 1 _ACEOF -else - NEED_FAKE_RFC2553=1 fi -done - ac_fn_c_check_type "$LINENO" "struct addrinfo" "ac_cv_type_struct_addrinfo" " -#include -#include -#include -#include +echo "$as_me:$LINENO: checking for getwd" >&5 +echo $ECHO_N "checking for getwd... $ECHO_C" >&6 +if test "${ac_cv_func_getwd+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. */ +/* Define getwd to an innocuous variant, in case declares getwd. + For example, HP-UX 11i declares gettimeofday. */ +#define getwd innocuous_getwd -" -if test "x$ac_cv_type_struct_addrinfo" = xyes; then : +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char getwd (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_ADDRINFO 1 -_ACEOF +#ifdef __STDC__ +# include +#else +# include +#endif +#undef getwd -else - NEED_FAKE_RFC2553=1 -fi -ac_fn_c_check_type "$LINENO" "struct in6_addr" "ac_cv_type_struct_in6_addr" " -#include -#include -#include -#include - -" -if test "x$ac_cv_type_struct_in6_addr" = xyes; then : +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char getwd (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_getwd) || defined (__stub___getwd) +choke me +#else +char (*f) () = getwd; +#endif +#ifdef __cplusplus +} +#endif -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IN6_ADDR 1 +int +main () +{ +return f != getwd; + ; + 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 + ac_cv_func_getwd=yes else - NEED_FAKE_RFC2553=1 -fi -ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" " -#include -#include -#include -#include - -" -if test "x$ac_cv_type_struct_sockaddr_in6" = xyes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_SOCKADDR_IN6 1 -_ACEOF - + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -else - NEED_FAKE_RFC2553=1 +ac_cv_func_getwd=no fi -ac_fn_c_check_type "$LINENO" "struct sockaddr_storage" "ac_cv_type_struct_sockaddr_storage" " -#include -#include -#include -#include - -" -if test "x$ac_cv_type_struct_sockaddr_storage" = xyes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_SOCKADDR_STORAGE 1 -_ACEOF - - -else - NEED_FAKE_RFC2553=1 +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi +echo "$as_me:$LINENO: result: $ac_cv_func_getwd" >&5 +echo "${ECHO_T}$ac_cv_func_getwd" >&6 +if test $ac_cv_func_getwd = yes; then + : +else -if test "x$NEED_FAKE_RFC2553" = "x1"; then - -$as_echo "#define NEED_FAKE_RFC2553 1" >>confdefs.h - - case " $LIBOBJS " in - *" fake-rfc2553.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" - ;; -esac - - ac_fn_c_check_func "$LINENO" "strlcpy" "ac_cv_func_strlcpy" -if test "x$ac_cv_func_strlcpy" = xyes; then : - -fi +cat >>confdefs.h <<\_ACEOF +#define NO_GETWD 1 +_ACEOF fi +echo "$as_me:$LINENO: checking for wait3" >&5 +echo $ECHO_N "checking for wait3... $ECHO_C" >&6 +if test "${ac_cv_func_wait3+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. */ +/* Define wait3 to an innocuous variant, in case declares wait3. + For example, HP-UX 11i declares gettimeofday. */ +#define wait3 innocuous_wait3 -#-------------------------------------------------------------------- -# Look for thread-safe variants of some library functions. -#-------------------------------------------------------------------- - -if test "${TCL_THREADS}" = 1; then - ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r" -if test "x$ac_cv_func_getpwuid_r" = xyes; then : +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char wait3 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5 -$as_echo_n "checking for getpwuid_r with 5 args... " >&6; } -if ${tcl_cv_api_getpwuid_r_5+:} false; then : - $as_echo_n "(cached) " >&6 -else +#ifdef __STDC__ +# include +#else +# include +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +#undef wait3 - #include - #include +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char wait3 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_wait3) || defined (__stub___wait3) +choke me +#else +char (*f) () = wait3; +#endif +#ifdef __cplusplus +} +#endif int main () { - - uid_t uid; - struct passwd pw, *pwp; - char buf[512]; - int buflen = 512; - - (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); - +return f != wait3; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getpwuid_r_5=yes +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 + ac_cv_func_wait3=yes else - tcl_cv_api_getpwuid_r_5=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_wait3=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_5" >&5 -$as_echo "$tcl_cv_api_getpwuid_r_5" >&6; } - tcl_ok=$tcl_cv_api_getpwuid_r_5 - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_func_wait3" >&5 +echo "${ECHO_T}$ac_cv_func_wait3" >&6 +if test $ac_cv_func_wait3 = yes; then + : +else + +cat >>confdefs.h <<\_ACEOF +#define NO_WAIT3 1 +_ACEOF -$as_echo "#define HAVE_GETPWUID_R_5 1" >>confdefs.h +fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 4 args" >&5 -$as_echo_n "checking for getpwuid_r with 4 args... " >&6; } -if ${tcl_cv_api_getpwuid_r_4+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for uname" >&5 +echo $ECHO_N "checking for uname... $ECHO_C" >&6 +if test "${ac_cv_func_uname+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +/* Define uname to an innocuous variant, in case declares uname. + For example, HP-UX 11i declares gettimeofday. */ +#define uname innocuous_uname - #include - #include +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char uname (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -int -main () -{ +#ifdef __STDC__ +# include +#else +# include +#endif - uid_t uid; - struct passwd pw; - char buf[512]; - int buflen = 512; +#undef uname - (void)getpwnam_r(uid, &pw, buf, buflen); +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char uname (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_uname) || defined (__stub___uname) +choke me +#else +char (*f) () = uname; +#endif +#ifdef __cplusplus +} +#endif +int +main () +{ +return f != uname; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getpwuid_r_4=yes +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 + ac_cv_func_uname=yes else - tcl_cv_api_getpwuid_r_4=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_uname=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_4" >&5 -$as_echo "$tcl_cv_api_getpwuid_r_4" >&6; } - tcl_ok=$tcl_cv_api_getpwuid_r_4 - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETPWUID_R_4 1" >>confdefs.h +echo "$as_me:$LINENO: result: $ac_cv_func_uname" >&5 +echo "${ECHO_T}$ac_cv_func_uname" >&6 +if test $ac_cv_func_uname = yes; then + : +else - fi - fi - if test "$tcl_ok" = yes; then +cat >>confdefs.h <<\_ACEOF +#define NO_UNAME 1 +_ACEOF -$as_echo "#define HAVE_GETPWUID_R 1" >>confdefs.h +fi - fi +if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ + test "`uname -r | awk -F. '{print $1}'`" -lt 7; then + # prior to Darwin 7, realpath is not threadsafe, so don't + # use it when threads are enabled, c.f. bug # 711232 + ac_cv_func_realpath=no fi +echo "$as_me:$LINENO: checking for realpath" >&5 +echo $ECHO_N "checking for realpath... $ECHO_C" >&6 +if test "${ac_cv_func_realpath+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. */ +/* Define realpath to an innocuous variant, in case declares realpath. + For example, HP-UX 11i declares gettimeofday. */ +#define realpath innocuous_realpath - ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r" -if test "x$ac_cv_func_getpwnam_r" = xyes; then : +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char realpath (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5 -$as_echo_n "checking for getpwnam_r with 5 args... " >&6; } -if ${tcl_cv_api_getpwnam_r_5+:} false; then : - $as_echo_n "(cached) " >&6 -else +#ifdef __STDC__ +# include +#else +# include +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +#undef realpath - #include - #include +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char realpath (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_realpath) || defined (__stub___realpath) +choke me +#else +char (*f) () = realpath; +#endif +#ifdef __cplusplus +} +#endif int main () { - - char *name; - struct passwd pw, *pwp; - char buf[512]; - int buflen = 512; - - (void) getpwnam_r(name, &pw, buf, buflen, &pwp); - +return f != realpath; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getpwnam_r_5=yes +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 + ac_cv_func_realpath=yes else - tcl_cv_api_getpwnam_r_5=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_realpath=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_5" >&5 -$as_echo "$tcl_cv_api_getpwnam_r_5" >&6; } - tcl_ok=$tcl_cv_api_getpwnam_r_5 - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_func_realpath" >&5 +echo "${ECHO_T}$ac_cv_func_realpath" >&6 +if test $ac_cv_func_realpath = yes; then + : +else -$as_echo "#define HAVE_GETPWNAM_R_5 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define NO_REALPATH 1 +_ACEOF - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 4 args" >&5 -$as_echo_n "checking for getpwnam_r with 4 args... " >&6; } -if ${tcl_cv_api_getpwnam_r_4+:} false; then : - $as_echo_n "(cached) " >&6 -else +fi - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - #include - #include -int -main () -{ + NEED_FAKE_RFC2553=0 - char *name; - struct passwd pw; - char buf[512]; - int buflen = 512; - (void)getpwnam_r(name, &pw, buf, buflen); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getpwnam_r_4=yes -else - tcl_cv_api_getpwnam_r_4=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_4" >&5 -$as_echo "$tcl_cv_api_getpwnam_r_4" >&6; } - tcl_ok=$tcl_cv_api_getpwnam_r_4 - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETPWNAM_R_4 1" >>confdefs.h - - fi - fi - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETPWNAM_R 1" >>confdefs.h - - fi -fi +for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func - ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r" -if test "x$ac_cv_func_getgrgid_r" = xyes; then : +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5 -$as_echo_n "checking for getgrgid_r with 5 args... " >&6; } -if ${tcl_cv_api_getgrgid_r_5+:} false; then : - $as_echo_n "(cached) " >&6 -else +#ifdef __STDC__ +# include +#else +# include +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +#undef $ac_func - #include - #include +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif int main () { - - gid_t gid; - struct group gr, *grp; - char buf[512]; - int buflen = 512; - - (void) getgrgid_r(gid, &gr, buf, buflen, &grp); - +return f != $ac_func; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getgrgid_r_5=yes +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 + eval "$as_ac_var=yes" else - tcl_cv_api_getgrgid_r_5=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_5" >&5 -$as_echo "$tcl_cv_api_getgrgid_r_5" >&6; } - tcl_ok=$tcl_cv_api_getgrgid_r_5 - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETGRGID_R_5 1" >>confdefs.h +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 4 args" >&5 -$as_echo_n "checking for getgrgid_r with 4 args... " >&6; } -if ${tcl_cv_api_getgrgid_r_4+:} false; then : - $as_echo_n "(cached) " >&6 else + NEED_FAKE_RFC2553=1 +fi +done - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + echo "$as_me:$LINENO: checking for struct addrinfo" >&5 +echo $ECHO_N "checking for struct addrinfo... $ECHO_C" >&6 +if test "${ac_cv_type_struct_addrinfo+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. */ - #include - #include +#include +#include +#include +#include + int main () { - - gid_t gid; - struct group gr; - char buf[512]; - int buflen = 512; - - (void)getgrgid_r(gid, &gr, buf, buflen); - +if ((struct addrinfo *) 0) + return 0; +if (sizeof (struct addrinfo)) + return 0; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getgrgid_r_4=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_struct_addrinfo=yes else - tcl_cv_api_getgrgid_r_4=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_struct_addrinfo=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_4" >&5 -$as_echo "$tcl_cv_api_getgrgid_r_4" >&6; } - tcl_ok=$tcl_cv_api_getgrgid_r_4 - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETGRGID_R_4 1" >>confdefs.h - - fi - fi - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_type_struct_addrinfo" >&5 +echo "${ECHO_T}$ac_cv_type_struct_addrinfo" >&6 +if test $ac_cv_type_struct_addrinfo = yes; then -$as_echo "#define HAVE_GETGRGID_R 1" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_ADDRINFO 1 +_ACEOF - fi +else + NEED_FAKE_RFC2553=1 fi - - ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r" -if test "x$ac_cv_func_getgrnam_r" = xyes; then : - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5 -$as_echo_n "checking for getgrnam_r with 5 args... " >&6; } -if ${tcl_cv_api_getgrnam_r_5+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for struct in6_addr" >&5 +echo $ECHO_N "checking for struct in6_addr... $ECHO_C" >&6 +if test "${ac_cv_type_struct_in6_addr+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #include - #include +#include +#include +#include +#include + int main () { - - char *name; - struct group gr, *grp; - char buf[512]; - int buflen = 512; - - (void) getgrnam_r(name, &gr, buf, buflen, &grp); - +if ((struct in6_addr *) 0) + return 0; +if (sizeof (struct in6_addr)) + return 0; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getgrnam_r_5=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_struct_in6_addr=yes else - tcl_cv_api_getgrnam_r_5=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_struct_in6_addr=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_5" >&5 -$as_echo "$tcl_cv_api_getgrnam_r_5" >&6; } - tcl_ok=$tcl_cv_api_getgrnam_r_5 - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_type_struct_in6_addr" >&5 +echo "${ECHO_T}$ac_cv_type_struct_in6_addr" >&6 +if test $ac_cv_type_struct_in6_addr = yes; then + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_IN6_ADDR 1 +_ACEOF -$as_echo "#define HAVE_GETGRNAM_R_5 1" >>confdefs.h - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 4 args" >&5 -$as_echo_n "checking for getgrnam_r with 4 args... " >&6; } -if ${tcl_cv_api_getgrnam_r_4+:} false; then : - $as_echo_n "(cached) " >&6 else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + NEED_FAKE_RFC2553=1 +fi +echo "$as_me:$LINENO: checking for struct sockaddr_in6" >&5 +echo $ECHO_N "checking for struct sockaddr_in6... $ECHO_C" >&6 +if test "${ac_cv_type_struct_sockaddr_in6+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. */ - #include - #include +#include +#include +#include +#include + int main () { - - char *name; - struct group gr; - char buf[512]; - int buflen = 512; - - (void)getgrnam_r(name, &gr, buf, buflen); - +if ((struct sockaddr_in6 *) 0) + return 0; +if (sizeof (struct sockaddr_in6)) + return 0; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_getgrnam_r_4=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_struct_sockaddr_in6=yes else - tcl_cv_api_getgrnam_r_4=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_struct_sockaddr_in6=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_4" >&5 -$as_echo "$tcl_cv_api_getgrnam_r_4" >&6; } - tcl_ok=$tcl_cv_api_getgrnam_r_4 - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETGRNAM_R_4 1" >>confdefs.h - - fi - fi - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_in6" >&5 +echo "${ECHO_T}$ac_cv_type_struct_sockaddr_in6" >&6 +if test $ac_cv_type_struct_sockaddr_in6 = yes; then -$as_echo "#define HAVE_GETGRNAM_R 1" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_SOCKADDR_IN6 1 +_ACEOF - fi +else + NEED_FAKE_RFC2553=1 fi - - if test "`uname -s`" = "Darwin" && \ - test "`uname -r | awk -F. '{print $1}'`" -gt 5; then - # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX - # are actually MT-safe as they always return pointers - # from TSD instead of static storage. - -$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h - - -$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h - - - elif test "`uname -s`" = "HP-UX" && \ - test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then - # Starting with HPUX 11.00 (we believe), gethostbyX - # are actually MT-safe as they always return pointers - # from TSD instead of static storage. - -$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h - - -$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h - - - else - ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r" -if test "x$ac_cv_func_gethostbyname_r" = xyes; then : - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5 -$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; } -if ${tcl_cv_api_gethostbyname_r_6+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for struct sockaddr_storage" >&5 +echo $ECHO_N "checking for struct sockaddr_storage... $ECHO_C" >&6 +if test "${ac_cv_type_struct_sockaddr_storage+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #include +#include +#include +#include +#include + int main () { - - char *name; - struct hostent *he, *res; - char buffer[2048]; - int buflen = 2048; - int h_errnop; - - (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); - +if ((struct sockaddr_storage *) 0) + return 0; +if (sizeof (struct sockaddr_storage)) + return 0; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_gethostbyname_r_6=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_struct_sockaddr_storage=yes else - tcl_cv_api_gethostbyname_r_6=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_struct_sockaddr_storage=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_6" >&5 -$as_echo "$tcl_cv_api_gethostbyname_r_6" >&6; } - tcl_ok=$tcl_cv_api_gethostbyname_r_6 - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_storage" >&5 +echo "${ECHO_T}$ac_cv_type_struct_sockaddr_storage" >&6 +if test $ac_cv_type_struct_sockaddr_storage = yes; then -$as_echo "#define HAVE_GETHOSTBYNAME_R_6 1" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_SOCKADDR_STORAGE 1 +_ACEOF - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 5 args" >&5 -$as_echo_n "checking for gethostbyname_r with 5 args... " >&6; } -if ${tcl_cv_api_gethostbyname_r_5+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +else + NEED_FAKE_RFC2553=1 +fi - #include +if test "x$NEED_FAKE_RFC2553" = "x1"; then -int -main () -{ +cat >>confdefs.h <<\_ACEOF +#define NEED_FAKE_RFC2553 1 +_ACEOF - char *name; - struct hostent *he; - char buffer[2048]; - int buflen = 2048; - int h_errnop; + case $LIBOBJS in + "fake-rfc2553.$ac_objext" | \ + *" fake-rfc2553.$ac_objext" | \ + "fake-rfc2553.$ac_objext "* | \ + *" fake-rfc2553.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;; +esac - (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); + echo "$as_me:$LINENO: checking for strlcpy" >&5 +echo $ECHO_N "checking for strlcpy... $ECHO_C" >&6 +if test "${ac_cv_func_strlcpy+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. */ +/* Define strlcpy to an innocuous variant, in case declares strlcpy. + For example, HP-UX 11i declares gettimeofday. */ +#define strlcpy innocuous_strlcpy + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strlcpy (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef strlcpy +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strlcpy (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strlcpy) || defined (__stub___strlcpy) +choke me +#else +char (*f) () = strlcpy; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != strlcpy; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_gethostbyname_r_5=yes +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 + ac_cv_func_strlcpy=yes else - tcl_cv_api_gethostbyname_r_5=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_strlcpy=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_5" >&5 -$as_echo "$tcl_cv_api_gethostbyname_r_5" >&6; } - tcl_ok=$tcl_cv_api_gethostbyname_r_5 - if test "$tcl_ok" = yes; then +echo "$as_me:$LINENO: result: $ac_cv_func_strlcpy" >&5 +echo "${ECHO_T}$ac_cv_func_strlcpy" >&6 -$as_echo "#define HAVE_GETHOSTBYNAME_R_5 1" >>confdefs.h +fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 3 args" >&5 -$as_echo_n "checking for gethostbyname_r with 3 args... " >&6; } -if ${tcl_cv_api_gethostbyname_r_3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +#-------------------------------------------------------------------- +# Look for thread-safe variants of some library functions. +#-------------------------------------------------------------------- + +if test "${TCL_THREADS}" = 1; then + echo "$as_me:$LINENO: checking for getpwuid_r" >&5 +echo $ECHO_N "checking for getpwuid_r... $ECHO_C" >&6 +if test "${ac_cv_func_getpwuid_r+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. */ +/* Define getpwuid_r to an innocuous variant, in case declares getpwuid_r. + For example, HP-UX 11i declares gettimeofday. */ +#define getpwuid_r innocuous_getpwuid_r - #include +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char getpwuid_r (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -int -main () -{ +#ifdef __STDC__ +# include +#else +# include +#endif - char *name; - struct hostent *he; - struct hostent_data data; +#undef getpwuid_r - (void) gethostbyname_r(name, he, &data); +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char getpwuid_r (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_getpwuid_r) || defined (__stub___getpwuid_r) +choke me +#else +char (*f) () = getpwuid_r; +#endif +#ifdef __cplusplus +} +#endif +int +main () +{ +return f != getpwuid_r; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_gethostbyname_r_3=yes +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 + ac_cv_func_getpwuid_r=yes else - tcl_cv_api_gethostbyname_r_3=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_3" >&5 -$as_echo "$tcl_cv_api_gethostbyname_r_3" >&6; } - tcl_ok=$tcl_cv_api_gethostbyname_r_3 - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETHOSTBYNAME_R_3 1" >>confdefs.h - - fi - fi - fi - if test "$tcl_ok" = yes; then - -$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h - - fi + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +ac_cv_func_getpwuid_r=no fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_getpwuid_r" >&5 +echo "${ECHO_T}$ac_cv_func_getpwuid_r" >&6 +if test $ac_cv_func_getpwuid_r = yes; then - ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r" -if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then : - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5 -$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; } -if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for getpwuid_r with 5 args" >&5 +echo $ECHO_N "checking for getpwuid_r with 5 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getpwuid_r_5+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #include + #include + #include int main () { - char *addr; - int length; - int type; - struct hostent *result; - char buffer[2048]; - int buflen = 2048; - int h_errnop; + uid_t uid; + struct passwd pw, *pwp; + char buf[512]; + int buflen = 512; - (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, - &h_errnop); + (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_gethostbyaddr_r_7=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getpwuid_r_5=yes else - tcl_cv_api_gethostbyaddr_r_7=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getpwuid_r_5=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 -$as_echo "$tcl_cv_api_gethostbyaddr_r_7" >&6; } - tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 +echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_5" >&5 +echo "${ECHO_T}$tcl_cv_api_getpwuid_r_5" >&6 + tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then -$as_echo "#define HAVE_GETHOSTBYADDR_R_7 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETPWUID_R_5 1 +_ACEOF else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 8 args" >&5 -$as_echo_n "checking for gethostbyaddr_r with 8 args... " >&6; } -if ${tcl_cv_api_gethostbyaddr_r_8+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for getpwuid_r with 4 args" >&5 +echo $ECHO_N "checking for getpwuid_r with 4 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getpwuid_r_4+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #include + #include + #include int main () { - char *addr; - int length; - int type; - struct hostent *result, *resultp; - char buffer[2048]; - int buflen = 2048; - int h_errnop; + uid_t uid; + struct passwd pw; + char buf[512]; + int buflen = 512; - (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, - &resultp, &h_errnop); + (void)getpwnam_r(uid, &pw, buf, buflen); ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_api_gethostbyaddr_r_8=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getpwuid_r_4=yes else - tcl_cv_api_gethostbyaddr_r_8=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getpwuid_r_4=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 -$as_echo "$tcl_cv_api_gethostbyaddr_r_8" >&6; } - tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 +echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_4" >&5 +echo "${ECHO_T}$tcl_cv_api_getpwuid_r_4" >&6 + tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then -$as_echo "#define HAVE_GETHOSTBYADDR_R_8 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETPWUID_R_4 1 +_ACEOF fi fi if test "$tcl_ok" = yes; then -$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h - - fi - -fi - - fi -fi - -#--------------------------------------------------------------------------- -# Check for serial port interface. -# -# termios.h is present on all POSIX systems. -# sys/ioctl.h is almost always present, though what it contains -# is system-specific. -# sys/modem.h is needed on HP-UX. -#--------------------------------------------------------------------------- - -for ac_header in termios.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default" -if test "x$ac_cv_header_termios_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_TERMIOS_H 1 +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETPWUID_R 1 _ACEOF -fi - -done - -for ac_header in sys/ioctl.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_ioctl_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_IOCTL_H 1 -_ACEOF + fi fi -done - -for ac_header in sys/modem.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/modem.h" "ac_cv_header_sys_modem_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_modem_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_MODEM_H 1 + echo "$as_me:$LINENO: checking for getpwnam_r" >&5 +echo $ECHO_N "checking for getpwnam_r... $ECHO_C" >&6 +if test "${ac_cv_func_getpwnam_r+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. */ +/* Define getpwnam_r to an innocuous variant, in case declares getpwnam_r. + For example, HP-UX 11i declares gettimeofday. */ +#define getpwnam_r innocuous_getpwnam_r -fi - -done +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char getpwnam_r (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ +#ifdef __STDC__ +# include +#else +# include +#endif -#-------------------------------------------------------------------- -# Include sys/select.h if it exists and if it supplies things -# that appear to be useful and aren't already in sys/types.h. -# This appears to be true only on the RS/6000 under AIX. Some -# systems like OSF/1 have a sys/select.h that's of no use, and -# other systems like SCO UNIX have a sys/select.h that's -# pernicious. If "fd_set" isn't defined anywhere then set a -# special flag. -#-------------------------------------------------------------------- +#undef getpwnam_r -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_set in sys/types" >&5 -$as_echo_n "checking for fd_set in sys/types... " >&6; } -if ${tcl_cv_type_fd_set+:} false; then : - $as_echo_n "(cached) " >&6 -else +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char getpwnam_r (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_getpwnam_r) || defined (__stub___getpwnam_r) +choke me +#else +char (*f) () = getpwnam_r; +#endif +#ifdef __cplusplus +} +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include int main () { -fd_set readMask, writeMask; +return f != getpwnam_r; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_type_fd_set=yes +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 + ac_cv_func_getpwnam_r=yes else - tcl_cv_type_fd_set=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_getpwnam_r=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_fd_set" >&5 -$as_echo "$tcl_cv_type_fd_set" >&6; } -tcl_ok=$tcl_cv_type_fd_set -if test $tcl_ok = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_mask in sys/select" >&5 -$as_echo_n "checking for fd_mask in sys/select... " >&6; } -if ${tcl_cv_grep_fd_mask+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: result: $ac_cv_func_getpwnam_r" >&5 +echo "${ECHO_T}$ac_cv_func_getpwnam_r" >&6 +if test $ac_cv_func_getpwnam_r = yes; then + + echo "$as_me:$LINENO: checking for getpwnam_r with 5 args" >&5 +echo $ECHO_N "checking for getpwnam_r with 5 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getpwnam_r_5+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "fd_mask" >/dev/null 2>&1; then : - tcl_cv_grep_fd_mask=present -else - tcl_cv_grep_fd_mask=missing -fi -rm -f conftest* + #include + #include -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5 -$as_echo "$tcl_cv_grep_fd_mask" >&6; } - if test $tcl_cv_grep_fd_mask = present; then - -$as_echo "#define HAVE_SYS_SELECT_H 1" >>confdefs.h - - tcl_ok=yes - fi -fi -if test $tcl_ok = no; then - -$as_echo "#define NO_FD_SET 1" >>confdefs.h - -fi +int +main () +{ -#------------------------------------------------------------------------------ -# Find out all about time handling differences. -#------------------------------------------------------------------------------ + char *name; + struct passwd pw, *pwp; + char buf[512]; + int buflen = 512; + (void) getpwnam_r(name, &pw, buf, buflen, &pwp); - for ac_header in sys/time.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/time.h" "ac_cv_header_sys_time_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_time_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_TIME_H 1 + ; + return 0; +} _ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getpwnam_r_5=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_cv_api_getpwnam_r_5=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_5" >&5 +echo "${ECHO_T}$tcl_cv_api_getpwnam_r_5" >&6 + tcl_ok=$tcl_cv_api_getpwnam_r_5 + if test "$tcl_ok" = yes; then -done +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETPWNAM_R_5 1 +_ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 -$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } -if ${ac_cv_header_time+:} false; then : - $as_echo_n "(cached) " >&6 + else + echo "$as_me:$LINENO: checking for getpwnam_r with 4 args" >&5 +echo $ECHO_N "checking for getpwnam_r with 4 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getpwnam_r_4+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include -#include -#include + + #include + #include int main () { -if ((struct tm *) 0) -return 0; + + char *name; + struct passwd pw; + char buf[512]; + int buflen = 512; + + (void)getpwnam_r(name, &pw, buf, buflen); + ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_time=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getpwnam_r_4=yes else - ac_cv_header_time=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getpwnam_r_4=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5 -$as_echo "$ac_cv_header_time" >&6; } -if test $ac_cv_header_time = yes; then - -$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h +echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_4" >&5 +echo "${ECHO_T}$tcl_cv_api_getpwnam_r_4" >&6 + tcl_ok=$tcl_cv_api_getpwnam_r_4 + if test "$tcl_ok" = yes; then -fi +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETPWNAM_R_4 1 +_ACEOF + fi + fi + if test "$tcl_ok" = yes; then - for ac_func in gmtime_r localtime_r mktime -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETPWNAM_R 1 _ACEOF -fi -done + fi +fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_tzadj in struct tm" >&5 -$as_echo_n "checking tm_tzadj in struct tm... " >&6; } -if ${tcl_cv_member_tm_tzadj+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for getgrgid_r" >&5 +echo $ECHO_N "checking for getgrgid_r... $ECHO_C" >&6 +if test "${ac_cv_func_getgrgid_r+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -struct tm tm; tm.tm_tzadj; - ; - return 0; -} + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_member_tm_tzadj=yes -else - tcl_cv_member_tm_tzadj=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_tzadj" >&5 -$as_echo "$tcl_cv_member_tm_tzadj" >&6; } - if test $tcl_cv_member_tm_tzadj = yes ; then +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define getgrgid_r to an innocuous variant, in case declares getgrgid_r. + For example, HP-UX 11i declares gettimeofday. */ +#define getgrgid_r innocuous_getgrgid_r -$as_echo "#define HAVE_TM_TZADJ 1" >>confdefs.h +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char getgrgid_r (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ - fi +#ifdef __STDC__ +# include +#else +# include +#endif - { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_gmtoff in struct tm" >&5 -$as_echo_n "checking tm_gmtoff in struct tm... " >&6; } -if ${tcl_cv_member_tm_gmtoff+:} false; then : - $as_echo_n "(cached) " >&6 -else +#undef getgrgid_r + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char getgrgid_r (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_getgrgid_r) || defined (__stub___getgrgid_r) +choke me +#else +char (*f) () = getgrgid_r; +#endif +#ifdef __cplusplus +} +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include int main () { -struct tm tm; tm.tm_gmtoff; +return f != getgrgid_r; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_member_tm_gmtoff=yes +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 + ac_cv_func_getgrgid_r=yes else - tcl_cv_member_tm_gmtoff=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_getgrgid_r=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_gmtoff" >&5 -$as_echo "$tcl_cv_member_tm_gmtoff" >&6; } - if test $tcl_cv_member_tm_gmtoff = yes ; then - -$as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h +echo "$as_me:$LINENO: result: $ac_cv_func_getgrgid_r" >&5 +echo "${ECHO_T}$ac_cv_func_getgrgid_r" >&6 +if test $ac_cv_func_getgrgid_r = yes; then - fi - - # - # Its important to include time.h in this check, as some systems - # (like convex) have timezone functions, etc. - # - { $as_echo "$as_me:${as_lineno-$LINENO}: checking long timezone variable" >&5 -$as_echo_n "checking long timezone variable... " >&6; } -if ${tcl_cv_timezone_long+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for getgrgid_r with 5 args" >&5 +echo $ECHO_N "checking for getgrgid_r with 5 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getgrgid_r_5+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include + + #include + #include + int main () { -extern long timezone; - timezone += 1; - exit (0); + + gid_t gid; + struct group gr, *grp; + char buf[512]; + int buflen = 512; + + (void) getgrgid_r(gid, &gr, buf, buflen, &grp); + ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_timezone_long=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getgrgid_r_5=yes else - tcl_cv_timezone_long=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getgrgid_r_5=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_long" >&5 -$as_echo "$tcl_cv_timezone_long" >&6; } - if test $tcl_cv_timezone_long = yes ; then +echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_5" >&5 +echo "${ECHO_T}$tcl_cv_api_getgrgid_r_5" >&6 + tcl_ok=$tcl_cv_api_getgrgid_r_5 + if test "$tcl_ok" = yes; then -$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETGRGID_R_5 1 +_ACEOF else - # - # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. - # - { $as_echo "$as_me:${as_lineno-$LINENO}: checking time_t timezone variable" >&5 -$as_echo_n "checking time_t timezone variable... " >&6; } -if ${tcl_cv_timezone_time+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking for getgrgid_r with 4 args" >&5 +echo $ECHO_N "checking for getgrgid_r with 4 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getgrgid_r_4+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include + + #include + #include + int main () { -extern time_t timezone; - timezone += 1; - exit (0); + + gid_t gid; + struct group gr; + char buf[512]; + int buflen = 512; + + (void)getgrgid_r(gid, &gr, buf, buflen); + ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_timezone_time=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getgrgid_r_4=yes else - tcl_cv_timezone_time=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getgrgid_r_4=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_time" >&5 -$as_echo "$tcl_cv_timezone_time" >&6; } - if test $tcl_cv_timezone_time = yes ; then +echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_4" >&5 +echo "${ECHO_T}$tcl_cv_api_getgrgid_r_4" >&6 + tcl_ok=$tcl_cv_api_getgrgid_r_4 + if test "$tcl_ok" = yes; then -$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETGRGID_R_4 1 +_ACEOF fi fi + if test "$tcl_ok" = yes; then - -#-------------------------------------------------------------------- -# Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But -# we might be able to use fstatfs instead. Some systems (OpenBSD?) also -# lack blkcnt_t. -#-------------------------------------------------------------------- - -if test "$ac_cv_cygwin" != "yes"; then - ac_fn_c_check_member "$LINENO" "struct stat" "st_blocks" "ac_cv_member_struct_stat_st_blocks" "$ac_includes_default" -if test "x$ac_cv_member_struct_stat_st_blocks" = xyes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BLOCKS 1 +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETGRGID_R 1 _ACEOF + fi fi -ac_fn_c_check_member "$LINENO" "struct stat" "st_blksize" "ac_cv_member_struct_stat_st_blksize" "$ac_includes_default" -if test "x$ac_cv_member_struct_stat_st_blksize" = xyes; then : -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BLKSIZE 1 + echo "$as_me:$LINENO: checking for getgrnam_r" >&5 +echo $ECHO_N "checking for getgrnam_r... $ECHO_C" >&6 +if test "${ac_cv_func_getgrnam_r+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. */ +/* Define getgrnam_r to an innocuous variant, in case declares getgrnam_r. + For example, HP-UX 11i declares gettimeofday. */ +#define getgrnam_r innocuous_getgrnam_r +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char getgrnam_r (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -fi +#ifdef __STDC__ +# include +#else +# include +#endif -fi -ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default" -if test "x$ac_cv_type_blkcnt_t" = xyes; then : +#undef getgrnam_r -cat >>confdefs.h <<_ACEOF -#define HAVE_BLKCNT_T 1 -_ACEOF +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char getgrnam_r (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_getgrnam_r) || defined (__stub___getgrnam_r) +choke me +#else +char (*f) () = getgrnam_r; +#endif +#ifdef __cplusplus +} +#endif +int +main () +{ +return f != getgrnam_r; + ; + 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 + ac_cv_func_getgrnam_r=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +ac_cv_func_getgrnam_r=no fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_getgrnam_r" >&5 +echo "${ECHO_T}$ac_cv_func_getgrnam_r" >&6 +if test $ac_cv_func_getgrnam_r = yes; then -ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs" -if test "x$ac_cv_func_fstatfs" = xyes; then : - + echo "$as_me:$LINENO: checking for getgrnam_r with 5 args" >&5 +echo $ECHO_N "checking for getgrnam_r with 5 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getgrnam_r_5+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else -$as_echo "#define NO_FSTATFS 1" >>confdefs.h - -fi + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + #include + #include -#-------------------------------------------------------------------- -# Some system have no memcmp or it does not work with 8 bit data, this -# checks it and add memcmp.o to LIBOBJS if needed -#-------------------------------------------------------------------- +int +main () +{ + + char *name; + struct group gr, *grp; + char buf[512]; + int buflen = 512; + + (void) getgrnam_r(name, &gr, buf, buflen, &grp); -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5 -$as_echo_n "checking for working memcmp... " >&6; } -if ${ac_cv_func_memcmp_working+:} false; then : - $as_echo_n "(cached) " >&6 + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getgrnam_r_5=yes else - if test "$cross_compiling" = yes; then : - ac_cv_func_memcmp_working=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getgrnam_r_5=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_5" >&5 +echo "${ECHO_T}$tcl_cv_api_getgrnam_r_5" >&6 + tcl_ok=$tcl_cv_api_getgrnam_r_5 + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETGRNAM_R_5 1 +_ACEOF + + else + echo "$as_me:$LINENO: checking for getgrnam_r with 4 args" >&5 +echo $ECHO_N "checking for getgrnam_r with 4 args... $ECHO_C" >&6 +if test "${tcl_cv_api_getgrnam_r_4+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -$ac_includes_default + + #include + #include + int main () { - /* Some versions of memcmp are not 8-bit clean. */ - char c0 = '\100', c1 = '\200', c2 = '\201'; - if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) - return 1; + char *name; + struct group gr; + char buf[512]; + int buflen = 512; - /* The Next x86 OpenStep bug shows up only when comparing 16 bytes - or more and with at least one buffer not starting on a 4-byte boundary. - William Lewis provided this test program. */ - { - char foo[21]; - char bar[21]; - int i; - for (i = 0; i < 4; i++) - { - char *a = foo + i; - char *b = bar + i; - strcpy (a, "--------01111111"); - strcpy (b, "--------10000000"); - if (memcmp (a, b, 16) >= 0) - return 1; - } - return 0; - } + (void)getgrnam_r(name, &gr, buf, buflen); ; return 0; } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_func_memcmp_working=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_getgrnam_r_4=yes else - ac_cv_func_memcmp_working=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_getgrnam_r_4=no fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi +echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_4" >&5 +echo "${ECHO_T}$tcl_cv_api_getgrnam_r_4" >&6 + tcl_ok=$tcl_cv_api_getgrnam_r_4 + if test "$tcl_ok" = yes; then -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5 -$as_echo "$ac_cv_func_memcmp_working" >&6; } -test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in - *" memcmp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" - ;; -esac +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETGRNAM_R_4 1 +_ACEOF + fi + fi + if test "$tcl_ok" = yes; then +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETGRNAM_R 1 +_ACEOF -#-------------------------------------------------------------------- -# Some system like SunOS 4 and other BSD like systems have no memmove -# (we assume they have bcopy instead). {The replacement define is in -# compat/string.h} -#-------------------------------------------------------------------- + fi -ac_fn_c_check_func "$LINENO" "memmove" "ac_cv_func_memmove" -if test "x$ac_cv_func_memmove" = xyes; then : +fi -else + if test "`uname -s`" = "Darwin" && \ + test "`uname -r | awk -F. '{print $1}'`" -gt 5; then + # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX + # are actually MT-safe as they always return pointers + # from TSD instead of static storage. +cat >>confdefs.h <<\_ACEOF +#define HAVE_MTSAFE_GETHOSTBYNAME 1 +_ACEOF -$as_echo "#define NO_MEMMOVE 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_MTSAFE_GETHOSTBYADDR 1 +_ACEOF -$as_echo "#define NO_STRING_H 1" >>confdefs.h -fi + elif test "`uname -s`" = "HP-UX" && \ + test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then + # Starting with HPUX 11.00 (we believe), gethostbyX + # are actually MT-safe as they always return pointers + # from TSD instead of static storage. +cat >>confdefs.h <<\_ACEOF +#define HAVE_MTSAFE_GETHOSTBYNAME 1 +_ACEOF -#-------------------------------------------------------------------- -# On some systems strstr is broken: it returns a pointer even even if -# the original string is empty. -#-------------------------------------------------------------------- +cat >>confdefs.h <<\_ACEOF +#define HAVE_MTSAFE_GETHOSTBYADDR 1 +_ACEOF - ac_fn_c_check_func "$LINENO" "strstr" "ac_cv_func_strstr" -if test "x$ac_cv_func_strstr" = xyes; then : - tcl_ok=1 -else - tcl_ok=0 -fi - if test "$tcl_ok" = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5 -$as_echo_n "checking proper strstr implementation... " >&6; } -if ${tcl_cv_strstr_unbroken+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - tcl_cv_strstr_unbroken=unknown + else + echo "$as_me:$LINENO: checking for gethostbyname_r" >&5 +echo $ECHO_N "checking for gethostbyname_r... $ECHO_C" >&6 +if test "${ac_cv_func_gethostbyname_r+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -int main() { - extern int strstr(); - exit(strstr("\0test", "test") ? 1 : 0); +/* Define gethostbyname_r to an innocuous variant, in case declares gethostbyname_r. + For example, HP-UX 11i declares gettimeofday. */ +#define gethostbyname_r innocuous_gethostbyname_r + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char gethostbyname_r (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef gethostbyname_r + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gethostbyname_r (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_gethostbyname_r) || defined (__stub___gethostbyname_r) +choke me +#else +char (*f) () = gethostbyname_r; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != gethostbyname_r; + ; + return 0; } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - tcl_cv_strstr_unbroken=ok +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 + ac_cv_func_gethostbyname_r=yes else - tcl_cv_strstr_unbroken=broken + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_gethostbyname_r=no fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi +echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname_r" >&5 +echo "${ECHO_T}$ac_cv_func_gethostbyname_r" >&6 +if test $ac_cv_func_gethostbyname_r = yes; then -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5 -$as_echo "$tcl_cv_strstr_unbroken" >&6; } - if test "$tcl_cv_strstr_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 - fi - fi - if test "$tcl_ok" = 0; then - case " $LIBOBJS " in - *" strstr.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strstr.$ac_objext" - ;; -esac + echo "$as_me:$LINENO: checking for gethostbyname_r with 6 args" >&5 +echo $ECHO_N "checking for gethostbyname_r with 6 args... $ECHO_C" >&6 +if test "${tcl_cv_api_gethostbyname_r_6+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else - USE_COMPAT=1 - fi + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + #include -#-------------------------------------------------------------------- -# Check for strtoul function. This is tricky because under some -# versions of AIX strtoul returns an incorrect terminator -# pointer for the string "0". -#-------------------------------------------------------------------- +int +main () +{ + char *name; + struct hostent *he, *res; + char buffer[2048]; + int buflen = 2048; + int h_errnop; - ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul" -if test "x$ac_cv_func_strtoul" = xyes; then : - tcl_ok=1 -else - tcl_ok=0 -fi + (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); - if test "$tcl_ok" = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5 -$as_echo_n "checking proper strtoul implementation... " >&6; } -if ${tcl_cv_strtoul_unbroken+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - tcl_cv_strtoul_unbroken=unknown -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -int main() { - extern int strtoul(); - char *term, *string = "0"; - exit(strtoul(string,&term,0) != 0 || term != string+1); + ; + return 0; } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - tcl_cv_strtoul_unbroken=ok +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_gethostbyname_r_6=yes else - tcl_cv_strtoul_unbroken=broken + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_gethostbyname_r_6=no fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi +echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_6" >&5 +echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_6" >&6 + tcl_ok=$tcl_cv_api_gethostbyname_r_6 + if test "$tcl_ok" = yes; then -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5 -$as_echo "$tcl_cv_strtoul_unbroken" >&6; } - if test "$tcl_cv_strtoul_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 - fi - fi - if test "$tcl_ok" = 0; then - case " $LIBOBJS " in - *" strtoul.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" - ;; -esac +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYNAME_R_6 1 +_ACEOF - USE_COMPAT=1 - fi + else + echo "$as_me:$LINENO: checking for gethostbyname_r with 5 args" >&5 +echo $ECHO_N "checking for gethostbyname_r with 5 args... $ECHO_C" >&6 +if test "${tcl_cv_api_gethostbyname_r_5+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. */ -#-------------------------------------------------------------------- -# Check for the strtod function. This is tricky because in some -# versions of Linux strtod mis-parses strings starting with "+". -#-------------------------------------------------------------------- + #include +int +main () +{ - ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod" -if test "x$ac_cv_func_strtod" = xyes; then : - tcl_ok=1 -else - tcl_ok=0 -fi + char *name; + struct hostent *he; + char buffer[2048]; + int buflen = 2048; + int h_errnop; - if test "$tcl_ok" = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtod implementation" >&5 -$as_echo_n "checking proper strtod implementation... " >&6; } -if ${tcl_cv_strtod_unbroken+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - tcl_cv_strtod_unbroken=unknown -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_gethostbyname_r_5=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_gethostbyname_r_5=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_5" >&5 +echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_5" >&6 + tcl_ok=$tcl_cv_api_gethostbyname_r_5 + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYNAME_R_5 1 +_ACEOF + + else + echo "$as_me:$LINENO: checking for gethostbyname_r with 3 args" >&5 +echo $ECHO_N "checking for gethostbyname_r with 3 args... $ECHO_C" >&6 +if test "${tcl_cv_api_gethostbyname_r_3+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() { - extern double strtod(); - char *term, *string = " +69"; - exit(strtod(string,&term) != 69 || term != string+4); + + #include + +int +main () +{ + + char *name; + struct hostent *he; + struct hostent_data data; + + (void) gethostbyname_r(name, he, &data); + + ; + return 0; } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - tcl_cv_strtod_unbroken=ok +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_gethostbyname_r_3=yes else - tcl_cv_strtod_unbroken=broken + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_gethostbyname_r_3=no fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi +echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_3" >&5 +echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_3" >&6 + tcl_ok=$tcl_cv_api_gethostbyname_r_3 + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYNAME_R_3 1 +_ACEOF + + fi + fi + fi + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYNAME_R 1 +_ACEOF + + fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_unbroken" >&5 -$as_echo "$tcl_cv_strtod_unbroken" >&6; } - if test "$tcl_cv_strtod_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 + + echo "$as_me:$LINENO: checking for gethostbyaddr_r" >&5 +echo $ECHO_N "checking for gethostbyaddr_r... $ECHO_C" >&6 +if test "${ac_cv_func_gethostbyaddr_r+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. */ +/* Define gethostbyaddr_r to an innocuous variant, in case declares gethostbyaddr_r. + For example, HP-UX 11i declares gettimeofday. */ +#define gethostbyaddr_r innocuous_gethostbyaddr_r + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char gethostbyaddr_r (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef gethostbyaddr_r + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gethostbyaddr_r (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_gethostbyaddr_r) || defined (__stub___gethostbyaddr_r) +choke me +#else +char (*f) () = gethostbyaddr_r; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != gethostbyaddr_r; + ; + 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 + ac_cv_func_gethostbyaddr_r=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_gethostbyaddr_r=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyaddr_r" >&5 +echo "${ECHO_T}$ac_cv_func_gethostbyaddr_r" >&6 +if test $ac_cv_func_gethostbyaddr_r = yes; then + + echo "$as_me:$LINENO: checking for gethostbyaddr_r with 7 args" >&5 +echo $ECHO_N "checking for gethostbyaddr_r with 7 args... $ECHO_C" >&6 +if test "${tcl_cv_api_gethostbyaddr_r_7+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. */ + + #include + +int +main () +{ + + char *addr; + int length; + int type; + struct hostent *result; + char buffer[2048]; + int buflen = 2048; + int h_errnop; + + (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, + &h_errnop); + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_gethostbyaddr_r_7=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_gethostbyaddr_r_7=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 +echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_7" >&6 + tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYADDR_R_7 1 +_ACEOF + + else + echo "$as_me:$LINENO: checking for gethostbyaddr_r with 8 args" >&5 +echo $ECHO_N "checking for gethostbyaddr_r with 8 args... $ECHO_C" >&6 +if test "${tcl_cv_api_gethostbyaddr_r_8+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. */ + + #include + +int +main () +{ + + char *addr; + int length; + int type; + struct hostent *result, *resultp; + char buffer[2048]; + int buflen = 2048; + int h_errnop; + + (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, + &resultp, &h_errnop); + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_api_gethostbyaddr_r_8=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_gethostbyaddr_r_8=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 +echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_8" >&6 + tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYADDR_R_8 1 +_ACEOF + fi fi - if test "$tcl_ok" = 0; then - case " $LIBOBJS " in - *" strtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strtod.$ac_objext" - ;; -esac + if test "$tcl_ok" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GETHOSTBYADDR_R 1 +_ACEOF - USE_COMPAT=1 fi +fi -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" that corrects the error. -#-------------------------------------------------------------------- + fi +fi + +#--------------------------------------------------------------------------- +# Check for serial port interface. +# +# termios.h is present on all POSIX systems. +# sys/ioctl.h is almost always present, though what it contains +# is system-specific. +# sys/modem.h is needed on HP-UX. +#--------------------------------------------------------------------------- - ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod" -if test "x$ac_cv_func_strtod" = xyes; then : - tcl_strtod=1 +for ac_header in termios.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else - tcl_strtod=0 + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in sys/ioctl.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in sys/modem.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +#-------------------------------------------------------------------- +# Include sys/select.h if it exists and if it supplies things +# that appear to be useful and aren't already in sys/types.h. +# This appears to be true only on the RS/6000 under AIX. Some +# systems like OSF/1 have a sys/select.h that's of no use, and +# other systems like SCO UNIX have a sys/select.h that's +# pernicious. If "fd_set" isn't defined anywhere then set a +# special flag. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for fd_set in sys/types" >&5 +echo $ECHO_N "checking for fd_set in sys/types... $ECHO_C" >&6 +if test "${tcl_cv_type_fd_set+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. */ +#include +int +main () +{ +fd_set readMask, writeMask; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_type_fd_set=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_type_fd_set=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_type_fd_set" >&5 +echo "${ECHO_T}$tcl_cv_type_fd_set" >&6 +tcl_ok=$tcl_cv_type_fd_set +if test $tcl_ok = no; then + echo "$as_me:$LINENO: checking for fd_mask in sys/select" >&5 +echo $ECHO_N "checking for fd_mask in sys/select... $ECHO_C" >&6 +if test "${tcl_cv_grep_fd_mask+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. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "fd_mask" >/dev/null 2>&1; then + tcl_cv_grep_fd_mask=present +else + tcl_cv_grep_fd_mask=missing +fi +rm -f conftest* + +fi +echo "$as_me:$LINENO: result: $tcl_cv_grep_fd_mask" >&5 +echo "${ECHO_T}$tcl_cv_grep_fd_mask" >&6 + if test $tcl_cv_grep_fd_mask = present; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_SYS_SELECT_H 1 +_ACEOF + + tcl_ok=yes + fi +fi +if test $tcl_ok = no; then + +cat >>confdefs.h <<\_ACEOF +#define NO_FD_SET 1 +_ACEOF + +fi + +#------------------------------------------------------------------------------ +# Find out all about time handling differences. +#------------------------------------------------------------------------------ + + + +for ac_header in sys/time.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5 +echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6 +if test "${ac_cv_header_time+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. */ +#include +#include +#include + +int +main () +{ +if ((struct tm *) 0) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_header_time=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_time=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5 +echo "${ECHO_T}$ac_cv_header_time" >&6 +if test $ac_cv_header_time = yes; then + +cat >>confdefs.h <<\_ACEOF +#define TIME_WITH_SYS_TIME 1 +_ACEOF + +fi + + + + + +for ac_func in gmtime_r localtime_r mktime +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + 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 + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + + echo "$as_me:$LINENO: checking tm_tzadj in struct tm" >&5 +echo $ECHO_N "checking tm_tzadj in struct tm... $ECHO_C" >&6 +if test "${tcl_cv_member_tm_tzadj+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. */ +#include +int +main () +{ +struct tm tm; tm.tm_tzadj; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_member_tm_tzadj=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_member_tm_tzadj=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_member_tm_tzadj" >&5 +echo "${ECHO_T}$tcl_cv_member_tm_tzadj" >&6 + if test $tcl_cv_member_tm_tzadj = yes ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_TM_TZADJ 1 +_ACEOF + + fi + + echo "$as_me:$LINENO: checking tm_gmtoff in struct tm" >&5 +echo $ECHO_N "checking tm_gmtoff in struct tm... $ECHO_C" >&6 +if test "${tcl_cv_member_tm_gmtoff+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. */ +#include +int +main () +{ +struct tm tm; tm.tm_gmtoff; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_member_tm_gmtoff=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_member_tm_gmtoff=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_member_tm_gmtoff" >&5 +echo "${ECHO_T}$tcl_cv_member_tm_gmtoff" >&6 + if test $tcl_cv_member_tm_gmtoff = yes ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_TM_GMTOFF 1 +_ACEOF + + fi + + # + # Its important to include time.h in this check, as some systems + # (like convex) have timezone functions, etc. + # + echo "$as_me:$LINENO: checking long timezone variable" >&5 +echo $ECHO_N "checking long timezone variable... $ECHO_C" >&6 +if test "${tcl_cv_timezone_long+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. */ +#include +int +main () +{ +extern long timezone; + timezone += 1; + exit (0); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_timezone_long=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_timezone_long=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_timezone_long" >&5 +echo "${ECHO_T}$tcl_cv_timezone_long" >&6 + if test $tcl_cv_timezone_long = yes ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_TIMEZONE_VAR 1 +_ACEOF + + else + # + # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. + # + echo "$as_me:$LINENO: checking time_t timezone variable" >&5 +echo $ECHO_N "checking time_t timezone variable... $ECHO_C" >&6 +if test "${tcl_cv_timezone_time+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. */ +#include +int +main () +{ +extern time_t timezone; + timezone += 1; + exit (0); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_timezone_time=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_timezone_time=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_timezone_time" >&5 +echo "${ECHO_T}$tcl_cv_timezone_time" >&6 + if test $tcl_cv_timezone_time = yes ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_TIMEZONE_VAR 1 +_ACEOF + + fi + fi + + +#-------------------------------------------------------------------- +# Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But +# we might be able to use fstatfs instead. Some systems (OpenBSD?) also +# lack blkcnt_t. +#-------------------------------------------------------------------- + +if test "$ac_cv_cygwin" != "yes"; then + echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5 +echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6 +if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static struct stat ac_aggr; +if (ac_aggr.st_blocks) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_member_struct_stat_st_blocks=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static struct stat ac_aggr; +if (sizeof ac_aggr.st_blocks) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_member_struct_stat_st_blocks=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_member_struct_stat_st_blocks=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blocks" >&5 +echo "${ECHO_T}$ac_cv_member_struct_stat_st_blocks" >&6 +if test $ac_cv_member_struct_stat_st_blocks = yes; then + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_BLOCKS 1 +_ACEOF + + +fi +echo "$as_me:$LINENO: checking for struct stat.st_blksize" >&5 +echo $ECHO_N "checking for struct stat.st_blksize... $ECHO_C" >&6 +if test "${ac_cv_member_struct_stat_st_blksize+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. */ +$ac_includes_default +int +main () +{ +static struct stat ac_aggr; +if (ac_aggr.st_blksize) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_member_struct_stat_st_blksize=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static struct stat ac_aggr; +if (sizeof ac_aggr.st_blksize) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_member_struct_stat_st_blksize=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_member_struct_stat_st_blksize=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blksize" >&5 +echo "${ECHO_T}$ac_cv_member_struct_stat_st_blksize" >&6 +if test $ac_cv_member_struct_stat_st_blksize = yes; then + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_BLKSIZE 1 +_ACEOF + + +fi + +fi +echo "$as_me:$LINENO: checking for blkcnt_t" >&5 +echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6 +if test "${ac_cv_type_blkcnt_t+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. */ +$ac_includes_default +int +main () +{ +if ((blkcnt_t *) 0) + return 0; +if (sizeof (blkcnt_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_blkcnt_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_blkcnt_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_blkcnt_t" >&5 +echo "${ECHO_T}$ac_cv_type_blkcnt_t" >&6 +if test $ac_cv_type_blkcnt_t = yes; then + +cat >>confdefs.h <<_ACEOF +#define HAVE_BLKCNT_T 1 +_ACEOF + + +fi + +echo "$as_me:$LINENO: checking for fstatfs" >&5 +echo $ECHO_N "checking for fstatfs... $ECHO_C" >&6 +if test "${ac_cv_func_fstatfs+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. */ +/* Define fstatfs to an innocuous variant, in case declares fstatfs. + For example, HP-UX 11i declares gettimeofday. */ +#define fstatfs innocuous_fstatfs + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char fstatfs (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef fstatfs + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char fstatfs (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_fstatfs) || defined (__stub___fstatfs) +choke me +#else +char (*f) () = fstatfs; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != fstatfs; + ; + 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 + ac_cv_func_fstatfs=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_fstatfs=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_fstatfs" >&5 +echo "${ECHO_T}$ac_cv_func_fstatfs" >&6 +if test $ac_cv_func_fstatfs = yes; then + : +else + +cat >>confdefs.h <<\_ACEOF +#define NO_FSTATFS 1 +_ACEOF + +fi + + +#-------------------------------------------------------------------- +# Some system have no memcmp or it does not work with 8 bit data, this +# checks it and add memcmp.o to LIBOBJS if needed +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for working memcmp" >&5 +echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6 +if test "${ac_cv_func_memcmp_working+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$cross_compiling" = yes; then + ac_cv_func_memcmp_working=no +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ + + /* Some versions of memcmp are not 8-bit clean. */ + char c0 = 0x40, c1 = 0x80, c2 = 0x81; + if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) + exit (1); + + /* The Next x86 OpenStep bug shows up only when comparing 16 bytes + or more and with at least one buffer not starting on a 4-byte boundary. + William Lewis provided this test program. */ + { + char foo[21]; + char bar[21]; + int i; + for (i = 0; i < 4; i++) + { + char *a = foo + i; + char *b = bar + i; + strcpy (a, "--------01111111"); + strcpy (b, "--------10000000"); + if (memcmp (a, b, 16) >= 0) + exit (1); + } + exit (0); + } + + ; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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 + ac_cv_func_memcmp_working=yes +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +ac_cv_func_memcmp_working=no +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5 +echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6 +test $ac_cv_func_memcmp_working = no && case $LIBOBJS in + "memcmp.$ac_objext" | \ + *" memcmp.$ac_objext" | \ + "memcmp.$ac_objext "* | \ + *" memcmp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;; +esac + + + +#-------------------------------------------------------------------- +# Some system like SunOS 4 and other BSD like systems have no memmove +# (we assume they have bcopy instead). {The replacement define is in +# compat/string.h} +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for memmove" >&5 +echo $ECHO_N "checking for memmove... $ECHO_C" >&6 +if test "${ac_cv_func_memmove+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. */ +/* Define memmove to an innocuous variant, in case declares memmove. + For example, HP-UX 11i declares gettimeofday. */ +#define memmove innocuous_memmove + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char memmove (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef memmove + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char memmove (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_memmove) || defined (__stub___memmove) +choke me +#else +char (*f) () = memmove; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != memmove; + ; + 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 + ac_cv_func_memmove=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_memmove=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_memmove" >&5 +echo "${ECHO_T}$ac_cv_func_memmove" >&6 +if test $ac_cv_func_memmove = yes; then + : +else + + +cat >>confdefs.h <<\_ACEOF +#define NO_MEMMOVE 1 +_ACEOF + + +cat >>confdefs.h <<\_ACEOF +#define NO_STRING_H 1 +_ACEOF + +fi + + +#-------------------------------------------------------------------- +# On some systems strstr is broken: it returns a pointer even even if +# the original string is empty. +#-------------------------------------------------------------------- + + + echo "$as_me:$LINENO: checking for strstr" >&5 +echo $ECHO_N "checking for strstr... $ECHO_C" >&6 +if test "${ac_cv_func_strstr+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. */ +/* Define strstr to an innocuous variant, in case declares strstr. + For example, HP-UX 11i declares gettimeofday. */ +#define strstr innocuous_strstr + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strstr (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef strstr + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strstr (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strstr) || defined (__stub___strstr) +choke me +#else +char (*f) () = strstr; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != strstr; + ; + 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 + ac_cv_func_strstr=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_strstr=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_strstr" >&5 +echo "${ECHO_T}$ac_cv_func_strstr" >&6 +if test $ac_cv_func_strstr = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi + + if test "$tcl_ok" = 1; then + echo "$as_me:$LINENO: checking proper strstr implementation" >&5 +echo $ECHO_N "checking proper strstr implementation... $ECHO_C" >&6 +if test "${tcl_cv_strstr_unbroken+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$cross_compiling" = yes; then + tcl_cv_strstr_unbroken=unknown +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() { + extern int strstr(); + exit(strstr("\0test", "test") ? 1 : 0); +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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_strstr_unbroken=ok +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +tcl_cv_strstr_unbroken=broken +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +echo "$as_me:$LINENO: result: $tcl_cv_strstr_unbroken" >&5 +echo "${ECHO_T}$tcl_cv_strstr_unbroken" >&6 + if test "$tcl_cv_strstr_unbroken" = "ok"; then + tcl_ok=1 + else + tcl_ok=0 + fi + fi + if test "$tcl_ok" = 0; then + case $LIBOBJS in + "strstr.$ac_objext" | \ + *" strstr.$ac_objext" | \ + "strstr.$ac_objext "* | \ + *" strstr.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strstr.$ac_objext" ;; +esac + + USE_COMPAT=1 + fi + + +#-------------------------------------------------------------------- +# Check for strtoul function. This is tricky because under some +# versions of AIX strtoul returns an incorrect terminator +# pointer for the string "0". +#-------------------------------------------------------------------- + + + echo "$as_me:$LINENO: checking for strtoul" >&5 +echo $ECHO_N "checking for strtoul... $ECHO_C" >&6 +if test "${ac_cv_func_strtoul+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. */ +/* Define strtoul to an innocuous variant, in case declares strtoul. + For example, HP-UX 11i declares gettimeofday. */ +#define strtoul innocuous_strtoul + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strtoul (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef strtoul + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strtoul (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strtoul) || defined (__stub___strtoul) +choke me +#else +char (*f) () = strtoul; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != strtoul; + ; + 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 + ac_cv_func_strtoul=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_strtoul=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_strtoul" >&5 +echo "${ECHO_T}$ac_cv_func_strtoul" >&6 +if test $ac_cv_func_strtoul = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi + + if test "$tcl_ok" = 1; then + echo "$as_me:$LINENO: checking proper strtoul implementation" >&5 +echo $ECHO_N "checking proper strtoul implementation... $ECHO_C" >&6 +if test "${tcl_cv_strtoul_unbroken+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$cross_compiling" = yes; then + tcl_cv_strtoul_unbroken=unknown +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() { + extern int strtoul(); + char *term, *string = "0"; + exit(strtoul(string,&term,0) != 0 || term != string+1); +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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_strtoul_unbroken=ok +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +tcl_cv_strtoul_unbroken=broken +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +echo "$as_me:$LINENO: result: $tcl_cv_strtoul_unbroken" >&5 +echo "${ECHO_T}$tcl_cv_strtoul_unbroken" >&6 + if test "$tcl_cv_strtoul_unbroken" = "ok"; then + tcl_ok=1 + else + tcl_ok=0 + fi + fi + if test "$tcl_ok" = 0; then + case $LIBOBJS in + "strtoul.$ac_objext" | \ + *" strtoul.$ac_objext" | \ + "strtoul.$ac_objext "* | \ + *" strtoul.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" ;; +esac + + USE_COMPAT=1 + fi + + +#-------------------------------------------------------------------- +# Check for the strtod function. This is tricky because in some +# versions of Linux strtod mis-parses strings starting with "+". +#-------------------------------------------------------------------- + + + echo "$as_me:$LINENO: checking for strtod" >&5 +echo $ECHO_N "checking for strtod... $ECHO_C" >&6 +if test "${ac_cv_func_strtod+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. */ +/* Define strtod to an innocuous variant, in case declares strtod. + For example, HP-UX 11i declares gettimeofday. */ +#define strtod innocuous_strtod + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strtod (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef strtod + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strtod (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strtod) || defined (__stub___strtod) +choke me +#else +char (*f) () = strtod; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != strtod; + ; + 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 + ac_cv_func_strtod=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_strtod=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 +echo "${ECHO_T}$ac_cv_func_strtod" >&6 +if test $ac_cv_func_strtod = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi + + if test "$tcl_ok" = 1; then + echo "$as_me:$LINENO: checking proper strtod implementation" >&5 +echo $ECHO_N "checking proper strtod implementation... $ECHO_C" >&6 +if test "${tcl_cv_strtod_unbroken+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$cross_compiling" = yes; then + tcl_cv_strtod_unbroken=unknown +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() { + extern double strtod(); + char *term, *string = " +69"; + exit(strtod(string,&term) != 69 || term != string+4); +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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_strtod_unbroken=ok +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +tcl_cv_strtod_unbroken=broken +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +echo "$as_me:$LINENO: result: $tcl_cv_strtod_unbroken" >&5 +echo "${ECHO_T}$tcl_cv_strtod_unbroken" >&6 + if test "$tcl_cv_strtod_unbroken" = "ok"; then + tcl_ok=1 + else + tcl_ok=0 + fi + fi + if test "$tcl_ok" = 0; then + case $LIBOBJS in + "strtod.$ac_objext" | \ + *" strtod.$ac_objext" | \ + "strtod.$ac_objext "* | \ + *" strtod.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strtod.$ac_objext" ;; +esac + + USE_COMPAT=1 + fi + + +#-------------------------------------------------------------------- +# Under Solaris 2.4, strtod returns the wrong value for the +# terminating character under some conditions. Check for this +# and if the problem exists use a substitute procedure +# "fixstrtod" that corrects the error. +#-------------------------------------------------------------------- + + + echo "$as_me:$LINENO: checking for strtod" >&5 +echo $ECHO_N "checking for strtod... $ECHO_C" >&6 +if test "${ac_cv_func_strtod+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. */ +/* Define strtod to an innocuous variant, in case declares strtod. + For example, HP-UX 11i declares gettimeofday. */ +#define strtod innocuous_strtod + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strtod (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef strtod + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strtod (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strtod) || defined (__stub___strtod) +choke me +#else +char (*f) () = strtod; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != strtod; + ; + 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 + ac_cv_func_strtod=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_strtod=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 +echo "${ECHO_T}$ac_cv_func_strtod" >&6 +if test $ac_cv_func_strtod = yes; then + tcl_strtod=1 +else + tcl_strtod=0 +fi + + if test "$tcl_strtod" = 1; then + echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5 +echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6 +if test "${tcl_cv_strtod_buggy+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + if test "$cross_compiling" = yes; then + tcl_cv_strtod_buggy=buggy +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + extern double strtod(); + int main() { + char *infString="Inf", *nanString="NaN", *spaceString=" "; + char *term; + double value; + value = strtod(infString, &term); + if ((term != infString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(nanString, &term); + if ((term != nanString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(spaceString, &term); + if (term == (spaceString+1)) { + exit(1); + } + exit(0); + } +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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_strtod_buggy=ok +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +tcl_cv_strtod_buggy=buggy +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5 +echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6 + if test "$tcl_cv_strtod_buggy" = buggy; then + case $LIBOBJS in + "fixstrtod.$ac_objext" | \ + *" fixstrtod.$ac_objext" | \ + "fixstrtod.$ac_objext "* | \ + *" fixstrtod.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;; +esac + + USE_COMPAT=1 + +cat >>confdefs.h <<\_ACEOF +#define strtod fixstrtod +_ACEOF + + fi + fi + + +#-------------------------------------------------------------------- +# Check for various typedefs and provide substitutes if +# they don't exist. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for mode_t" >&5 +echo $ECHO_N "checking for mode_t... $ECHO_C" >&6 +if test "${ac_cv_type_mode_t+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. */ +$ac_includes_default +int +main () +{ +if ((mode_t *) 0) + return 0; +if (sizeof (mode_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_mode_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_mode_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_mode_t" >&5 +echo "${ECHO_T}$ac_cv_type_mode_t" >&6 +if test $ac_cv_type_mode_t = yes; then + : +else + +cat >>confdefs.h <<_ACEOF +#define mode_t int +_ACEOF + +fi + +echo "$as_me:$LINENO: checking for pid_t" >&5 +echo $ECHO_N "checking for pid_t... $ECHO_C" >&6 +if test "${ac_cv_type_pid_t+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. */ +$ac_includes_default +int +main () +{ +if ((pid_t *) 0) + return 0; +if (sizeof (pid_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_pid_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_pid_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5 +echo "${ECHO_T}$ac_cv_type_pid_t" >&6 +if test $ac_cv_type_pid_t = yes; then + : +else + +cat >>confdefs.h <<_ACEOF +#define pid_t int +_ACEOF + +fi + +echo "$as_me:$LINENO: checking for size_t" >&5 +echo $ECHO_N "checking for size_t... $ECHO_C" >&6 +if test "${ac_cv_type_size_t+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. */ +$ac_includes_default +int +main () +{ +if ((size_t *) 0) + return 0; +if (sizeof (size_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_size_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_size_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5 +echo "${ECHO_T}$ac_cv_type_size_t" >&6 +if test $ac_cv_type_size_t = yes; then + : +else + +cat >>confdefs.h <<_ACEOF +#define size_t unsigned +_ACEOF + +fi + +echo "$as_me:$LINENO: checking for uid_t in sys/types.h" >&5 +echo $ECHO_N "checking for uid_t in sys/types.h... $ECHO_C" >&6 +if test "${ac_cv_type_uid_t+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. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "uid_t" >/dev/null 2>&1; then + ac_cv_type_uid_t=yes +else + ac_cv_type_uid_t=no +fi +rm -f conftest* + +fi +echo "$as_me:$LINENO: result: $ac_cv_type_uid_t" >&5 +echo "${ECHO_T}$ac_cv_type_uid_t" >&6 +if test $ac_cv_type_uid_t = no; then + +cat >>confdefs.h <<\_ACEOF +#define uid_t int +_ACEOF + + +cat >>confdefs.h <<\_ACEOF +#define gid_t int +_ACEOF + +fi + + +echo "$as_me:$LINENO: checking for socklen_t" >&5 +echo $ECHO_N "checking for socklen_t... $ECHO_C" >&6 +if test "${tcl_cv_type_socklen_t+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. */ + + #include + #include + +int +main () +{ + + socklen_t foo; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_type_socklen_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_type_socklen_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5 +echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6 +if test $tcl_cv_type_socklen_t = no; then + +cat >>confdefs.h <<\_ACEOF +#define socklen_t int +_ACEOF + +fi + +echo "$as_me:$LINENO: checking for intptr_t" >&5 +echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 +if test "${ac_cv_type_intptr_t+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. */ +$ac_includes_default +int +main () +{ +if ((intptr_t *) 0) + return 0; +if (sizeof (intptr_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_intptr_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_intptr_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 +echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 +if test $ac_cv_type_intptr_t = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_INTPTR_T 1 +_ACEOF + +else + + echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 +echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 +if test "${tcl_cv_intptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_ok=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_ok=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done +fi +echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 +echo "${ECHO_T}$tcl_cv_intptr_t" >&6 + if test "$tcl_cv_intptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define intptr_t $tcl_cv_intptr_t +_ACEOF + + fi + +fi + +echo "$as_me:$LINENO: checking for uintptr_t" >&5 +echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 +if test "${ac_cv_type_uintptr_t+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. */ +$ac_includes_default +int +main () +{ +if ((uintptr_t *) 0) + return 0; +if (sizeof (uintptr_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_type_uintptr_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_uintptr_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 +echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 +if test $ac_cv_type_uintptr_t = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_UINTPTR_T 1 +_ACEOF + +else + + echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 +echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 +if test "${tcl_cv_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_ok=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_ok=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done +fi +echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 +echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 + if test "$tcl_cv_uintptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define uintptr_t $tcl_cv_uintptr_t +_ACEOF + + fi + +fi + + +#-------------------------------------------------------------------- +# If a system doesn't have an opendir function (man, that's old!) +# then we have to supply a different version of dirent.h which +# is compatible with the substitute version of opendir that's +# provided. This version only works with V7-style directories. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for opendir" >&5 +echo $ECHO_N "checking for opendir... $ECHO_C" >&6 +if test "${ac_cv_func_opendir+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. */ +/* Define opendir to an innocuous variant, in case declares opendir. + For example, HP-UX 11i declares gettimeofday. */ +#define opendir innocuous_opendir + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char opendir (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef opendir + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char opendir (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_opendir) || defined (__stub___opendir) +choke me +#else +char (*f) () = opendir; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != opendir; + ; + 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 + ac_cv_func_opendir=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_opendir=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_opendir" >&5 +echo "${ECHO_T}$ac_cv_func_opendir" >&6 +if test $ac_cv_func_opendir = yes; then + : +else + +cat >>confdefs.h <<\_ACEOF +#define USE_DIRENT2_H 1 +_ACEOF + +fi + + +#-------------------------------------------------------------------- +# The check below checks whether defines the type +# "union wait" correctly. It's needed because of weirdness in +# HP-UX where "union wait" is defined in both the BSD and SYS-V +# environments. Checking the usability of WIFEXITED seems to do +# the trick. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking union wait" >&5 +echo $ECHO_N "checking union wait... $ECHO_C" >&6 +if test "${tcl_cv_union_wait+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. */ +#include +#include +int +main () +{ + +union wait x; +WIFEXITED(x); /* Generates compiler error if WIFEXITED + * uses an int. */ + + ; + 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_union_wait=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_union_wait=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_union_wait" >&5 +echo "${ECHO_T}$tcl_cv_union_wait" >&6 +if test $tcl_cv_union_wait = no; then + +cat >>confdefs.h <<\_ACEOF +#define NO_UNION_WAIT 1 +_ACEOF + +fi + +#-------------------------------------------------------------------- +# Check whether there is an strncasecmp function on this system. +# This is a bit tricky because under SCO it's in -lsocket and +# under Sequent Dynix it's in -linet. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for strncasecmp" >&5 +echo $ECHO_N "checking for strncasecmp... $ECHO_C" >&6 +if test "${ac_cv_func_strncasecmp+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. */ +/* Define strncasecmp to an innocuous variant, in case declares strncasecmp. + For example, HP-UX 11i declares gettimeofday. */ +#define strncasecmp innocuous_strncasecmp + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char strncasecmp (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef strncasecmp + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strncasecmp (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_strncasecmp) || defined (__stub___strncasecmp) +choke me +#else +char (*f) () = strncasecmp; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != strncasecmp; + ; + 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 + ac_cv_func_strncasecmp=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_strncasecmp=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_strncasecmp" >&5 +echo "${ECHO_T}$ac_cv_func_strncasecmp" >&6 +if test $ac_cv_func_strncasecmp = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi + +if test "$tcl_ok" = 0; then + echo "$as_me:$LINENO: checking for strncasecmp in -lsocket" >&5 +echo $ECHO_N "checking for strncasecmp in -lsocket... $ECHO_C" >&6 +if test "${ac_cv_lib_socket_strncasecmp+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strncasecmp (); +int +main () +{ +strncasecmp (); + ; + 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 + ac_cv_lib_socket_strncasecmp=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_socket_strncasecmp=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_socket_strncasecmp" >&5 +echo "${ECHO_T}$ac_cv_lib_socket_strncasecmp" >&6 +if test $ac_cv_lib_socket_strncasecmp = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi + +fi +if test "$tcl_ok" = 0; then + echo "$as_me:$LINENO: checking for strncasecmp in -linet" >&5 +echo $ECHO_N "checking for strncasecmp in -linet... $ECHO_C" >&6 +if test "${ac_cv_lib_inet_strncasecmp+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-linet $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char strncasecmp (); +int +main () +{ +strncasecmp (); + ; + 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 + ac_cv_lib_inet_strncasecmp=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_inet_strncasecmp=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_inet_strncasecmp" >&5 +echo "${ECHO_T}$ac_cv_lib_inet_strncasecmp" >&6 +if test $ac_cv_lib_inet_strncasecmp = yes; then + tcl_ok=1 +else + tcl_ok=0 +fi + +fi +if test "$tcl_ok" = 0; then + case $LIBOBJS in + "strncasecmp.$ac_objext" | \ + *" strncasecmp.$ac_objext" | \ + "strncasecmp.$ac_objext "* | \ + *" strncasecmp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" ;; +esac + + USE_COMPAT=1 +fi + +#-------------------------------------------------------------------- +# The code below deals with several issues related to gettimeofday: +# 1. Some systems don't provide a gettimeofday function at all +# (set NO_GETTOD if this is the case). +# 2. See if gettimeofday is declared in the header file. +# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can +# declare it. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for gettimeofday" >&5 +echo $ECHO_N "checking for gettimeofday... $ECHO_C" >&6 +if test "${ac_cv_func_gettimeofday+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. */ +/* Define gettimeofday to an innocuous variant, in case declares gettimeofday. + For example, HP-UX 11i declares gettimeofday. */ +#define gettimeofday innocuous_gettimeofday + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char gettimeofday (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef gettimeofday + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gettimeofday (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_gettimeofday) || defined (__stub___gettimeofday) +choke me +#else +char (*f) () = gettimeofday; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != gettimeofday; + ; + 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 + ac_cv_func_gettimeofday=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_gettimeofday=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_gettimeofday" >&5 +echo "${ECHO_T}$ac_cv_func_gettimeofday" >&6 +if test $ac_cv_func_gettimeofday = yes; then + : +else + + +cat >>confdefs.h <<\_ACEOF +#define NO_GETTOD 1 +_ACEOF + + fi - if test "$tcl_strtod" = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Solaris2.4/Tru64 strtod bugs" >&5 -$as_echo_n "checking for Solaris2.4/Tru64 strtod bugs... " >&6; } -if ${tcl_cv_strtod_buggy+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for gettimeofday declaration" >&5 +echo $ECHO_N "checking for gettimeofday declaration... $ECHO_C" >&6 +if test "${tcl_cv_grep_gettimeofday+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test "$cross_compiling" = yes; then : - tcl_cv_strtod_buggy=buggy -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +#include - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - tcl_cv_strtod_buggy=ok +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "gettimeofday" >/dev/null 2>&1; then + tcl_cv_grep_gettimeofday=present else - tcl_cv_strtod_buggy=buggy -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext + tcl_cv_grep_gettimeofday=missing fi +rm -f conftest* fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_buggy" >&5 -$as_echo "$tcl_cv_strtod_buggy" >&6; } - if test "$tcl_cv_strtod_buggy" = buggy; then - case " $LIBOBJS " in - *" fixstrtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" - ;; -esac - - USE_COMPAT=1 - -$as_echo "#define strtod fixstrtod" >>confdefs.h +echo "$as_me:$LINENO: result: $tcl_cv_grep_gettimeofday" >&5 +echo "${ECHO_T}$tcl_cv_grep_gettimeofday" >&6 +if test $tcl_cv_grep_gettimeofday = missing ; then - fi - fi +cat >>confdefs.h <<\_ACEOF +#define GETTOD_NOT_DECLARED 1 +_ACEOF +fi #-------------------------------------------------------------------- -# Check for various typedefs and provide substitutes if -# they don't exist. +# The following code checks to see whether it is possible to get +# signed chars on this platform. This is needed in order to +# properly generate sign-extended ints from character values. #-------------------------------------------------------------------- -ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" -if test "x$ac_cv_type_mode_t" = xyes; then : +echo "$as_me:$LINENO: checking whether char is unsigned" >&5 +echo $ECHO_N "checking whether char is unsigned... $ECHO_C" >&6 +if test "${ac_cv_c_char_unsigned+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. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(((char) -1) < 0)]; +test_array [0] = 0 -cat >>confdefs.h <<_ACEOF -#define mode_t int + ; + return 0; +} _ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_cv_c_char_unsigned=no +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +ac_cv_c_char_unsigned=yes +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi +echo "$as_me:$LINENO: result: $ac_cv_c_char_unsigned" >&5 +echo "${ECHO_T}$ac_cv_c_char_unsigned" >&6 +if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then + cat >>confdefs.h <<\_ACEOF +#define __CHAR_UNSIGNED__ 1 +_ACEOF -ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" -if test "x$ac_cv_type_pid_t" = xyes; then : +fi +echo "$as_me:$LINENO: checking signed char declarations" >&5 +echo $ECHO_N "checking signed char declarations... $ECHO_C" >&6 +if test "${tcl_cv_char_signed+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else -cat >>confdefs.h <<_ACEOF -#define pid_t int + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ -fi +int +main () +{ -ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" -if test "x$ac_cv_type_size_t" = xyes; then : + signed char *p; + p = 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_char_signed=yes else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -cat >>confdefs.h <<_ACEOF -#define size_t unsigned int +tcl_cv_char_signed=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_char_signed" >&5 +echo "${ECHO_T}$tcl_cv_char_signed" >&6 +if test $tcl_cv_char_signed = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_SIGNED_CHAR 1 _ACEOF fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5 -$as_echo_n "checking for uid_t in sys/types.h... " >&6; } -if ${ac_cv_type_uid_t+:} false; then : - $as_echo_n "(cached) " >&6 +#-------------------------------------------------------------------- +# Does putenv() copy or not? We need to know to avoid memory leaks. +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking for a putenv() that copies the buffer" >&5 +echo $ECHO_N "checking for a putenv() that copies the buffer... $ECHO_C" >&6 +if test "${tcl_cv_putenv_copy+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + if test "$cross_compiling" = yes; then + tcl_cv_putenv_copy=no else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include + + #include + #define OURVAR "havecopy=yes" + int main (int argc, char *argv[]) + { + char *foo, *bar; + foo = (char *)strdup(OURVAR); + putenv(foo); + strcpy((char *)(strchr(foo, '=') + 1), "no"); + bar = getenv("havecopy"); + if (!strcmp(bar, "no")) { + /* doesnt copy */ + return 0; + } else { + /* does copy */ + return 1; + } + } _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "uid_t" >/dev/null 2>&1; then : - ac_cv_type_uid_t=yes +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./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_putenv_copy=no else - ac_cv_type_uid_t=no -fi -rm -f conftest* + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +( exit $ac_status ) +tcl_cv_putenv_copy=yes fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5 -$as_echo "$ac_cv_type_uid_t" >&6; } -if test $ac_cv_type_uid_t = no; then - -$as_echo "#define uid_t int" >>confdefs.h - +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +echo "$as_me:$LINENO: result: $tcl_cv_putenv_copy" >&5 +echo "${ECHO_T}$tcl_cv_putenv_copy" >&6 +if test $tcl_cv_putenv_copy = yes; then -$as_echo "#define gid_t int" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_PUTENV_THAT_COPIES 1 +_ACEOF fi +#-------------------------------------------------------------------- +# Check for support of nl_langinfo function +#-------------------------------------------------------------------- + -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t" >&5 -$as_echo_n "checking for socklen_t... " >&6; } -if ${tcl_cv_type_socklen_t+:} false; then : - $as_echo_n "(cached) " >&6 + # Check whether --enable-langinfo or --disable-langinfo was given. +if test "${enable_langinfo+set}" = set; then + enableval="$enable_langinfo" + langinfo_ok=$enableval else + langinfo_ok=yes +fi; - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + HAVE_LANGINFO=0 + if test "$langinfo_ok" = "yes"; then + if test "${ac_cv_header_langinfo_h+set}" = set; then + echo "$as_me:$LINENO: checking for langinfo.h" >&5 +echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 +if test "${ac_cv_header_langinfo_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 +echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking langinfo.h usability" >&5 +echo $ECHO_N "checking langinfo.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - #include - #include - -int -main () -{ - - socklen_t foo; +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 - ; - return 0; -} +# Is the header present? +echo "$as_me:$LINENO: checking langinfo.h presence" >&5 +echo $ECHO_N "checking langinfo.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_type_socklen_t=yes +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - tcl_cv_type_socklen_t=no + ac_cpp_err=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_socklen_t" >&5 -$as_echo "$tcl_cv_type_socklen_t" >&6; } -if test $tcl_cv_type_socklen_t = no; then - -$as_echo "#define socklen_t int" >>confdefs.h +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + ac_header_preproc=no fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 -ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default" -if test "x$ac_cv_type_intptr_t" = xyes; then : - - -$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: langinfo.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: langinfo.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: langinfo.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: langinfo.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: langinfo.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: langinfo.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: langinfo.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: langinfo.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: langinfo.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: langinfo.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for langinfo.h" >&5 +echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6 +if test "${ac_cv_header_langinfo_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_langinfo_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5 +echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6 +fi +if test $ac_cv_header_langinfo_h = yes; then + langinfo_ok=yes else + langinfo_ok=no +fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5 -$as_echo_n "checking for pointer-size signed integer type... " >&6; } -if ${tcl_cv_intptr_t+:} false; then : - $as_echo_n "(cached) " >&6 + + fi + echo "$as_me:$LINENO: checking whether to use nl_langinfo" >&5 +echo $ECHO_N "checking whether to use nl_langinfo... $ECHO_C" >&6 + if test "$langinfo_ok" = "yes"; then + if test "${tcl_cv_langinfo_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - for tcl_cv_intptr_t in "int" "long" "long long" none; do - if test "$tcl_cv_intptr_t" != none; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -$ac_includes_default +#include int main () { -static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; -test_array [0] = 0; -return test_array [0]; - +nl_langinfo(CODESET); ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_ok=yes +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_langinfo_h=yes else - tcl_ok=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_langinfo_h=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$tcl_ok" = yes && break; fi - done +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5 -$as_echo "$tcl_cv_intptr_t" >&6; } - if test "$tcl_cv_intptr_t" != none; then -cat >>confdefs.h <<_ACEOF -#define intptr_t $tcl_cv_intptr_t + echo "$as_me:$LINENO: result: $tcl_cv_langinfo_h" >&5 +echo "${ECHO_T}$tcl_cv_langinfo_h" >&6 + if test $tcl_cv_langinfo_h = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_LANGINFO 1 _ACEOF + fi + else + echo "$as_me:$LINENO: result: $langinfo_ok" >&5 +echo "${ECHO_T}$langinfo_ok" >&6 fi -fi -ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default" -if test "x$ac_cv_type_uintptr_t" = xyes; then : +#-------------------------------------------------------------------- +# Check for support of chflags and mkstemps functions +#-------------------------------------------------------------------- -$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h -else +for ac_func in chflags mkstemps +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5 -$as_echo_n "checking for pointer-size unsigned integer type... " >&6; } -if ${tcl_cv_uintptr_t+:} false; then : - $as_echo_n "(cached) " >&6 -else +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif - for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ - none; do - if test "$tcl_cv_uintptr_t" != none; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default int main () { -static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; -test_array [0] = 0; -return test_array [0]; - +return f != $ac_func; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_ok=yes +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 + eval "$as_ac_var=yes" else - tcl_ok=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$tcl_ok" = yes && break; fi - done +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5 -$as_echo "$tcl_cv_uintptr_t" >&6; } - if test "$tcl_cv_uintptr_t" != none; then - -cat >>confdefs.h <<_ACEOF -#define uintptr_t $tcl_cv_uintptr_t +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF - fi - -fi - - -#-------------------------------------------------------------------- -# If a system doesn't have an opendir function (man, that's old!) -# then we have to supply a different version of dirent.h which -# is compatible with the substitute version of opendir that's -# provided. This version only works with V7-style directories. -#-------------------------------------------------------------------- - -ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir" -if test "x$ac_cv_func_opendir" = xyes; then : - -else - -$as_echo "#define USE_DIRENT2_H 1" >>confdefs.h - fi +done #-------------------------------------------------------------------- -# The check below checks whether defines the type -# "union wait" correctly. It's needed because of weirdness in -# HP-UX where "union wait" is defined in both the BSD and SYS-V -# environments. Checking the usability of WIFEXITED seems to do -# the trick. +# Check for support of isnan() function or macro #-------------------------------------------------------------------- -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking union wait" >&5 -$as_echo_n "checking union wait... " >&6; } -if ${tcl_cv_union_wait+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking isnan" >&5 +echo $ECHO_N "checking isnan... $ECHO_C" >&6 +if test "${tcl_cv_isnan+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include -#include +#include int main () { -union wait x; -WIFEXITED(x); /* Generates compiler error if WIFEXITED - * uses an int. */ +isnan(0.0); /* Generates an error if isnan is missing */ ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - tcl_cv_union_wait=yes +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_isnan=yes else - tcl_cv_union_wait=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_isnan=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_union_wait" >&5 -$as_echo "$tcl_cv_union_wait" >&6; } -if test $tcl_cv_union_wait = no; then +echo "$as_me:$LINENO: result: $tcl_cv_isnan" >&5 +echo "${ECHO_T}$tcl_cv_isnan" >&6 +if test $tcl_cv_isnan = no; then -$as_echo "#define NO_UNION_WAIT 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define NO_ISNAN 1 +_ACEOF fi #-------------------------------------------------------------------- -# Check whether there is an strncasecmp function on this system. -# This is a bit tricky because under SCO it's in -lsocket and -# under Sequent Dynix it's in -linet. +# Darwin specific API checks and defines #-------------------------------------------------------------------- -ac_fn_c_check_func "$LINENO" "strncasecmp" "ac_cv_func_strncasecmp" -if test "x$ac_cv_func_strncasecmp" = xyes; then : - tcl_ok=1 -else - tcl_ok=0 -fi +if test "`uname -s`" = "Darwin" ; then -if test "$tcl_ok" = 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -lsocket" >&5 -$as_echo_n "checking for strncasecmp in -lsocket... " >&6; } -if ${ac_cv_lib_socket_strncasecmp+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lsocket $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +for ac_func in getattrlist +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" +{ #endif -char strncasecmp (); +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + int main () { -return strncasecmp (); +return f != $ac_func; ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_socket_strncasecmp=yes +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 + eval "$as_ac_var=yes" else - ac_cv_lib_socket_strncasecmp=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_strncasecmp" >&5 -$as_echo "$ac_cv_lib_socket_strncasecmp" >&6; } -if test "x$ac_cv_lib_socket_strncasecmp" = xyes; then : - tcl_ok=1 -else - tcl_ok=0 +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + fi +done + +for ac_header in copyfile.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 fi -if test "$tcl_ok" = 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -linet" >&5 -$as_echo_n "checking for strncasecmp in -linet... " >&6; } -if ${ac_cv_lib_inet_strncasecmp+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else - ac_check_lib_save_LIBS=$LIBS -LIBS="-linet $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char strncasecmp (); -int -main () -{ -return strncasecmp (); - ; - return 0; -} +$ac_includes_default +#include <$ac_header> _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_inet_strncasecmp=yes -else - ac_cv_lib_inet_strncasecmp=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_strncasecmp" >&5 -$as_echo "$ac_cv_lib_inet_strncasecmp" >&6; } -if test "x$ac_cv_lib_inet_strncasecmp" = xyes; then : - tcl_ok=1 +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes else - tcl_ok=0 -fi - -fi -if test "$tcl_ok" = 0; then - case " $LIBOBJS " in - *" strncasecmp.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" - ;; -esac + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - USE_COMPAT=1 +ac_header_compiler=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 -#-------------------------------------------------------------------- -# The code below deals with several issues related to gettimeofday: -# 1. Some systems don't provide a gettimeofday function at all -# (set NO_GETTOD if this is the case). -# 2. See if gettimeofday is declared in the header file. -# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can -# declare it. -#-------------------------------------------------------------------- - -ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" -if test "x$ac_cv_func_gettimeofday" = xyes; then : - +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - - -$as_echo "#define NO_GETTOD 1" >>confdefs.h - - + ac_cpp_err=yes fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 -$as_echo_n "checking for gettimeofday declaration... " >&6; } -if ${tcl_cv_grep_gettimeofday+:} false; then : - $as_echo_n "(cached) " >&6 +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "gettimeofday" >/dev/null 2>&1; then : - tcl_cv_grep_gettimeofday=present +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - tcl_cv_grep_gettimeofday=missing + eval "$as_ac_Header=\$ac_header_preproc" fi -rm -f conftest* +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5 -$as_echo "$tcl_cv_grep_gettimeofday" >&6; } -if test $tcl_cv_grep_gettimeofday = missing ; then - -$as_echo "#define GETTOD_NOT_DECLARED 1" >>confdefs.h +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF fi -#-------------------------------------------------------------------- -# The following code checks to see whether it is possible to get -# signed chars on this platform. This is needed in order to -# properly generate sign-extended ints from character values. -#-------------------------------------------------------------------- +done -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether char is unsigned" >&5 -$as_echo_n "checking whether char is unsigned... " >&6; } -if ${ac_cv_c_char_unsigned+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -static int test_array [1 - 2 * !(((char) -1) < 0)]; -test_array [0] = 0; -return test_array [0]; - ; - return 0; -} +for ac_func in copyfile +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_char_unsigned=no -else - ac_cv_c_char_unsigned=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_char_unsigned" >&5 -$as_echo "$ac_cv_c_char_unsigned" >&6; } -if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then - $as_echo "#define __CHAR_UNSIGNED__ 1" >>confdefs.h +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func -fi +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking signed char declarations" >&5 -$as_echo_n "checking signed char declarations... " >&6; } -if ${tcl_cv_char_signed+:} false; then : - $as_echo_n "(cached) " >&6 -else +#ifdef __STDC__ +# include +#else +# include +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif int main () { - - signed char *p; - p = 0; - +return f != $ac_func; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_char_signed=yes +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 + eval "$as_ac_var=yes" else - tcl_cv_char_signed=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_char_signed" >&5 -$as_echo "$tcl_cv_char_signed" >&6; } -if test $tcl_cv_char_signed = yes; then - -$as_echo "#define HAVE_SIGNED_CHAR 1" >>confdefs.h +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF fi +done -#-------------------------------------------------------------------- -# Does putenv() copy or not? We need to know to avoid memory leaks. -#-------------------------------------------------------------------- - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a putenv() that copies the buffer" >&5 -$as_echo_n "checking for a putenv() that copies the buffer... " >&6; } -if ${tcl_cv_putenv_copy+:} false; then : - $as_echo_n "(cached) " >&6 -else + if test $tcl_corefoundation = yes; then - if test "$cross_compiling" = yes; then : - tcl_cv_putenv_copy=no +for ac_header in libkern/OSAtomic.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 - #include - #define OURVAR "havecopy=yes" - int main (int argc, char *argv[]) - { - char *foo, *bar; - foo = (char *)strdup(OURVAR); - putenv(foo); - strcpy((char *)(strchr(foo, '=') + 1), "no"); - bar = getenv("havecopy"); - if (!strcmp(bar, "no")) { - /* doesnt copy */ - return 0; - } else { - /* does copy */ - return 1; - } - } +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - tcl_cv_putenv_copy=no +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - tcl_cv_putenv_copy=yes + ac_cpp_err=yes fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5 -$as_echo "$tcl_cv_putenv_copy" >&6; } -if test $tcl_cv_putenv_copy = yes; then +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -$as_echo "#define HAVE_PUTENV_THAT_COPIES 1" >>confdefs.h +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF fi -#-------------------------------------------------------------------- -# Check for support of nl_langinfo function -#-------------------------------------------------------------------- +done - # Check whether --enable-langinfo was given. -if test "${enable_langinfo+set}" = set; then : - enableval=$enable_langinfo; langinfo_ok=$enableval -else - langinfo_ok=yes -fi +for ac_func in OSSpinLockLock +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+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. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ - HAVE_LANGINFO=0 - if test "$langinfo_ok" = "yes"; then - ac_fn_c_check_header_mongrel "$LINENO" "langinfo.h" "ac_cv_header_langinfo_h" "$ac_includes_default" -if test "x$ac_cv_header_langinfo_h" = xyes; then : - langinfo_ok=yes -else - langinfo_ok=no -fi +#ifdef __STDC__ +# include +#else +# include +#endif +#undef $ac_func - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use nl_langinfo" >&5 -$as_echo_n "checking whether to use nl_langinfo... " >&6; } - if test "$langinfo_ok" = "yes"; then - if ${tcl_cv_langinfo_h+:} false; then : - $as_echo_n "(cached) " >&6 -else +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include int main () { -nl_langinfo(CODESET); +return f != $ac_func; ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - tcl_cv_langinfo_h=yes +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 + eval "$as_ac_var=yes" else - tcl_cv_langinfo_h=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_langinfo_h" >&5 -$as_echo "$tcl_cv_langinfo_h" >&6; } - if test $tcl_cv_langinfo_h = yes; then - -$as_echo "#define HAVE_LANGINFO 1" >>confdefs.h - - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $langinfo_ok" >&5 -$as_echo "$langinfo_ok" >&6; } - fi - - -#-------------------------------------------------------------------- -# Check for support of chflags and mkstemps functions -#-------------------------------------------------------------------- - -for ac_func in chflags mkstemps -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done + fi -#-------------------------------------------------------------------- -# Check for support of isnan() function or macro -#-------------------------------------------------------------------- - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking isnan" >&5 -$as_echo_n "checking isnan... " >&6; } -if ${tcl_cv_isnan+:} false; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - -isnan(0.0); /* Generates an error if isnan is missing */ - - ; - return 0; -} +cat >>confdefs.h <<\_ACEOF +#define USE_VFORK 1 _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - tcl_cv_isnan=yes -else - tcl_cv_isnan=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_isnan" >&5 -$as_echo "$tcl_cv_isnan" >&6; } -if test $tcl_cv_isnan = no; then - -$as_echo "#define NO_ISNAN 1" >>confdefs.h - -fi -#-------------------------------------------------------------------- -# Darwin specific API checks and defines -#-------------------------------------------------------------------- -if test "`uname -s`" = "Darwin" ; then - for ac_func in getattrlist -do : - ac_fn_c_check_func "$LINENO" "getattrlist" "ac_cv_func_getattrlist" -if test "x$ac_cv_func_getattrlist" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETATTRLIST 1 +cat >>confdefs.h <<\_ACEOF +#define TCL_DEFAULT_ENCODING "utf-8" _ACEOF -fi -done - for ac_header in copyfile.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "copyfile.h" "ac_cv_header_copyfile_h" "$ac_includes_default" -if test "x$ac_cv_header_copyfile_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_COPYFILE_H 1 +cat >>confdefs.h <<\_ACEOF +#define TCL_LOAD_FROM_MEMORY 1 _ACEOF -fi - -done - for ac_func in copyfile -do : - ac_fn_c_check_func "$LINENO" "copyfile" "ac_cv_func_copyfile" -if test "x$ac_cv_func_copyfile" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_COPYFILE 1 +cat >>confdefs.h <<\_ACEOF +#define TCL_WIDE_CLICKS 1 _ACEOF -fi -done - if test $tcl_corefoundation = yes; then - for ac_header in libkern/OSAtomic.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "libkern/OSAtomic.h" "ac_cv_header_libkern_OSAtomic_h" "$ac_includes_default" -if test "x$ac_cv_header_libkern_OSAtomic_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBKERN_OSATOMIC_H 1 +for ac_header in AvailabilityMacros.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +ac_header_compiler=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 -done - - for ac_func in OSSpinLockLock -do : - ac_fn_c_check_func "$LINENO" "OSSpinLockLock" "ac_cv_func_OSSpinLockLock" -if test "x$ac_cv_func_OSSpinLockLock" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_OSSPINLOCKLOCK 1 +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ _ACEOF - +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes fi -done - - fi - -$as_echo "#define USE_VFORK 1" >>confdefs.h - - -$as_echo "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h - - -$as_echo "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 -$as_echo "#define TCL_WIDE_CLICKS 1" >>confdefs.h +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 - for ac_header in AvailabilityMacros.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "AvailabilityMacros.h" "ac_cv_header_AvailabilityMacros_h" "$ac_includes_default" -if test "x$ac_cv_header_AvailabilityMacros_h" = xyes; then : +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define HAVE_AVAILABILITYMACROS_H 1 +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -9831,14 +18064,18 @@ fi done if test "$ac_cv_header_AvailabilityMacros_h" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if weak import is available" >&5 -$as_echo_n "checking if weak import is available... " >&6; } -if ${tcl_cv_cc_weak_import+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if weak import is available" >&5 +echo $ECHO_N "checking if weak import is available... $ECHO_C" >&6 +if test "${tcl_cv_cc_weak_import+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ @@ -9858,30 +18095,60 @@ rand(); return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_cc_weak_import=yes else - tcl_cv_cc_weak_import=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_weak_import=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_weak_import" >&5 -$as_echo "$tcl_cv_cc_weak_import" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_cc_weak_import" >&5 +echo "${ECHO_T}$tcl_cv_cc_weak_import" >&6 if test $tcl_cv_cc_weak_import = yes; then -$as_echo "#define HAVE_WEAK_IMPORT 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_WEAK_IMPORT 1 +_ACEOF fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Darwin SUSv3 extensions are available" >&5 -$as_echo_n "checking if Darwin SUSv3 extensions are available... " >&6; } -if ${tcl_cv_cc_darwin_c_source+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking if Darwin SUSv3 extensions are available" >&5 +echo $ECHO_N "checking if Darwin SUSv3 extensions are available... $ECHO_C" >&6 +if test "${tcl_cv_cc_darwin_c_source+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ @@ -9902,19 +18169,45 @@ main () return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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_cc_darwin_c_source=yes else - tcl_cv_cc_darwin_c_source=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cc_darwin_c_source=no fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$hold_cflags fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_darwin_c_source" >&5 -$as_echo "$tcl_cv_cc_darwin_c_source" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_cc_darwin_c_source" >&5 +echo "${ECHO_T}$tcl_cv_cc_darwin_c_source" >&6 if test $tcl_cv_cc_darwin_c_source = yes; then -$as_echo "#define _DARWIN_C_SOURCE 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define _DARWIN_C_SOURCE 1 +_ACEOF fi fi @@ -9930,13 +18223,17 @@ fi # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fts" >&5 -$as_echo_n "checking for fts... " >&6; } -if ${tcl_cv_api_fts+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for fts" >&5 +echo $ECHO_N "checking for fts... $ECHO_C" >&6 +if test "${tcl_cv_api_fts+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include @@ -9955,19 +18252,45 @@ main () return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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_api_fts=yes else - tcl_cv_api_fts=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_api_fts=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_fts" >&5 -$as_echo "$tcl_cv_api_fts" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_api_fts" >&5 +echo "${ECHO_T}$tcl_cv_api_fts" >&6 if test $tcl_cv_api_fts = yes; then -$as_echo "#define HAVE_FTS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_FTS 1 +_ACEOF fi @@ -9978,24 +18301,300 @@ fi #-------------------------------------------------------------------- - for ac_header in sys/ioctl.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_ioctl_h" = xyes; then : + +for ac_header in sys/ioctl.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_IOCTL_H 1 +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done - for ac_header in sys/filio.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/filio.h" "ac_cv_header_sys_filio_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_filio_h" = xyes; then : + +for ac_header in sys/filio.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_FILIO_H 1 +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi @@ -10003,10 +18602,10 @@ fi done - { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 -$as_echo_n "checking system version... " >&6; } -if ${tcl_cv_sys_version+:} false; then : - $as_echo_n "(cached) " >&6 + echo "$as_me:$LINENO: checking system version" >&5 +echo $ECHO_N "checking system version... $ECHO_C" >&6 +if test "${tcl_cv_sys_version+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -f /usr/lib/NextStep/software_version; then @@ -10014,8 +18613,8 @@ else else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 -$as_echo "$as_me: WARNING: can't find uname command" >&2;} + { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5 +echo "$as_me: WARNING: can't find uname command" >&2;} tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird @@ -10031,52 +18630,58 @@ $as_echo "$as_me: WARNING: can't find uname command" >&2;} fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 -$as_echo "$tcl_cv_sys_version" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5 +echo "${ECHO_T}$tcl_cv_sys_version" >&6 system=$tcl_cv_sys_version - { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 -$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } + echo "$as_me:$LINENO: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 +echo $ECHO_N "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... $ECHO_C" >&6 case $system in OSF*) -$as_echo "#define USE_FIONBIO 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define USE_FIONBIO 1 +_ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 -$as_echo "FIONBIO" >&6; } + echo "$as_me:$LINENO: result: FIONBIO" >&5 +echo "${ECHO_T}FIONBIO" >&6 ;; SunOS-4*) -$as_echo "#define USE_FIONBIO 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define USE_FIONBIO 1 +_ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 -$as_echo "FIONBIO" >&6; } + echo "$as_me:$LINENO: result: FIONBIO" >&5 +echo "${ECHO_T}FIONBIO" >&6 ;; *) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5 -$as_echo "O_NONBLOCK" >&6; } + echo "$as_me:$LINENO: result: O_NONBLOCK" >&5 +echo "${ECHO_T}O_NONBLOCK" >&6 ;; esac #------------------------------------------------------------------------ -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use dll unloading" >&5 -$as_echo_n "checking whether to use dll unloading... " >&6; } -# Check whether --enable-dll-unloading was given. -if test "${enable_dll_unloading+set}" = set; then : - enableval=$enable_dll_unloading; tcl_ok=$enableval +echo "$as_me:$LINENO: checking whether to use dll unloading" >&5 +echo $ECHO_N "checking whether to use dll unloading... $ECHO_C" >&6 +# Check whether --enable-dll-unloading or --disable-dll-unloading was given. +if test "${enable_dll_unloading+set}" = set; then + enableval="$enable_dll_unloading" + tcl_ok=$enableval else tcl_ok=yes -fi - +fi; if test $tcl_ok = yes; then -$as_echo "#define TCL_UNLOAD_DLLS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_UNLOAD_DLLS 1 +_ACEOF fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 -$as_echo "$tcl_ok" >&6; } +echo "$as_me:$LINENO: result: $tcl_ok" >&5 +echo "${ECHO_T}$tcl_ok" >&6 #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has @@ -10084,31 +18689,31 @@ $as_echo "$tcl_ok" >&6; } # be overriden on the configure command line either way. #------------------------------------------------------------------------ -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5 -$as_echo_n "checking for timezone data... " >&6; } +echo "$as_me:$LINENO: checking for timezone data" >&5 +echo $ECHO_N "checking for timezone data... $ECHO_C" >&6 -# Check whether --with-tzdata was given. -if test "${with_tzdata+set}" = set; then : - withval=$with_tzdata; tcl_ok=$withval +# Check whether --with-tzdata or --without-tzdata was given. +if test "${with_tzdata+set}" = set; then + withval="$with_tzdata" + tcl_ok=$withval else tcl_ok=auto -fi - +fi; # # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # case $tcl_ok in no) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by OS vendor" >&5 -$as_echo "supplied by OS vendor" >&6; } + echo "$as_me:$LINENO: result: supplied by OS vendor" >&5 +echo "${ECHO_T}supplied by OS vendor" >&6 ;; yes) # nothing to do here ;; auto*) - if ${tcl_cv_dir_zoneinfo+:} false; then : - $as_echo_n "(cached) " >&6 + if test "${tcl_cv_dir_zoneinfo+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else for dir in /usr/share/zoneinfo \ @@ -10125,20 +18730,22 @@ fi if test -n "$tcl_cv_dir_zoneinfo"; then tcl_ok=no - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $dir" >&5 -$as_echo "$dir" >&6; } + echo "$as_me:$LINENO: result: $dir" >&5 +echo "${ECHO_T}$dir" >&6 else tcl_ok=yes fi ;; *) - as_fn_error $? "invalid argument: $tcl_ok" "$LINENO" 5 + { { echo "$as_me:$LINENO: error: invalid argument: $tcl_ok" >&5 +echo "$as_me: error: invalid argument: $tcl_ok" >&2;} + { (exit 1); exit 1; }; } ;; esac if test $tcl_ok = yes then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by Tcl" >&5 -$as_echo "supplied by Tcl" >&6; } + echo "$as_me:$LINENO: result: supplied by Tcl" >&5 +echo "${ECHO_T}supplied by Tcl" >&6 INSTALL_TZDATA=install-tzdata fi @@ -10146,16 +18753,152 @@ fi # DTrace support #-------------------------------------------------------------------- -# Check whether --enable-dtrace was given. -if test "${enable_dtrace+set}" = set; then : - enableval=$enable_dtrace; tcl_ok=$enableval +# Check whether --enable-dtrace or --disable-dtrace was given. +if test "${enable_dtrace+set}" = set; then + enableval="$enable_dtrace" + tcl_ok=$enableval else tcl_ok=no +fi; +if test $tcl_ok = yes; then + if test "${ac_cv_header_sys_sdt_h+set}" = set; then + echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 +echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 +if test "${ac_cv_header_sys_sdt_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 +echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking sys/sdt.h usability" >&5 +echo $ECHO_N "checking sys/sdt.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 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_objext' + { (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 + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 -if test $tcl_ok = yes; then - ac_fn_c_check_header_mongrel "$LINENO" "sys/sdt.h" "ac_cv_header_sys_sdt_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_sdt_h" = xyes; then : +# Is the header present? +echo "$as_me:$LINENO: checking sys/sdt.h presence" >&5 +echo $ECHO_N "checking sys/sdt.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: sys/sdt.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: sys/sdt.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: sys/sdt.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for sys/sdt.h" >&5 +echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6 +if test "${ac_cv_header_sys_sdt_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_sys_sdt_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5 +echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6 + +fi +if test $ac_cv_header_sys_sdt_h = yes; then tcl_ok=yes else tcl_ok=no @@ -10166,10 +18909,10 @@ fi if test $tcl_ok = yes; then # Extract the first word of "dtrace", so it can be a program name with args. set dummy dtrace; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_DTRACE+:} false; then : - $as_echo_n "(cached) " >&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_path_DTRACE+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else case $DTRACE in [\\/]* | ?:[\\/]*) @@ -10182,37 +18925,38 @@ for as_dir in $as_dummy do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_DTRACE="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done ;; esac fi DTRACE=$ac_cv_path_DTRACE + if test -n "$DTRACE"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5 -$as_echo "$DTRACE" >&6; } + echo "$as_me:$LINENO: result: $DTRACE" >&5 +echo "${ECHO_T}$DTRACE" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable DTrace support" >&5 -$as_echo_n "checking whether to enable DTrace support... " >&6; } +echo "$as_me:$LINENO: checking whether to enable DTrace support" >&5 +echo $ECHO_N "checking whether to enable DTrace support... $ECHO_C" >&6 MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then -$as_echo "#define USE_DTRACE 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define USE_DTRACE 1 +_ACEOF DTRACE_SRC="\${DTRACE_SRC}" DTRACE_HDR="\${DTRACE_HDR}" @@ -10230,20 +18974,24 @@ $as_echo "#define USE_DTRACE 1" >>confdefs.h fi fi fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 -$as_echo "$tcl_ok" >&6; } +echo "$as_me:$LINENO: result: $tcl_ok" >&5 +echo "${ECHO_T}$tcl_ok" >&6 #-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5 -$as_echo_n "checking whether the cpuid instruction is usable... " >&6; } -if ${tcl_cv_cpuid+:} false; then : - $as_echo_n "(cached) " >&6 +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 confdefs.h - <<_ACEOF >conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int @@ -10262,19 +19010,45 @@ main () return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +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 - tcl_cv_cpuid=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cpuid=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cpuid" >&5 -$as_echo "$tcl_cv_cpuid" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_cpuid" >&5 +echo "${ECHO_T}$tcl_cv_cpuid" >&6 if test $tcl_cv_cpuid = yes; then -$as_echo "#define HAVE_CPUID 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_CPUID 1 +_ACEOF fi @@ -10305,38 +19079,38 @@ HTML_DIR='$(DISTDIR)/html' if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to package libraries" >&5 -$as_echo_n "checking how to package libraries... " >&6; } - # Check whether --enable-framework was given. -if test "${enable_framework+set}" = set; then : - enableval=$enable_framework; enable_framework=$enableval + echo "$as_me:$LINENO: checking how to package libraries" >&5 +echo $ECHO_N "checking how to package libraries... $ECHO_C" >&6 + # Check whether --enable-framework or --disable-framework was given. +if test "${enable_framework+set}" = set; then + enableval="$enable_framework" + enable_framework=$enableval else enable_framework=no -fi - +fi; if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 -$as_echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} + { echo "$as_me:$LINENO: WARNING: Frameworks can only be built if --enable-shared is yes" >&5 +echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;} enable_framework=no fi if test $tcl_corefoundation = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 -$as_echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} + { echo "$as_me:$LINENO: WARNING: Frameworks can only be used when CoreFoundation is available" >&5 +echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;} enable_framework=no fi fi if test $enable_framework = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: framework" >&5 -$as_echo "framework" >&6; } + echo "$as_me:$LINENO: result: framework" >&5 +echo "${ECHO_T}framework" >&6 FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared library" >&5 -$as_echo "shared library" >&6; } + echo "$as_me:$LINENO: result: shared library" >&5 +echo "${ECHO_T}shared library" >&6 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: static library" >&5 -$as_echo "static library" >&6; } + echo "$as_me:$LINENO: result: static library" >&5 +echo "${ECHO_T}static library" >&6 fi FRAMEWORK_BUILD=0 fi @@ -10348,18 +19122,20 @@ $as_echo "static library" >&6; } TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' - ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" + ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" TCL_YEAR="`date +%Y`" fi if test "$FRAMEWORK_BUILD" = "1" ; then -$as_echo "#define TCL_FRAMEWORK 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_FRAMEWORK 1 +_ACEOF # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work - ac_config_commands="$ac_config_commands Tcl.framework" + ac_config_commands="$ac_config_commands Tcl.framework" LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" # default install directory for bundled packages @@ -10429,29 +19205,6 @@ fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl -# core vfs and kit support. -#-------------------------------------------------------------------- - -eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" -eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" - -eval "TCL_KIT_LIB_FILE=libtclkit${TCL_UNSHARED_LIB_SUFFIX}" -eval "TCL_KIT_LIB_FILE=\"${TCL_KIT_LIB_FILE}\"" -eval "TCL_KIT_LIB_DIR=${libdir}" - -if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TCL_KIT_LIB_FLAG="-ltclkit${TCL_VERSION}" -else - TCL_KIT_LIB_FLAG="-ltclkit`echo ${TCL_VERSION} | tr -d .`" -fi - -TCL_BUILD_KIT_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_KIT_LIB_FLAG}" -TCL_KIT_LIB_SPEC="-L${TCL_KIT_LIB_DIR} ${TCL_KIT_LIB_FLAG}" -TCL_BUILD_KIT_LIB_PATH="`pwd`/${TCL_KIT_LIB_FILE}" -TCL_KIT_LIB_PATH="${TCL_KIT_LIB_DIR}/${TCL_KIT_LIB_FILE}" - -#-------------------------------------------------------------------- -# The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- @@ -10542,16 +19295,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD} - - - - - - - - - -ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -10571,70 +19315,39 @@ _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. -# So, we kill variables containing newlines. +# So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -( - for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - +{ (set) 2>&1 | - case $as_nl`(ac_space=' '; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \. + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" - ;; #( + ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; - esac | - sort -) | + esac; +} | sed ' - /^ac_cv_env_/b end t clear - :clear + : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end - s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - :end' >>confcache -if diff "$cache_file" confcache >/dev/null 2>&1; then :; else - if test -w "$cache_file"; then - if test "x$cache_file" != "x/dev/null"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 -$as_echo "$as_me: updating cache $cache_file" >&6;} - if test ! -f "$cache_file" || test -h "$cache_file"; then - cat confcache >"$cache_file" - else - case $cache_file in #( - */* | ?:*) - mv -f confcache "$cache_file"$$ && - mv -f "$cache_file"$$ "$cache_file" ;; #( - *) - mv -f confcache "$cache_file" ;; - esac - fi - fi + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else + if test -w $cache_file; then + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file else - { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 -$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + echo "not updating unwritable cache $cache_file" fi fi rm -f confcache @@ -10643,56 +19356,63 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' +fi + # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that -# take arguments), then branch to the quote section. Otherwise, +# take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. -ac_script=' -:mline -/\\$/{ - N - s,\\\n,, - b mline -} +cat >confdef2opt.sed <<\_ACEOF t clear -:clear -s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote -s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote -b any -:quote -s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g -s/\[/\\&/g -s/\]/\\&/g -s/\$/$$/g -H -:any -${ - g - s/^\n// - s/\n/ /g - p -} -' -DEFS=`sed -n "$ac_script" confdefs.h` +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" - -: "${CONFIG_STATUS=./config.status}" -ac_write_fail=0 +: ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 -$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} -as_write_fail=0 -cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. @@ -10702,253 +19422,81 @@ cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 debug=false ac_cs_recheck=false ac_cs_silent=false - SHELL=\${CONFIG_SHELL-$SHELL} -export SHELL -_ASEOF -cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix fi +DUALCASE=1; export DUALCASE # for MKS sh +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi -as_me=`$as_basename -- "$0" || +# Name of the executable. +as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + +# PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' @@ -10956,111 +19504,148 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' else - as_ln_s='cp -pR' + PATH_SEPARATOR=: fi -else - as_ln_s='cp -pR' + rm -f conf$$.sh fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done - case $as_dir in #( - -*) as_dir=./$as_dir;; + ;; esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file -} # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' + as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -as_test_x='test -x' -as_executable_p=as_fn_executable_p +as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -11069,20 +19654,31 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + exec 6>&1 -## ----------------------------------- ## -## Main body of $CONFIG_STATUS script. ## -## ----------------------------------- ## -_ASEOF -test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Save the log message, to keep $0 and so on meaningful, and to + +# Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. -ac_log=" +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + This file was extended by tcl $as_me 8.6, which was -generated by GNU Autoconf 2.69. Invocation command line was +generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -11090,41 +19686,43 @@ generated by GNU Autoconf 2.69. Invocation command line was CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ -on `(hostname || uname -n) 2>/dev/null | sed 1q` -" - +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 _ACEOF -case $ac_config_files in *" -"*) set x $ac_config_files; shift; ac_config_files=$*;; -esac +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# Files that config.status was made for. -config_files="$ac_config_files" -config_commands="$ac_config_commands" +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi -_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions -from templates according to the current configuration. Unless the files -and actions are specified as TAGs, all are instantiated by default. +\`$as_me' instantiates files from templates according to the +current configuration. -Usage: $0 [OPTION]... [TAG]... +Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit - -V, --version print version number and configuration settings, then exit - --config print configuration, then exit - -q, --quiet, --silent - do not print progress messages + -V, --version print version number, then exit + -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE Configuration files: $config_files @@ -11132,78 +19730,83 @@ $config_files Configuration commands: $config_commands -Report bugs to the package provider." - +Report bugs to ." _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" + +cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ tcl config.status 8.6 -configured by $0, generated by GNU Autoconf 2.69, - with options \\"\$ac_cs_config\\" +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." - -ac_pwd='$ac_pwd' -srcdir='$srcdir' -test -n "\$AWK" || AWK=awk +srcdir=$srcdir _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# The default lists apply if the user does not specify any file. +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in - --*=?*) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` - ac_shift=: - ;; - --*=) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg= + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; - *) + -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; esac case $ac_option in # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; - --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) - $as_echo "$ac_cs_version"; exit ;; - --config | --confi | --conf | --con | --co | --c ) - $as_echo "$ac_cs_config"; exit ;; - --debug | --debu | --deb | --de | --d | -d ) + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift - case $ac_optarg in - *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - '') as_fn_error $? "missing file argument" ;; - esac - as_fn_append CONFIG_FILES " '$ac_optarg'" + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; - --he | --h | --help | --hel | -h ) - $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. - -*) as_fn_error $? "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; - *) as_fn_append ac_config_targets " $1" - ac_need_defaults=false ;; + *) ac_config_targets="$ac_config_targets $1" ;; esac shift @@ -11217,55 +19820,43 @@ if $ac_cs_silent; then fi _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then - set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion - shift - \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 - CONFIG_SHELL='$SHELL' - export CONFIG_SHELL - exec "\$@" + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX - $as_echo "$ac_log" -} >&5 -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>$CONFIG_STATUS <<_ACEOF # -# INIT-COMMANDS +# INIT-COMMANDS section. # + VERSION=${TCL_VERSION} _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Handling of arguments. + +cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do - case $ac_config_target in - "Tcl-Info.plist") CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; - "Tclsh-Info.plist") CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; - "Tcl.framework") CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; - "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; - "dltest/Makefile") CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; - "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; - "tcl.pc") CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; - - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + case "$ac_config_target" in + # Handling of arguments. + "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; + "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; + "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; + "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; + "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; + "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; esac done - # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely @@ -11276,427 +19867,533 @@ if $ac_need_defaults; then fi # Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason against having it here, and in addition, +# simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. -# Hook for its removal unless debugging. -# Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. +# Create a temporary directory, and hook for its removal unless debugging. $debug || { - tmp= ac_tmp= - trap 'exit_status=$? - : "${ac_tmp:=$tmp}" - { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status -' 0 - trap 'as_fn_exit 1' 1 2 13 15 + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 } + # Create a (secure) tmp directory for tmp files. { - tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -d "$tmp" + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" } || { - tmp=./conf$$-$RANDOM - (umask 077 && mkdir "$tmp") -} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 -ac_tmp=$tmp - -# Set up the scripts for CONFIG_FILES section. -# No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. -if test -n "$CONFIG_FILES"; then - - -ac_cr=`echo X | tr X '\015'` -# On cygwin, bash can eat \r inside `` if the user requested igncr. -# But we know of no other shell where ac_cr would be empty at this -# point, so we can use a bashism as a fallback. -if test "x$ac_cr" = x; then - eval ac_cr=\$\'\\r\' -fi -ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` -if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\\r' -else - ac_cs_awk_cr=$ac_cr -fi - -echo 'BEGIN {' >"$ac_tmp/subs1.awk" && -_ACEOF - - + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || { - echo "cat >conf$$subs.awk <<_ACEOF" && - echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && - echo "_ACEOF" -} >conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` -ac_delim='%!_!# ' -for ac_last_try in false false false false false :; do - . ./conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - - ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` - if test $ac_delim_n = $ac_delim_num; then - break - elif $ac_last_try; then - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done -rm -f conf$$subs.sh - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && -_ACEOF -sed -n ' -h -s/^/S["/; s/!.*/"]=/ -p -g -s/^[^!]*!// -:repl -t repl -s/'"$ac_delim"'$// -t delim -:nl -h -s/\(.\{148\}\)..*/\1/ -t more1 -s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ -p -n -b repl -:more1 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t nl -:delim -h -s/\(.\{148\}\)..*/\1/ -t more2 -s/["\\]/\\&/g; s/^/"/; s/$/"/ -p -b -:more2 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t delim -' >$CONFIG_STATUS || ac_write_fail=1 -rm -f conf$$subs.awk -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACAWK -cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && - for (key in S) S_is_set[key] = 1 - FS = "" - -} -{ - line = $ 0 - nfields = split(line, field, "@") - substed = 0 - len = length(field[1]) - for (i = 2; i < nfields; i++) { - key = field[i] - keylen = length(key) - if (S_is_set[key]) { - value = S[key] - line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) - len += length(value) + length(field[++i]) - substed = 1 - } else - len += 1 + keylen - } - - print line + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } } -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then - sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" -else - cat -fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ - || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF -# VPATH may cause trouble with some makes, so we remove sole $(srcdir), -# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and -# trailing colons and then remove the whole line if VPATH becomes empty -# (actually we leave an empty line to preserve line numbers). -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ -h -s/// -s/^/:/ -s/[ ]*$/:/ -s/:\$(srcdir):/:/g -s/:\${srcdir}:/:/g -s/:@srcdir@:/:/g -s/^:*// -s/:*$// -x -s/\(=[ ]*\).*/\1/ -G -s/\n// -s/^[^=]*=[ ]*$// -}' -fi - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -fi # test -n "$CONFIG_FILES" +cat >>$CONFIG_STATUS <<_ACEOF +# +# CONFIG_FILES section. +# -eval set X " :F $CONFIG_FILES :C $CONFIG_COMMANDS" -shift -for ac_tag -do - case $ac_tag in - :[FHLC]) ac_mode=$ac_tag; continue;; - esac - case $ac_mode$ac_tag in - :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; - :[FH]-) ac_tag=-:-;; - :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; - esac - ac_save_IFS=$IFS - IFS=: - set x $ac_tag - IFS=$ac_save_IFS - shift - ac_file=$1 - shift +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@MAN_FLAGS@,$MAN_FLAGS,;t t +s,@CC@,$CC,;t t +s,@CFLAGS@,$CFLAGS,;t t +s,@LDFLAGS@,$LDFLAGS,;t t +s,@CPPFLAGS@,$CPPFLAGS,;t t +s,@ac_ct_CC@,$ac_ct_CC,;t t +s,@EXEEXT@,$EXEEXT,;t t +s,@OBJEXT@,$OBJEXT,;t t +s,@CPP@,$CPP,;t t +s,@EGREP@,$EGREP,;t t +s,@TCL_THREADS@,$TCL_THREADS,;t t +s,@TCLSH_PROG@,$TCLSH_PROG,;t t +s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t +s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t +s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t +s,@RANLIB@,$RANLIB,;t t +s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t +s,@AR@,$AR,;t t +s,@ac_ct_AR@,$ac_ct_AR,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@TCL_LIBS@,$TCL_LIBS,;t t +s,@DL_LIBS@,$DL_LIBS,;t t +s,@DL_OBJS@,$DL_OBJS,;t t +s,@PLAT_OBJS@,$PLAT_OBJS,;t t +s,@PLAT_SRCS@,$PLAT_SRCS,;t t +s,@LDAIX_SRC@,$LDAIX_SRC,;t t +s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t +s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t +s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t +s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t +s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t +s,@CC_SEARCH_FLAGS@,$CC_SEARCH_FLAGS,;t t +s,@LD_SEARCH_FLAGS@,$LD_SEARCH_FLAGS,;t t +s,@STLIB_LD@,$STLIB_LD,;t t +s,@SHLIB_LD@,$SHLIB_LD,;t t +s,@TCL_SHLIB_LD_EXTRAS@,$TCL_SHLIB_LD_EXTRAS,;t t +s,@TK_SHLIB_LD_EXTRAS@,$TK_SHLIB_LD_EXTRAS,;t t +s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t +s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t +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 +s,@DTRACE@,$DTRACE,;t t +s,@TCL_VERSION@,$TCL_VERSION,;t t +s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t +s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t +s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t +s,@TCL_YEAR@,$TCL_YEAR,;t t +s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t +s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t +s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t +s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t +s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t +s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t +s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t +s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t +s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t +s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t +s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t +s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t +s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t +s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t +s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t +s,@LD_LIBRARY_PATH_VAR@,$LD_LIBRARY_PATH_VAR,;t t +s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t +s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t +s,@TCL_SHARED_LIB_SUFFIX@,$TCL_SHARED_LIB_SUFFIX,;t t +s,@TCL_UNSHARED_LIB_SUFFIX@,$TCL_UNSHARED_LIB_SUFFIX,;t t +s,@TCL_HAS_LONGLONG@,$TCL_HAS_LONGLONG,;t t +s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t +s,@DTRACE_SRC@,$DTRACE_SRC,;t t +s,@DTRACE_HDR@,$DTRACE_HDR,;t t +s,@DTRACE_OBJ@,$DTRACE_OBJ,;t t +s,@MAKEFILE_SHELL@,$MAKEFILE_SHELL,;t t +s,@BUILD_DLTEST@,$BUILD_DLTEST,;t t +s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t +s,@TCL_MODULE_PATH@,$TCL_MODULE_PATH,;t t +s,@TCL_LIBRARY@,$TCL_LIBRARY,;t t +s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t +s,@HTML_DIR@,$HTML_DIR,;t t +s,@PACKAGE_DIR@,$PACKAGE_DIR,;t t +s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t +s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t +s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t +s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t +s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t +s,@EXTRA_TCLSH_LIBS@,$EXTRA_TCLSH_LIBS,;t t +s,@DLTEST_LD@,$DLTEST_LD,;t t +s,@DLTEST_SUFFIX@,$DLTEST_SUFFIX,;t t +CEOF - case $ac_mode in - :L) ac_source=$1;; - :[FH]) - ac_file_inputs= - for ac_f - do - case $ac_f in - -) ac_f="$ac_tmp/stdin";; - *) # Look for the file first in the build tree, then in the source tree - # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. - test -f "$ac_f" || - case $ac_f in - [\\/$]*) false;; - *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; - esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; - esac - case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac - as_fn_append ac_file_inputs " '$ac_f'" - done +_ACEOF - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - configure_input='Generated from '` - $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' - `' by configure.' - if test x"$ac_file" != x-; then - configure_input="$ac_file. $configure_input" - { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 -$as_echo "$as_me: creating $ac_file" >&6;} + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi - # Neutralize special characters interpreted by sed in replacement strings. - case $configure_input in #( - *\&* | *\|* | *\\* ) - ac_sed_conf_input=`$as_echo "$configure_input" | - sed 's/[\\\\&|]/\\\\&/g'`;; #( - *) ac_sed_conf_input=$configure_input;; - esac + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat + fi +fi # test -n "$CONFIG_FILES" - case $ac_tag in - *:-:* | *:-) cat >"$ac_tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; - esac - ;; +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case $ac_file in + - | *:- | *:-:* ) # input from stdin + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; esac - ac_dir=`$as_dirname -- "$ac_file" || + # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. + ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir="$ac_dir"; as_fn_mkdir_p + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + ac_builddir=. -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi case $srcdir in - .) # We are building in place. + .) # No --srcdir option. We are building in place. ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - - case $ac_mode in - :F) - # - # CONFIG_FILE - # - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# If the template does not know about datarootdir, expand it. -# FIXME: This hack should be removed a few years after 2.60. -ac_datarootdir_hack=; ac_datarootdir_seen= -ac_sed_dataroot=' -/datarootdir/ { - p - q -} -/@datadir@/p -/@docdir@/p -/@infodir@/p -/@localedir@/p -/@mandir@/p' -case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in -*datarootdir*) ac_datarootdir_seen=yes;; -*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 -$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - ac_datarootdir_hack=' - s&@datadir@&$datadir&g - s&@docdir@&$docdir&g - s&@infodir@&$infodir&g - s&@localedir@&$localedir&g - s&@mandir@&$mandir&g - s&\\\${datarootdir}&$datarootdir&g' ;; +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; esac -_ACEOF -# Neutralize VPATH when `$srcdir' = `.'. -# Shell code in configure.ac might set extrasub. -# FIXME: do we really want to maintain this feature? -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_sed_extra="$ac_vpsub + + + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + case $f in + -) echo $tmp/stdin ;; + [\\/$]*) + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + echo "$f";; + *) # Relative + if test -f "$f"; then + # Build tree + echo "$f" + elif test -f "$srcdir/$f"; then + # Source tree + echo "$srcdir/$f" + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub $extrasub _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s|@configure_input@|$ac_sed_conf_input|;t t -s&@top_builddir@&$ac_top_builddir_sub&;t t -s&@top_build_prefix@&$ac_top_build_prefix&;t t -s&@srcdir@&$ac_srcdir&;t t -s&@abs_srcdir@&$ac_abs_srcdir&;t t -s&@top_srcdir@&$ac_top_srcdir&;t t -s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t -s&@builddir@&$ac_builddir&;t t -s&@abs_builddir@&$ac_abs_builddir&;t t -s&@abs_top_builddir@&$ac_abs_top_builddir&;t t -$ac_datarootdir_hack -" -eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ - >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - -test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ - "$ac_tmp/out"`; test -z "$ac_out"; } && - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined" >&5 -$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined" >&2;} - - rm -f "$ac_tmp/stdin" - case $ac_file in - -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; - *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; - esac \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - ;; +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi +done +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF - :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 -$as_echo "$as_me: executing $ac_file commands" >&6;} - ;; - esac +# +# CONFIG_COMMANDS section. +# +for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue + ac_dest=`echo "$ac_file" | sed 's,:.*,,'` + ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_dir=`(dirname "$ac_dest") 2>/dev/null || +$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_dest" : 'X\(//\)[^/]' \| \ + X"$ac_dest" : 'X\(//\)$' \| \ + X"$ac_dest" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_dest" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac - case $ac_file$ac_mode in - "Tcl.framework":C) n=Tcl && + { echo "$as_me:$LINENO: executing $ac_dest commands" >&5 +echo "$as_me: executing $ac_dest commands" >&6;} + case $ac_dest in + Tcl.framework ) n=Tcl && f=$n.framework && v=Versions/$VERSION && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && unset n f v ;; - esac -done # for ac_tag +done +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF -as_fn_exit 0 +{ (exit 0); exit 0; } _ACEOF +chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save -test $ac_write_fail = 0 || - as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 - # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. @@ -11716,11 +20413,7 @@ if test "$no_create" != yes; then exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. - $ac_cs_success || as_fn_exit 1 -fi -if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 -$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} + $ac_cs_success || { (exit 1); exit 1; } fi diff --git a/unix/configure.in b/unix/configure.in index bc7bdef..85bd7ee 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -893,29 +893,6 @@ fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl -# core vfs and kit support. -#-------------------------------------------------------------------- - -eval "TCL_KIT_LIB_FILE=libtclkit${UNSHARED_LIB_SUFFIX}" -eval "TCL_KIT_LIB_FILE=${TCL_KIT_LIB_FILE}" - -eval "TCL_KIT_LIB_FILE=libtclkit${TCL_UNSHARED_LIB_SUFFIX}" -eval "TCL_KIT_LIB_FILE=\"${TCL_KIT_LIB_FILE}\"" -eval "TCL_KIT_LIB_DIR=${libdir}" - -if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TCL_KIT_LIB_FLAG="-ltclkit${TCL_VERSION}" -else - TCL_KIT_LIB_FLAG="-ltclkit`echo ${TCL_VERSION} | tr -d .`" -fi - -TCL_BUILD_KIT_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_KIT_LIB_FLAG}" -TCL_KIT_LIB_SPEC="-L${TCL_KIT_LIB_DIR} ${TCL_KIT_LIB_FLAG}" -TCL_BUILD_KIT_LIB_PATH="`pwd`/${TCL_KIT_LIB_FILE}" -TCL_KIT_LIB_PATH="${TCL_KIT_LIB_DIR}/${TCL_KIT_LIB_FILE}" - -#-------------------------------------------------------------------- -# The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- @@ -956,24 +933,14 @@ AC_SUBST(PKG_CFG_ARGS) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) -AC_SUBST(TCL_BUILD_LIB_SPEC) - AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_PATH) +AC_SUBST(TCL_INCLUDE_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_SPEC) AC_SUBST(TCL_BUILD_STUB_LIB_PATH) -AC_SUBST(TCL_KIT_LIB_FILE) -AC_SUBST(TCL_KIT_LIB_FLAG) -AC_SUBST(TCL_KIT_LIB_SPEC) -AC_SUBST(TCL_KIT_LIB_PATH) -AC_SUBST(TCL_BUILD_KIT_LIB_SPEC) -AC_SUBST(TCL_BUILD_KIT_LIB_PATH) - -AC_SUBST(TCL_INCLUDE_SPEC) - AC_SUBST(TCL_SRC_DIR) AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX) AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) @@ -981,6 +948,7 @@ AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) AC_SUBST(TCL_SHARED_BUILD) AC_SUBST(LD_LIBRARY_PATH_VAR) +AC_SUBST(TCL_BUILD_LIB_SPEC) AC_SUBST(TCL_LIB_VERSIONS_OK) AC_SUBST(TCL_SHARED_LIB_SUFFIX) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 88f2b81..3ca65d8 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2060,14 +2060,6 @@ dnl # preprocessing tests use only CPPFLAGS. ]) ]) - AS_IF([test "$RANLIB" = ""], [ - MAKE_KIT_LIB='$(STLIB_LD) [$]@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS}' - INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)"' - ], [ - MAKE_KIT_LIB='${STLIB_LD} [$]@ ${TCL_OBJS} ${TOMMATH_OBJS} ${ZLIB_OBJS} ; ${RANLIB} [$]@' - INSTALL_KIT_LIB='$(INSTALL_LIBRARY) $(TCL_KIT_LIB_FILE) "$(LIB_INSTALL_DIR)/$(TCL_KIT_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(TCL_KIT_LIB_FILE))' - ]) - # Stub lib does not depend on shared/static configuration AS_IF([test "$RANLIB" = ""], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}' @@ -2134,12 +2126,10 @@ dnl # preprocessing tests use only CPPFLAGS. [What is the default extension for shared libraries?]) AC_SUBST(MAKE_LIB) - AC_SUBST(MAKE_KIT_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(INSTALL_LIB) AC_SUBST(DLL_INSTALL_DIR) AC_SUBST(INSTALL_STUB_LIB) - AC_SUBST(INSTALL_KIT_LIB) AC_SUBST(RANLIB) ]) diff --git a/win/makefile.bc b/win/makefile.bc index e005979..57bfda0 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -159,6 +159,7 @@ TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME) TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe +TCLKIT = $(OUTDIR)\$(NAMEPREFIX)kit$(VERSION)$(DBGX).exe TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME) TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll @@ -177,6 +178,10 @@ INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include TCLSHOBJS = \ $(TMPDIR)\tclAppInit.obj +TCLKITOBJS = \ + $(TMP_DIR)\tclZipVfs.obj \ + $(TMPDIR)\tclKitInit.obj + TCLTESTOBJS = \ $(TMPDIR)\tclTest.obj \ $(TMPDIR)\tclTestObj.obj \ @@ -275,7 +280,6 @@ TCLOBJS = \ $(TMPDIR)\tclWinSock.obj \ $(TMPDIR)\tclWinThrd.obj \ $(TMPDIR)\tclWinTime.obj \ - $(TMP_DIR)\tclZipVfs.obj \ $(TMPDIR)\tclZlib.obj TCLSTUBOBJS = \ @@ -392,6 +396,11 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res ! +$(TCLKIT): $(TCLKITOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res + $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&! + $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res +! + $(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB) $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \ $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \ @@ -512,6 +521,10 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? +$(TMPDIR)\tclKitInit.obj : $(WINDIR)\tclAppInit.c + $(cc32) $(TCL_CFLAGS) -DDTCL_ZIPVFS -o$(TMPDIR)\$@ $? + + # The following objects should be built using the stub interfaces # tclWinReg: Produces errors in ANSI mode diff --git a/win/makefile.vc b/win/makefile.vc index 43644cc..832f6bd 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -209,6 +209,9 @@ TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) +TCLKITNAME = $(PROJECT)kit$(VERSION)$(SUFX).exe +TCLKIT = $(OUT_DIR)\$(TCLSHNAME) + TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT) TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) @@ -244,6 +247,18 @@ TCLSHOBJS = \ !endif $(TMP_DIR)\tclsh.res +TCLKITOBJS = \ + $(TMP_DIR)\tclKitInit.obj \ + $(TMP_DIR)\tclZipVfs.obj \ +!if !$(STATIC_BUILD) +!if $(TCL_USE_STATIC_PACKAGES) + $(TMP_DIR)\tclWinReg.obj \ + $(TMP_DIR)\tclWinDde.obj \ +!endif +!endif + $(TMP_DIR)\tclsh.res + + TCLTESTOBJS = \ $(TMP_DIR)\tclTest.obj \ $(TMP_DIR)\tclTestObj.obj \ @@ -343,7 +358,6 @@ COREOBJS = \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ - $(TMP_DIR)\tclZipVfs.obj \ $(TMP_DIR)\tclZlib.obj ZLIBOBJS = \ @@ -957,6 +971,12 @@ $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? +$(TMP_DIR)\tclKitInit.obj: $(WINDIR)\tclAppInit.c + $(cc32) $(TCL_CFLAGS) \ + -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ + -DTCL_ZIPVFS \ + -Fo$@ $? + ### The following objects should be built using the stub interfaces ### *ALL* extensions need to built with -DTCL_THREADS=1 -- cgit v0.12 From a684c1a281bc1a3c98249e6aa961fa57498dd9a7 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 15 Sep 2014 10:04:50 +0000 Subject: Modified the makefile to produce a distinct name for a kit depending on whether it was compiled statically or dynamically. This allows builders to run and install successive builds of Tcl both statically and dynamically. --- unix/Makefile.in | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 7523fca..ba81ecc 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -109,6 +109,7 @@ CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ +SHARED_BUILD = @TCL_SHARED_BUILD@ # To disable ANSI-C procedure prototypes reverse the comment characters on the # following lines: @@ -167,7 +168,13 @@ INSTALL_DATA_DIR = ${INSTALL} -d -m 755 # Do not use SHELL_ENV for NATIVE_TCLSH unless it is the tclsh being built. EXE_SUFFIX = @EXEEXT@ TCL_EXE = tclsh${EXE_SUFFIX} -TCLKIT_EXE = tclkit${EXE_SUFFIX} +ifeq ($(SHARED_BUILD),0) +TCLKIT_BASE = tclkits +else +TCLKIT_BASE = tclkitd +endif +TCLKIT_EXE = ${TCLKIT_BASE}${EXE_SUFFIX} + TCLTEST_EXE = tcltest${EXE_SUFFIX} NATIVE_TCLSH = @TCLSH_PROG@ @@ -675,7 +682,7 @@ ${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tclk cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . # Builds an executable directly from the Tcl sources -tclkit-direct: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs +tclkit-static: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ @@ -836,8 +843,8 @@ install-binaries: binaries @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" - @echo "Installing ${TCLKIT_EXE} as $(BIN_INSTALL_DIR)/tclkit$(VERSION)${EXE_SUFFIX}" - @$(INSTALL_PROGRAM) ${TCLKIT_EXE} "$(BIN_INSTALL_DIR)/tclkit$(VERSION)${EXE_SUFFIX}" + @echo "Installing ${TCLKIT_EXE} as $(BIN_INSTALL_DIR)/${TCLKIT_BASE}$(VERSION)${EXE_SUFFIX}" + @$(INSTALL_PROGRAM) ${TCLKIT_EXE} "$(BIN_INSTALL_DIR)/${TCLKIT_BASE}$(VERSION)${EXE_SUFFIX}" @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/" @@ -2166,7 +2173,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages -.PHONY: tclkit-direct +.PHONY: tclkit-static #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. -- cgit v0.12 From 4b8398a6ed8396348a2cbcd0da5a47bf42756fab Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 15 Sep 2014 14:59:20 +0000 Subject: Removed non-working code from the end of the mkVfs.tcl script --- tools/mkVfs.tcl | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl index 83eb9e6..bc6f3aa 100644 --- a/tools/mkVfs.tcl +++ b/tools/mkVfs.tcl @@ -91,17 +91,3 @@ set VFSROOT $dir } pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} close $fout -exit 0 -puts $fout { -# Save Tcl the trouble of hunting for these packages -} -set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] -if {$ddedll != {}} { - puts $fout [cat ${TCL_SCRIPT_DIR}/dde/pkgIndex.tcl] -} -set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] -if {$regdll != {}} { - puts $fout [cat ${TCL_SCRIPT_DIR}/reg/pkgIndex.tcl] -} -close $fout -file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 1 -- cgit v0.12 From ff7a13136dd5b09e8e2dee557447b05336329fc5 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 16 Sep 2014 23:07:44 +0000 Subject: Added a "make tclkit" to makefile Removed debugging fprintf --- generic/tclZipVfs.c | 2 -- unix/Makefile.in | 6 ++++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index 15f38bd..7839648 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1774,7 +1774,6 @@ Zvfs_doInit( ** Boot a shell, mount the executable's VFS, detect main.tcl */ int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *initscript) { - FILE *fout; Zvfs_Common_Init(NULL); if(!vfsmountpoint) { vfsmountpoint="/zvfs"; @@ -1823,7 +1822,6 @@ int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *init if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { /* Startup script should be set before calling Tcl_AppInit */ - fprintf(fout,"%s\n",Tcl_GetString(vfsinitscript)); Tcl_SetStartupScript(vfsinitscript,NULL); } diff --git a/unix/Makefile.in b/unix/Makefile.in index ba81ecc..757f313 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -670,7 +670,9 @@ tclkit.vfs: @echo "Building VFS File system in tclkit.vfs" @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ "$(UNIX_DIR)/tclkit.vfs/tcl$(VERSION)" "$(TOP_DIR)" unix - + +tclkit: ${TCLKIT_EXE} + # Builds an executable linked to the Tcl dynamic library ${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tclkit.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ @@ -2173,7 +2175,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages -.PHONY: tclkit-static +.PHONY: tclkit-static tclkit #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. -- cgit v0.12 From 2e0b2484a98701ffab53bda837e16ee86829fc6b Mon Sep 17 00:00:00 2001 From: tne Date: Wed, 17 Sep 2014 08:31:21 +0000 Subject: Removed non-working tclkit-direct makefile technique --- win/Makefile.in | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index 0b52640..113f87a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -442,7 +442,12 @@ tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows -$(TCLKIT): tclkit-direct +$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs + $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ + cat null.zip >> $(TCLKIT) + cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . # Builds an executable directly from the Tcl sources tclkit-direct: $(TCLKIT_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs @@ -456,22 +461,6 @@ tclkit-direct: $(TCLKIT_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLI cat null.zip >> $(TCLKIT) cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . - -# Builds an executable linked to the Tcl dynamic library -tclkit-dynamic: $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs - $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - @VC_MANIFEST_EMBED_EXE@ - cat null.zip >> $(TCLKIT) - cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . - -tclkit-kitlib: $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs - $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - @VC_MANIFEST_EMBED_EXE@ - cat null.zip >> $(TCLKIT) - cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . - cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) -- cgit v0.12 From ebebb29be9f0d9bf86391ccc015e0f1a97d3b39b Mon Sep 17 00:00:00 2001 From: tne Date: Wed, 17 Sep 2014 08:33:16 +0000 Subject: Walked back modifications to tclConfig.sh.in (Builds don't require them anymore) --- unix/tclConfig.sh.in | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index 976bd7f..b58e9fd 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -39,9 +39,6 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' -# The name of the static Tcl library (intended for kits): -TCL_KIT_LIB_FILE='@TCL_KIT_LIB_FILE@' - # Additional libraries to use when linking Tcl. TCL_LIBS='@TCL_LIBS@' @@ -145,31 +142,6 @@ TCL_SRC_DIR='@TCL_SRC_DIR@' # the "exec_prefix" directory, if it is different. TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@' -# Core VFS Kit Support -TCL_SUPPORT_KITS=1 - -# The name of the Tcl kit library (.a): -TCL_KIT_LIB_FILE='@TCL_KIT_LIB_FILE@' - -# -l flag to pass to the linker to pick up the Tcl kit library -TCL_KIT_LIB_FLAG='@TCL_KIT_LIB_FLAG@' - -# String to pass to linker to pick up the Tcl kit library from its -# build directory. -TCL_BUILD_KIT_LIB_SPEC='@TCL_BUILD_KIT_LIB_SPEC@' - -# String to pass to linker to pick up the Tcl kit library from its -# installed directory. -TCL_KIT_LIB_SPEC='@TCL_KIT_LIB_SPEC@' - -# Path to the Tcl kit library in the build directory. -TCL_BUILD_KIT_LIB_PATH='@TCL_BUILD_KIT_LIB_PATH@' - -# Path to the Tcl kit library in the install directory. -TCL_KIT_LIB_PATH='@TCL_KIT_LIB_PATH@' - -# END VFS SUPPORT - # Tcl supports stub. TCL_SUPPORTS_STUBS=1 -- cgit v0.12 From cfd9edb0fe18c9cc71f548a037e8d308494269c4 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sun, 19 Oct 2014 20:03:00 +0000 Subject: Update the zipvfs implementation with additional code from both Odie and Dennis LaBelle's FreeWrap. Split the boot loader code out of tclZipVfs.c and into its own File. Altered the structure of tclZipVfs.c to better mirror that which is distributed in Odie and FreeWrap to make popping and swapping improvements easier. --- generic/tclBootVfs.h | 24 + generic/tclZipVfs.c | 2837 +++++++++++++++++------------------------------ generic/tclZipVfsBoot.c | 86 ++ unix/Makefile.in | 7 +- unix/tclAppInit.c | 7 +- win/Makefile.in | 2 +- win/tclAppInit.c | 8 +- 7 files changed, 1154 insertions(+), 1817 deletions(-) create mode 100644 generic/tclBootVfs.h create mode 100644 generic/tclZipVfsBoot.c diff --git a/generic/tclBootVfs.h b/generic/tclBootVfs.h new file mode 100644 index 0000000..1cb7c23 --- /dev/null +++ b/generic/tclBootVfs.h @@ -0,0 +1,24 @@ +#include +#include "tclInt.h" +#include "tclFileSystem.h" + +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif + +#define TCLVFSBOOT_INIT "main.tcl" +#define TCLVFSBOOT_MOUNT "/zvfs" + +/* Make sure the stubbed variants of those are never used. */ +#undef Tcl_ObjSetVar2 +#undef Tcl_NewStringObj +#undef Tk_Init +#undef Tk_MainEx +#undef Tk_SafeInit + +MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); +MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); +MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); +MODULE_SCOPE int Tclkit_Packages_Init(Tcl_Interp *); + + diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index 7839648..c9160ba 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1,256 +1,309 @@ /* - * Copyright (c) 2000 D. Richard Hipp - * Copyright (c) 2007 PDQ Interfaces Inc. - * Copyright (c) 2013-2014 Sean Woods - * - * This file is now released under the BSD style license outlined in the - * included file license.terms. - * - ************************************************************************ - * A ZIP archive virtual filesystem for Tcl. - * - * This package of routines enables Tcl to use a Zip file as a virtual file - * system. Each of the content files of the Zip archive appears as a real - * file to Tcl. - * - * Well, almost... Actually, the virtual file system is limited in a number - * of ways. The only things you can do are "stat" and "read" file content - * files. You cannot use "cd". But it turns out that "stat" and "read" are - * sufficient for most purposes. - * - * This version has been modified to run under Tcl 8.6 - */ -#include "tcl.h" -#include +** Copyright (c) 2000 D. Richard Hipp +** +** This program is free software; you can redistribute it and/or +** modify it under the terms of the GNU General Public +** License as published by the Free Software Foundation; either +** version 2 of the License, or (at your option) any later version. +** +** This program is distributed in the hope that it will be useful, +** but WITHOUT ANY WARRANTY; without even the implied warranty of +** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +** General Public License for more details. +** +** You should have received a copy of the GNU General Public +** License along with this library; if not, write to the +** Free Software Foundation, Inc., 59 Temple Place - Suite 330, +** Boston, MA 02111-1307, USA. +** +** Author contact information: +** drh@hwaci.com +** http://www.hwaci.com/drh/ +** +************************************************************************* +** A ZIP archive virtual filesystem for Tcl. +** +** This package of routines enables Tcl to use a Zip file as +** a virtual file system. Each of the content files of the Zip +** archive appears as a real file to Tcl. +** +** Modified to use Tcl VFS hooks by Peter MacDonald +** peter@pdqi.com +** http://pdqi.com +** +** @(#) $Id: zvfs.c,v 1.1.1.1 2002/01/27 17:44:02 cvs Exp $ +** +** Revison Date Author Description +** ------- ------------- ----------------- ---------------------------------------------- +** Jan 8, 2006 Dennis R. LaBelle Modified to support encrypted files +** +** Dec 16, 2009 Dennis R. LaBelle Corrected Tobe_FSMatchInDirectoryProc() for +** proper operation of glob command on ZVFS files +** under TCL 8.5. +** Oct 19, 2014 Sean D. Woods Corrected Tobe_FSMatchInDirectoryProc() to work around +** issues resolving global file paths under Windows. +** Wrapped FreeWrap specific calls inside of macros. +** Wrapped calls that implement encryption inside of macros. (The supporting +** library for this is part of Zip, and not distributed with Tcl.) +** Reconciled this edition of Zvfs with parallel work on the Odie project. +*/ + #include #include #include #include #include #include +#include +#include "tcl.h" + +#undef ZIPVFSCRYPT +#ifdef ZIPVFSCRYPT +/* Some modifications to support encrypted files */ +#define update_keys zp_update_keys +#define init_keys zp_init_keys +#define decrypt_byte zp_decrypt_byte + +/* some prototype definitions */ +extern void init_keys(char *pwd); +extern int update_keys(int c); +extern unsigned char decrypt_byte(); +extern char *getPwdKey(char *keybuf); +extern const unsigned long *crc_32_tab; +#endif + +/* End of modifications to support encrypted files. */ /* - * Size of the decompression input buffer - */ -#define COMPR_BUF_SIZE 8192 -/*TODO: use thread-local as appropriate*/ +** Size of the decompression input buffer +*/ +#define COMPR_BUF_SIZE 32768 static int openarch = 0; /* Set to 1 when opening archive. */ +static int maptolower=0; /* - * All static variables are collected into a structure named "local". That - * way, it is clear in the code when we are using a static variable because - * its name begins with "local.". - */ +** All static variables are collected into a structure named "local". +** That way, it is clear in the code when we are using a static +** variable because its name begins with "local.". +*/ static struct { - Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The - * key is the virtual filename. The data is an - * instance of the ZvfsFile structure. */ - Tcl_HashTable archiveHash; /* One entry for each archive. Key is the - * name. The data is the ZvfsArchive - * structure. */ - int isInit; /* True after initialization */ + Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The + ** The key is the virtual filename. The data + ** an an instance of the ZvfsFile structure. */ + Tcl_HashTable archiveHash; /* One entry for each archive. Key is the name. + ** data is the ZvfsArchive structure */ + int isInit; /* True after initialization */ + char *firstMount; /* The path to to the first mounted file. */ } local; /* - * Each ZIP archive file that is mounted is recorded as an instance of this - * structure - */ +** Each ZIP archive file that is mounted is recorded as an instance +** of this structure +*/ typedef struct ZvfsArchive { - char *zName; /* Name of the archive */ - char *zMountPoint; /* Where this archive is mounted */ - struct ZvfsFile *pFiles; /* List of files in that archive */ + char *zName; /* Name of the archive */ + char *zMountPoint; /* Where this archive is mounted */ + struct ZvfsFile *pFiles; /* List of files in that archive */ } ZvfsArchive; /* - * Particulars about each virtual file are recorded in an instance of the - * following structure. - */ +** Particulars about each virtual file are recorded in an instance +** of the following structure. +*/ typedef struct ZvfsFile { - char *zName; /* The full pathname of the virtual file */ - ZvfsArchive *pArchive; /* The ZIP archive holding this file data */ - int iOffset; /* Offset into the ZIP archive of the data */ - int nByte; /* Uncompressed size of the virtual file */ - int nByteCompr; /* Compressed size of the virtual file */ - time_t timestamp; /* Modification time */ - int isdir; /* Set to 2 if directory, or 1 if mount */ - int depth; /* Number of slashes in path. */ - int permissions; /* File permissions. */ - struct ZvfsFile *pNext; /* Next file in the same archive */ - struct ZvfsFile *pNextName; /* A doubly-linked list of files with the - * _same_ name. Only the first is in - * local.fileHash */ - struct ZvfsFile *pPrevName; + char *zName; /* The full pathname of the virtual file */ + ZvfsArchive *pArchive; /* The ZIP archive holding this file data */ + int iOffset; /* Offset into the ZIP archive of the data */ + int nByte; /* Uncompressed size of the virtual file */ + int nByteCompr; /* Compressed size of the virtual file */ + int isdir; /* Set to 1 if directory */ + int depth; /* Number of slashes in path. */ + int timestamp; /* Modification time */ + int permissions; /* File permissions. */ + struct ZvfsFile *pNext; /* Next file in the same archive */ + struct ZvfsFile *pNextName; /* A doubly-linked list of files with the same */ + struct ZvfsFile *pPrevName; /* name. Only the first is in local.fileHash */ + /* The following would be used for writable zips. */ + int nExtra; /* Extra space in the TOC header */ + int isSpecial; /* Not really a file in the ZIP archive */ + int dosTime; /* Modification time (DOS format) */ + int dosDate; /* Modification date (DOS format) */ + int iCRC; /* Cyclic Redundancy Check of the data */ } ZvfsFile; /* - * Information about each file within a ZIP archive is stored in an instance - * of the following structure. A list of these structures forms a table of - * contents for the archive. - */ -typedef struct ZFile ZFile; -struct ZFile { - char *zName; /* Name of the file */ - int isSpecial; /* Not really a file in the ZIP archive */ - int dosTime; /* Modification time (DOS format) */ - int dosDate; /* Modification date (DOS format) */ - int iOffset; /* Offset into the ZIP archive of the data */ - int nByte; /* Uncompressed size of the virtual file */ - int nByteCompr; /* Compressed size of the virtual file */ - int nExtra; /* Extra space in the TOC header */ - int iCRC; /* Cyclic Redundancy Check of the data */ - int permissions; /* File permissions. */ - int flags; /* Deletion = bit 0. */ - ZFile *pNext; /* Next file in the same archive */ -}; - -EXTERN int Tcl_Zvfs_Mount(Tcl_Interp *interp,const char *zArchive,const char *zMountPoint); -EXTERN int Tcl_Zvfs_Umount(const char *zArchive); -EXTERN int TclZvfsInit(Tcl_Interp *interp); -EXTERN int Tcl_Zvfs_SafeInit(Tcl_Interp *interp); - -/* - * Macros to read 16-bit and 32-bit big-endian integers into the native format - * of this local processor. B is an array of characters and the integer - * begins at the N-th character of the array. - */ +** Macros to read 16-bit and 32-bit big-endian integers into the +** native format of this local processor. B is an array of +** characters and the integer begins at the N-th character of +** the array. +*/ #define INT16(B, N) (B[N] + (B[N+1]<<8)) #define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24)) /* - * Write a 16- or 32-bit integer as little-endian into the given buffer. - */ -static void -put16( - char *z, - int v) -{ - z[0] = v & 0xff; - z[1] = (v>>8) & 0xff; +** Write a 16- or 32-bit integer as little-endian into the given buffer. +*/ +static void put16(char *z, int v){ + z[0] = v & 0xff; + z[1] = (v>>8) & 0xff; } -static void -put32( - char *z, - int v) -{ - z[0] = v & 0xff; - z[1] = (v>>8) & 0xff; - z[2] = (v>>16) & 0xff; - z[3] = (v>>24) & 0xff; +static void put32(char *z, int v){ + z[0] = v & 0xff; + z[1] = (v>>8) & 0xff; + z[2] = (v>>16) & 0xff; + z[3] = (v>>24) & 0xff; } -/* - * Make a new ZFile structure with space to hold a name of the number of - * characters given. Return a pointer to the new structure. - */ -static ZFile * -newZFile( - int nName, - ZFile **ppList) -{ - ZFile *pNew = (void *) Tcl_Alloc(sizeof(*pNew) + nName + 1); - - memset(pNew, 0, sizeof(*pNew)); - pNew->zName = (char*)&pNew[1]; - pNew->pNext = *ppList; - *ppList = pNew; - return pNew; -} - -/* - * Delete an entire list of ZFile structures - */ -static void -deleteZFileList( - ZFile *pList) -{ - ZFile *pNext; - - while( pList ){ - pNext = pList->pNext; - Tcl_Free((char*)pList); - pList = pNext; - } -} - -/* Convert DOS time to unix time. */ -static void -UnixTimeDate( - struct tm *tm, - int *dosDate, - int *dosTime) -{ - *dosDate = ((((tm->tm_year-80)<<9)&0xfe00) | (((tm->tm_mon+1)<<5)&0x1e0) - | (tm->tm_mday&0x1f)); - *dosTime = (((tm->tm_hour<<11)&0xf800) | ((tm->tm_min<<5)&0x7e0) - | (tm->tm_sec&0x1f)); -} - /* Convert DOS time to unix time. */ -static time_t -DosTimeDate( - int dosDate, - int dosTime) -{ - time_t now; - struct tm *tm; - - now = time(NULL); - tm = localtime(&now); - tm->tm_year = (((dosDate&0xfe00)>>9) + 80); - tm->tm_mon = ((dosDate&0x1e0)>>5); - tm->tm_mday = (dosDate & 0x1f); - tm->tm_hour = (dosTime&0xf800)>>11; - tm->tm_min = (dosTime&0x7e0)>>5; - tm->tm_sec = (dosTime&0x1f); - return mktime(tm); +static time_t DosTimeDate(int dosDate, int dosTime){ + time_t now; + struct tm *tm; + now=time(NULL); + tm = localtime(&now); + tm->tm_year=(((dosDate&0xfe00)>>9) + 80); + tm->tm_mon=((dosDate&0x1e0)>>5)-1; + tm->tm_mday=(dosDate & 0x1f); + tm->tm_hour=(dosTime&0xf800)>>11; + tm->tm_min=(dosTime&0x7e)>>5; + tm->tm_sec=(dosTime&0x1f); + return mktime(tm); } /* - * Translate a DOS time and date stamp into a human-readable string. - */ -static void -translateDosTimeDate( - char *zStr, - int dosDate, - int dosTime){ - static char *zMonth[] = { "nil", - "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", - }; +** Translate a DOS time and date stamp into a human-readable string. +*/ +static void translateDosTimeDate(char *zStr, int dosDate, int dosTime){ + static char *zMonth[] = { "nil", + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + }; - sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", - dosDate & 0x1f, - zMonth[ ((dosDate&0x1e0)>>5) ], - ((dosDate&0xfe00)>>9) + 1980, - (dosTime&0xf800)>>11, - (dosTime&0x7e)>>5, - dosTime&0x1f); + sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", + dosDate & 0x1f, + zMonth[ ((dosDate&0x1e0)>>5) ], + ((dosDate&0xfe00)>>9) + 1980, + (dosTime&0xf800)>>11, + (dosTime&0x7e)>>5, + dosTime&0x1f + ); } /* Return count of char ch in str */ -int -strchrcnt( - char *str, - char ch) -{ - int cnt = 0; - char *cp = str; +int strchrcnt(char *str, char ch) { + int cnt=0; + char *cp=str; + while ((cp=strchr(cp,ch))) { cp++; cnt++; } + return cnt; +} + +#ifdef FREEWRAP +/* +** Concatenate zTail onto zRoot to form a pathname. zRoot will begin +** with "/". After concatenation, simplify the pathname be removing +** unnecessary ".." and "." directories. Under windows, make all +** characters lower case. +** +** Resulting pathname is returned. Space to hold the returned path is +** obtained from Tcl_Alloc() and should be freed by the calling function. +*/ +static char *CanonicalPath(const char *zRoot, const char *zTail){ + char *zPath; + int i, j, c; - while ((cp = strchr(cp,ch)) != NULL) { - cp++; - cnt++; +#ifdef __WIN32__ + if( isalpha(zTail[0]) && zTail[1]==':' ){ zTail += 2; } + if( zTail[0]=='\\' ){ zRoot = ""; zTail++; } + if( zTail[0]=='\\' ){ zRoot = "/"; zTail++; } // account for UNC style path +#endif + if( zTail[0]=='/' ){ zRoot = ""; zTail++; } + if( zTail[0]=='/' ){ zRoot = "/"; zTail++; } // account for UNC style path + zPath = (void *)Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 ); + if( zPath==0 ) return 0; + sprintf(zPath, "%s/%s", zRoot, zTail); + for(i=j=0; (c = zPath[i])!=0; i++){ +#ifdef __WIN32__ + if( isupper(c) ) { if (maptolower) c = tolower(c); } + else if( c=='\\' ) c = '/'; +#endif + if( c=='/' ){ + int c2 = zPath[i+1]; + if( c2=='/' ) continue; + if( c2=='.' ){ + int c3 = zPath[i+2]; + if( c3=='/' || c3==0 ){ + i++; + continue; + } + if( c3=='.' && (zPath[i+3]=='.' || zPath[i+3]==0) ){ + i += 2; + while( j>0 && zPath[j-1]!='/' ){ j--; } + continue; + } + } + } + zPath[j++] = c; + } + if( j==0 ){ zPath[j++] = '/'; } + zPath[j] = 0; + return zPath; +} +/* +** Construct an absolute pathname in memory obtained from Tcl_Alloc +** that means the same file as the pathname given. +** +** Under windows, all backslash (\) charaters are converted to foward +** slash (/) and all upper case letters are converted to lower case. +** The drive letter (if present) is preserved. +*/ +static char *AbsolutePath(const char *z){ + Tcl_DString pwd; + char *zResult; + Tcl_DStringInit(&pwd); + if( *z!='/' +#ifdef __WIN32__ + && *z!='\\' && (!isalpha(*z) || z[1]!=':') +#endif + ){ + /* Case 1: "z" is a relative path. So prepend the current working + ** directory in order to generate an absolute path. Note that the + ** CanonicalPath() function takes care of converting upper to lower + ** case and (\) to (/) under windows. + */ + Tcl_GetCwd(0, &pwd); + zResult = CanonicalPath( Tcl_DStringValue(&pwd), z); + Tcl_DStringFree(&pwd); + } else { + /* Case 2: "z" is an absolute path already. We just need to make + ** a copy of it. Under windows, we need to convert upper to lower + ** case and (\) into (/) on the copy. + */ + zResult = (void *)Tcl_Alloc( strlen(z) + 1 ); + if( zResult==0 ) return 0; + strcpy(zResult, z); +#ifdef __WIN32__ + { + int i, c; + for(i=0; (c=zResult[i])!=0; i++){ + if( isupper(c) ) { + // zResult[i] = tolower(c); + } + else if( c=='\\' ) zResult[i] = '/'; + } } - return cnt; +#endif + } + return zResult; } - +#else /* - * Concatenate zTail onto zRoot to form a pathname. zRoot will begin with - * "/". After concatenation, simplify the pathname be removing unnecessary - * ".." and "." directories. Under windows, make all characters lower case. - * - * Resulting pathname is returned. Space to hold the returned path is - * obtained form Tcl_Alloc() and should be freed by the calling function. - */ +** Concatenate zTail onto zRoot to form a pathname. zRoot will begin +** with "/". After concatenation, simplify the pathname be removing +** unnecessary ".." and "." directories. Under windows, make all +** characters lower case. +** +** Resulting pathname is returned. Space to hold the returned path is +** obtained from Tcl_Alloc() and should be freed by the calling function. +*/ static char * CanonicalPath( const char *zRoot, @@ -317,7 +370,6 @@ CanonicalPath( zPath[j] = 0; return zPath; } - /* * Construct an absolute pathname where memory is obtained from Tcl_Alloc that * means the same file as the pathname given. @@ -346,6 +398,7 @@ AbsolutePath( Tcl_GetCwd(0, &pwd); #endif } + zResult = CanonicalPath(Tcl_DStringValue(&pwd), zRelative); done: Tcl_DStringFree(&pwd); @@ -355,136 +408,18 @@ AbsolutePath( } return zResult; } - -int -ZvfsReadTOCStart( - Tcl_Interp *interp, /* Leave error messages in this interpreter */ - Tcl_Channel chan, - ZFile **pList, - int *iStart) -{ - int nFile; /* Number of files in the archive */ - int iPos; /* Current position in the archive file */ - unsigned char zBuf[100]; /* Space into which to read from the ZIP - * archive */ - ZFile *p; - int zipStart; - - if (!chan) { - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-translation", - "binary") != TCL_OK){ - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { - return TCL_ERROR; - } - - /* - * Read the "End Of Central Directory" record from the end of the ZIP - * archive. - */ - - iPos = Tcl_Seek(chan, -22, SEEK_END); - Tcl_Read(chan, (char *) zBuf, 22); - if (memcmp(zBuf, "\120\113\05\06", 4)) { - /* Tcl_AppendResult(interp, "not a ZIP archive", NULL); */ - return TCL_BREAK; - } - - /* - * Compute the starting location of the directory for the ZIP archive in - * iPos then seek to that location. - */ - - zipStart = iPos; - nFile = INT16(zBuf,8); - iPos -= INT32(zBuf,12); - Tcl_Seek(chan, iPos, SEEK_SET); - - while (1) { - int lenName; /* Length of the next filename */ - int lenExtra=0; /* Length of "extra" data for next file */ - int iData; /* Offset to start of file data */ - - if (nFile-- <= 0) { - break; - } - - /* - * Read the next directory entry. Extract the size of the filename, - * the size of the "extra" information, and the offset into the - * archive file of the file data. - */ - - Tcl_Read(chan, (char *) zBuf, 46); - if (memcmp(zBuf, "\120\113\01\02", 4)) { - Tcl_AppendResult(interp, "ill-formed central directory entry", - NULL); - return TCL_ERROR; - } - lenName = INT16(zBuf,28); - lenExtra = INT16(zBuf,30) + INT16(zBuf,32); - iData = INT32(zBuf,42); - if (iData < zipStart) { - zipStart = iData; - } - - p = newZFile(lenName, pList); - if (!p) { - break; - } - - Tcl_Read(chan, p->zName, lenName); - p->zName[lenName] = 0; - if (lenName > 0 && p->zName[lenName-1] == '/') { - p->isSpecial = 1; - } - p->dosDate = INT16(zBuf, 14); - p->dosTime = INT16(zBuf, 12); - p->nByteCompr = INT32(zBuf, 20); - p->nByte = INT32(zBuf, 24); - p->nExtra = INT32(zBuf, 28); - p->iCRC = INT32(zBuf, 32); - - if (nFile < 0) { - break; - } - - /* - * Skip over the extra information so that the next read will be from - * the beginning of the next directory entry. - */ - - Tcl_Seek(chan, lenExtra, SEEK_CUR); - } - *iStart = zipStart; - return TCL_OK; -} - -int -ZvfsReadTOC( - Tcl_Interp *interp, /* Leave error messages in this interpreter */ - Tcl_Channel chan, - ZFile **pList) -{ - int iStart; - - return ZvfsReadTOCStart(interp, chan, pList, &iStart); -} +#endif /* - * Read a ZIP archive and make entries in the virutal file hash table for all - * content files of that ZIP archive. Also initialize the ZVFS if this - * routine has not been previously called. - */ -int -Tcl_Zvfs_Mount( - Tcl_Interp *interp, /* Leave error messages in this interpreter */ - const char *zArchive, /* The ZIP archive file */ - const char *zMountPoint) /* Mount contents at this directory */ -{ +** Read a ZIP archive and make entries in the virutal file hash table for all +** content files of that ZIP archive. Also initialize the ZVFS if this +** routine has not been previously called. +*/ +int Zvfs_Mount( + Tcl_Interp *interp, /* Leave error messages in this interpreter */ + const char *zArchive, /* The ZIP archive file */ + const char *zMountPoint /* Mount contents at this directory */ +) { Tcl_Channel chan; /* Used for reading the ZIP archive file */ char *zArchiveName = 0; /* A copy of zArchive */ char *zTrueName = 0; /* A copy of zMountPoint */ @@ -538,7 +473,7 @@ Tcl_Zvfs_Mount( Tcl_AppendResult(interp, pArchive->zMountPoint, 0); } } - Tcl_Free(zTrueName); + Tcl_Free((char *)zTrueName); return TCL_OK; } chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0); @@ -688,7 +623,6 @@ Tcl_Zvfs_Mount( pZvfs->pNextName = 0; } else { ZvfsFile *pOld = Tcl_GetHashValue(pEntry); - pOld->pPrevName = pZvfs; pZvfs->pNextName = pOld; } @@ -715,34 +649,28 @@ Tcl_Zvfs_Mount( } /* - * Locate the ZvfsFile structure that corresponds to the file named. Return - * NULL if there is no such ZvfsFile. - */ -static ZvfsFile * -ZvfsLookup( - char *zFilename) -{ - char *zTrueName; - Tcl_HashEntry *pEntry; - ZvfsFile *pFile; - - if (local.isInit == 0) { - return 0; - } - zTrueName = AbsolutePath(zFilename); - pEntry = Tcl_FindHashEntry(&local.fileHash, zTrueName); - pFile = pEntry ? Tcl_GetHashValue(pEntry) : 0; - Tcl_Free(zTrueName); - return pFile; +** Locate the ZvfsFile structure that corresponds to the file named. +** Return NULL if there is no such ZvfsFile. +*/ +static ZvfsFile *ZvfsLookup(char *zFilename){ + char *zTrueName; + Tcl_HashEntry *pEntry; + ZvfsFile *pFile; + + if( local.isInit==0 ) return 0; + zTrueName = AbsolutePath(zFilename); + pEntry = Tcl_FindHashEntry(&local.fileHash, zTrueName); + pFile = pEntry ? Tcl_GetHashValue(pEntry) : 0; + Tcl_Free(zTrueName); + return pFile; } /* - * Unmount all the files in the given ZIP archive. - */ -int -Tcl_Zvfs_Umount( - const char *zArchive) -{ +** Unmount all the files in the given ZIP archive. +*/ +static int Zvfs_Unmount( + const char *zArchive +) { char *zArchiveName; ZvfsArchive *pArchive; ZvfsFile *pFile, *pNextFile; @@ -804,7 +732,7 @@ ZvfsMountObjCmd( " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0); return TCL_ERROR; } - return Tcl_Zvfs_Mount(interp, objc>1?Tcl_GetString(objv[1]):NULL, objc>2?Tcl_GetString(objv[2]):NULL); + return Zvfs_Mount(interp, objc>1?Tcl_GetString(objv[1]):NULL, objc>2?Tcl_GetString(objv[2]):NULL); } /* @@ -832,7 +760,7 @@ ZvfsUnmountObjCmd( return TCL_ERROR; } zFilename=Tcl_GetString(objv[1]); - if (Tcl_Zvfs_Umount(zFilename)) { + if (Zvfs_Unmount(zFilename)) { return TCL_OK; } pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch); @@ -840,7 +768,7 @@ ZvfsUnmountObjCmd( pArchive = Tcl_GetHashValue(pEntry); if (pArchive && pArchive->zMountPoint[0] && (strcmp(pArchive->zMountPoint, zFilename) == 0)) { - if (Tcl_Zvfs_Umount(pArchive->zName)) { + if (Zvfs_Unmount(pArchive->zName)) { return TCL_OK; } break; @@ -1004,324 +932,392 @@ ZvfsListObjCmd( } /* - * Whenever a ZVFS file is opened, an instance of this structure is attached - * to the open channel where it will be available to the ZVFS I/O routines - * below. All state information about an open ZVFS file is held in this - * structure. - */ +** Whenever a ZVFS file is opened, an instance of this structure is +** attached to the open channel where it will be available to the +** ZVFS I/O routines below. All state information about an open +** ZVFS file is held in this structure. +*/ typedef struct ZvfsChannelInfo { - unsigned int nByte; /* number of bytes of read uncompressed - * data */ - unsigned int nByteCompr; /* number of bytes of unread compressed - * data */ - unsigned int nData; /* total number of bytes of compressed data */ - int readSoFar; /* Number of bytes read so far */ - long startOfData; /* File position of start of data in ZIP - * archive */ - int isCompressed; /* True data is compressed */ - Tcl_Channel chan; /* Open to the archive file */ - unsigned char *zBuf; /* buffer used by the decompressor */ - z_stream stream; /* state of the decompressor */ + unsigned long nByte; /* number of bytes of uncompressed data */ + unsigned long nByteCompr; /* number of bytes of unread compressed data */ + unsigned long nData; /* total number of bytes of compressed data */ + unsigned long readSoFar; /* position of next byte to be read from the channel */ + long startOfData; /* File position of start of data in ZIP archive */ + Tcl_Channel chan; /* Open file handle to the archive file */ + unsigned char *zBuf; /* buffer used by the decompressor */ + unsigned char *uBuf; /* pointer to the uncompressed, unencrypted data */ + z_stream stream; /* state of the decompressor */ + int isEncrypted; /* file is encrypted */ + int isCompressed; /* True data is compressed */ } ZvfsChannelInfo; /* - * This routine is called as an exit handler. If we do not set - * ZvfsChannelInfo.chan to NULL, then Tcl_Close() will be called on that - * channel twice when Tcl_Exit runs. This will lead to a core dump. - */ -static void -vfsExit( - void *pArg) -{ - ZvfsChannelInfo *pInfo = pArg; - - pInfo->chan = 0; +** This routine is called as an exit handler. If we do not set +** ZvfsChannelInfo.chan to NULL, then Tcl_Close() will be called on +** that channel a second time when Tcl_Exit runs. This will lead to a +** core dump. +*/ +static void vfsExit(void *pArg){ + ZvfsChannelInfo *pInfo = (ZvfsChannelInfo*)pArg; + pInfo->chan = 0; } /* - * This routine is called when the ZVFS channel is closed - */ -static int -vfsClose( - ClientData instanceData, /* A ZvfsChannelInfo structure */ - Tcl_Interp *interp) /* The TCL interpreter */ -{ - ZvfsChannelInfo* pInfo = instanceData; +** This routine is called when the ZVFS channel is closed +*/ +static int vfsClose( + ClientData instanceData, /* A ZvfsChannelInfo structure */ + Tcl_Interp *interp /* The TCL interpreter */ +){ + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*)instanceData; + + if( pInfo->zBuf ){ + Tcl_Free((char *)pInfo->zBuf); + Tcl_Free((char *)pInfo->uBuf); + inflateEnd(&pInfo->stream); + } + if( pInfo->chan ){ + Tcl_Close(interp, pInfo->chan); + Tcl_DeleteExitHandler(vfsExit, pInfo); + } + Tcl_Free((char*)pInfo); + return TCL_OK; +} - if (pInfo->zBuf) { - Tcl_Free((void *) pInfo->zBuf); - inflateEnd(&pInfo->stream); - } - if (pInfo->chan) { - Tcl_Close(interp, pInfo->chan); - Tcl_DeleteExitHandler(vfsExit, pInfo); - } - Tcl_Free((void *) pInfo); - return TCL_OK; +static int vfsInput ( + ClientData instanceData, /* The channel to read from */ + char *buf, /* Buffer to fill */ + int toRead, /* Requested number of bytes */ + int *pErrorCode /* Location of error flag */ +){ /* The TCL I/O system calls this function to actually read information + * from a ZVFS file. + */ + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; + unsigned long nextpos; + + nextpos = pInfo->readSoFar + toRead; + if (nextpos > pInfo->nByte) { + toRead = pInfo->nByte - pInfo->readSoFar; + nextpos = pInfo->nByte; + } + if( toRead == 0 ) + return 0; + + memcpy(buf, pInfo->uBuf + pInfo->readSoFar, toRead); + + pInfo->readSoFar = nextpos; + *pErrorCode = 0; + + return toRead; } -/* - * The TCL I/O system calls this function to actually read information from a - * ZVFS file. - */ -static int -vfsInput( - ClientData instanceData, /* The channel to read from */ - char *buf, /* Buffer to fill */ - int toRead, /* Requested number of bytes */ - int *pErrorCode) /* Location of error flag */ -{ - ZvfsChannelInfo* pInfo = instanceData; - if (toRead > pInfo->nByte) { - toRead = pInfo->nByte; - } - if (toRead == 0) { - return 0; +static int vfsRead ( + ClientData instanceData, /* The channel to read from */ + char *buf, /* Buffer to fill */ + int toRead, /* Requested number of bytes */ + int *pErrorCode /* Location of error flag */ + ){ /* Read and decompress all data for the associated file into the specified buffer */ + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; + unsigned char encryptHdr[12]; + int C; + int temp; + int i; + int len; + char pwdbuf[20]; + + if( (unsigned long)toRead > pInfo->nByte ){ + toRead = pInfo->nByte; + } + if( toRead == 0 ){ + return 0; + } + if (pInfo->isEncrypted) { +#ifdef ZIPVFSCRYPT + + /* Make preparations to decrypt the data. */ + + /* Read and decrypt the encryption header. */ + crc_32_tab = get_crc_table(); + init_keys(getPwdKey(pwdbuf)); + len = Tcl_Read(pInfo->chan, encryptHdr, sizeof(encryptHdr)); + if (len == sizeof(encryptHdr)) { + for (i = 0; i < sizeof(encryptHdr); ++i) { + C = encryptHdr[i] ^ decrypt_byte(); + update_keys(C); + } + + } +#endif + + } + if( pInfo->isCompressed ){ + int err = Z_OK; + z_stream *stream = &pInfo->stream; + stream->next_out = buf; + stream->avail_out = toRead; + while (stream->avail_out) { + if (!stream->avail_in) { + len = pInfo->nByteCompr; + if (len > COMPR_BUF_SIZE) { + len = COMPR_BUF_SIZE; + } + len = Tcl_Read(pInfo->chan, pInfo->zBuf, len); +#ifdef ZIPVFSCRYPT + + if (pInfo->isEncrypted) { + /* Decrypt the bytes we have just read. */ + for (i = 0; i < len; ++i) { + C = pInfo->zBuf[i]; + temp = C ^ decrypt_byte(); + update_keys(temp); + pInfo->zBuf[i] = temp; + } + } +#endif + pInfo->nByteCompr -= len; + stream->next_in = pInfo->zBuf; + stream->avail_in = len; + } + err = inflate(stream, Z_NO_FLUSH); + if (err) break; } - if (pInfo->isCompressed) { - int err = Z_OK; - z_stream *stream = &pInfo->stream; - - stream->next_out = (unsigned char *) buf; - stream->avail_out = toRead; - while (stream->avail_out) { - if (!stream->avail_in) { - int len = pInfo->nByteCompr; - - if (len > COMPR_BUF_SIZE) { - len = COMPR_BUF_SIZE; + if (err == Z_STREAM_END) { + if ((stream->avail_out != 0)) { + *pErrorCode = err; /* premature end */ + return -1; + } + }else if( err ){ + *pErrorCode = err; /* some other zlib error */ + return -1; + } + }else{ + toRead = Tcl_Read(pInfo->chan, buf, toRead); +#ifdef ZIPVFSCRYPT + if (pInfo->isEncrypted) { + /* Decrypt the bytes we have just read. */ + for (i = 0; i < toRead; ++i) { + C = buf[i]; + temp = C ^ decrypt_byte(); + update_keys(temp); + buf[i] = temp; } - len = Tcl_Read(pInfo->chan, (char *) pInfo->zBuf, len); - pInfo->nByteCompr -= len; - stream->next_in = pInfo->zBuf; - stream->avail_in = len; - } - err = inflate(stream, Z_NO_FLUSH); - if (err) { - break; - } - } - if (err == Z_STREAM_END) { - if (stream->avail_out != 0) { - *pErrorCode = err; /* premature end */ - return -1; - } - }else if (err) { - *pErrorCode = err; /* some other zlib error */ - return -1; } - } else { - toRead = Tcl_Read(pInfo->chan, buf, toRead); - } - pInfo->nByte -= toRead; - pInfo->readSoFar += toRead; - *pErrorCode = 0; - return toRead; +#endif + } + pInfo->nByte = toRead; + pInfo->readSoFar = 0; + *pErrorCode = 0; + return toRead; } /* - * Write to a ZVFS file. ZVFS files are always read-only, so this routine - * always returns an error. - */ -static int -vfsOutput( - ClientData instanceData, /* The channel to write to */ - const char *buf, /* Data to be stored. */ - int toWrite, /* Number of bytes to write. */ - int *pErrorCode) /* Location of error flag. */ -{ - *pErrorCode = EINVAL; - return -1; +** Write to a ZVFS file. ZVFS files are always read-only, so this routine +** always returns an error. +*/ +static int vfsOutput( + ClientData instanceData, /* The channel to write to */ + CONST char *buf, /* Data to be stored. */ + int toWrite, /* Number of bytes to write. */ + int *pErrorCode /* Location of error flag. */ +){ + *pErrorCode = EINVAL; + return -1; } -/* - * Move the file pointer so that the next byte read will be "offset". - */ -static int -vfsSeek( - ClientData instanceData, /* The file structure */ - long offset, /* Offset to seek to */ - int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */ - int *pErrorCode) /* Write the error code here */ -{ - ZvfsChannelInfo* pInfo = instanceData; - - switch (mode) { - case SEEK_CUR: - offset += pInfo->readSoFar; - break; - case SEEK_END: - offset += pInfo->readSoFar + pInfo->nByte; - break; - default: - /* Do nothing */ - break; +static int vfsSeek( + ClientData instanceData, /* The file structure */ + long offset, /* Offset to seek to */ + int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */ + int *pErrorCode /* Write the error code here */ +){ /* Move the file pointer so that the next byte read will be "offset". */ + + ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; + + switch( mode ){ + case SEEK_CUR: { + offset += pInfo->readSoFar; + break; } - if (offset < 0) { - offset = 0; + case SEEK_END: { + offset += pInfo->nByte - 1; + break; } - if (!pInfo->isCompressed) { - Tcl_Seek(pInfo->chan, offset + pInfo->startOfData, SEEK_SET); - pInfo->nByte = pInfo->nData; - pInfo->readSoFar = offset; - } else { - if (offset < pInfo->readSoFar) { - z_stream *stream = &pInfo->stream; - - inflateEnd(stream); - stream->zalloc = (alloc_func)0; - stream->zfree = (free_func)0; - stream->opaque = (voidpf)0; - stream->avail_in = 2; - stream->next_in = pInfo->zBuf; - pInfo->zBuf[0] = 0x78; - pInfo->zBuf[1] = 0x01; - inflateInit(&pInfo->stream); - Tcl_Seek(pInfo->chan, pInfo->startOfData, SEEK_SET); - pInfo->nByte += pInfo->readSoFar; - pInfo->nByteCompr = pInfo->nData; - pInfo->readSoFar = 0; - } - while (pInfo->readSoFar < offset) { - int toRead, errCode; - char zDiscard[100]; - - toRead = offset - pInfo->readSoFar; - if (toRead > sizeof(zDiscard)) { - toRead = sizeof(zDiscard); - } - vfsInput(instanceData, zDiscard, toRead, &errCode); - } + default: { + /* Do nothing */ + break; } - return pInfo->readSoFar; + } +/* Don't seek past end of data */ +if (pInfo->nByte < (unsigned long)offset) + return -1; + +/* Don't seek before the start of data */ +if (offset < 0) + return -1; + +pInfo->readSoFar = (unsigned long)offset; +return pInfo->readSoFar; } /* - * Handle events on the channel. ZVFS files do not generate events, so this - * is a no-op. - */ -static void -vfsWatchChannel( - ClientData instanceData, /* Channel to watch */ - int mask) /* Events of interest */ -{ - return; +** Handle events on the channel. ZVFS files do not generate events, +** so this is a no-op. +*/ +static void vfsWatchChannel( + ClientData instanceData, /* Channel to watch */ + int mask /* Events of interest */ +){ + return; } /* - * Called to retrieve the underlying file handle for this ZVFS file. As the - * ZVFS file has no underlying file handle, this is a no-op. - */ -static int -vfsGetFile( - ClientData instanceData, /* Channel to query */ - int direction, /* Direction of interest */ - ClientData* handlePtr) /* Space to the handle into */ -{ - return TCL_ERROR; +** Called to retrieve the underlying file handle for this ZVFS file. +** As the ZVFS file has no underlying file handle, this is a no-op. +*/ +static int vfsGetFile( + ClientData instanceData, /* Channel to query */ + int direction, /* Direction of interest */ + ClientData* handlePtr /* Space to the handle into */ +){ + return TCL_ERROR; } /* - * This structure describes the channel type structure for access to the ZVFS. - */ +** This structure describes the channel type structure for +** access to the ZVFS. +*/ static Tcl_ChannelType vfsChannelType = { - "vfs", /* Type name. */ - NULL, /* Set blocking/nonblocking behaviour. - * NULL'able */ - vfsClose, /* Close channel, clean instance data */ - vfsInput, /* Handle read request */ - vfsOutput, /* Handle write request */ - vfsSeek, /* Move location of access point. NULL'able */ - NULL, /* Set options. NULL'able */ - NULL, /* Get options. NULL'able */ - vfsWatchChannel, /* Initialize notifier */ - vfsGetFile /* Get OS handle from the channel. */ + "vfs", /* Type name. */ + NULL, /* Set blocking/nonblocking behaviour. NULL'able */ + vfsClose, /* Close channel, clean instance data */ + vfsInput, /* Handle read request */ + vfsOutput, /* Handle write request */ + vfsSeek, /* Move location of access point. NULL'able */ + NULL, /* Set options. NULL'able */ + NULL, /* Get options. NULL'able */ + vfsWatchChannel, /* Initialize notifier */ + vfsGetFile /* Get OS handle from the channel. */ }; /* - * This routine attempts to do an open of a file. Check to see if the file is - * located in the ZVFS. If so, then open a channel for reading the file. If - * not, return NULL. - */ -static Tcl_Channel -ZvfsFileOpen( - Tcl_Interp *interp, /* The TCL interpreter doing the open */ - char *zFilename, /* Name of the file to open */ - char *modeString, /* Mode string for the open (ignored) */ - int permissions) /* Permissions for a newly created file - * (ignored). */ -{ - ZvfsFile *pFile; - ZvfsChannelInfo *pInfo; - Tcl_Channel chan; - static int count = 1; - char zName[50]; - unsigned char zBuf[50]; - - pFile = ZvfsLookup(zFilename); - if (pFile == 0) { - return NULL; - } - openarch = 1; - chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); - openarch = 0; - if (chan == 0) { - return 0; - } - if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") - || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ - /* this should never happen */ - Tcl_Close(0, chan); - return 0; - } - Tcl_Seek(chan, pFile->iOffset, SEEK_SET); - Tcl_Read(chan, (char *) zBuf, 30); - if (memcmp(zBuf, "\120\113\03\04", 4)) { - if (interp) { - Tcl_AppendResult(interp, "local header mismatch: ", NULL); - } - Tcl_Close(interp, chan); - return 0; - } - pInfo = (void *) Tcl_Alloc(sizeof(*pInfo)); - pInfo->chan = chan; - Tcl_CreateExitHandler(vfsExit, pInfo); - pInfo->isCompressed = INT16(zBuf, 8); - if (pInfo->isCompressed) { - z_stream *stream = &pInfo->stream; - - pInfo->zBuf = (void *) Tcl_Alloc(COMPR_BUF_SIZE); - stream->zalloc = NULL; - stream->zfree = NULL; - stream->opaque = NULL; - stream->avail_in = 2; - stream->next_in = pInfo->zBuf; - pInfo->zBuf[0] = 0x78; - pInfo->zBuf[1] = 0x01; - inflateInit(&pInfo->stream); - } else { - pInfo->zBuf = 0; +** This routine attempts to do an open of a file. Check to see +** if the file is located in the ZVFS. If so, then open a channel +** for reading the file. If not, return NULL. +*/ +static Tcl_Channel ZvfsFileOpen( + Tcl_Interp *interp, /* The TCL interpreter doing the open */ + char *zFilename, /* Name of the file to open */ + char *modeString, /* Mode string for the open (ignored) */ + int permissions /* Permissions for a newly created file (ignored) */ +){ + ZvfsFile *pFile; + ZvfsChannelInfo *pInfo; + Tcl_Channel chan; + static int count = 1; + char zName[50]; + unsigned char zBuf[50]; + int errCode; + + pFile = ZvfsLookup(zFilename); + if( pFile==0 ) { + return NULL; + } + openarch = 1; + chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); + openarch = 0; + + if (local.firstMount == NULL) { + local.firstMount = pFile->pArchive->zName; + } + if( chan==0 ){ + return 0; + } + if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") + || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") + ){ + /* this should never happen */ + Tcl_Close(0, chan); + return 0; + } + Tcl_Seek(chan, pFile->iOffset, SEEK_SET); + Tcl_Read(chan, zBuf, 30); + if( memcmp(zBuf, "\120\113\03\04", 4) ){ + if( interp ){ + Tcl_AppendResult(interp, "local header mismatch: ", NULL); } - pInfo->nByte = INT32(zBuf, 22); - pInfo->nByteCompr = pInfo->nData = INT32(zBuf, 18); + Tcl_Close(interp, chan); + return 0; + } + pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) ); + pInfo->chan = chan; + Tcl_CreateExitHandler(vfsExit, pInfo); +#ifdef ZIPVFSCRYPT + pInfo->isEncrypted = zBuf[6] & 1; + if (pFile->pArchive->zName == local.firstMount) { + /* FreeWrap specific. + We are opening a file from the executable. + All such files must be encrypted. + */ + if (!pInfo->isEncrypted) { + /* The file is not encrypted. + Someone must have tampered with the application. + Let's exit the program. + */ + printf("This application has an unauthorized modification. Exiting immediately\n"); + exit(-10); + } + } +#endif + pInfo->isCompressed = INT16(zBuf, 8); + if (pInfo->isCompressed ){ + z_stream *stream = &pInfo->stream; + pInfo->zBuf = (void *)Tcl_Alloc(COMPR_BUF_SIZE); + stream->zalloc = (alloc_func)0; + stream->zfree = (free_func)0; + stream->opaque = (voidpf)0; + stream->avail_in = 2; + stream->next_in = pInfo->zBuf; + pInfo->zBuf[0] = 0x78; + pInfo->zBuf[1] = 0x01; + inflateInit(&pInfo->stream); + } else { + pInfo->zBuf = 0; + } + pInfo->nByte = INT32(zBuf,22); + pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18); + pInfo->readSoFar = 0; + Tcl_Seek(chan, INT16(zBuf,26)+INT16(zBuf,28), SEEK_CUR); + pInfo->startOfData = Tcl_Tell(chan); + sprintf(zName,"vfs_%x_%x",((int)pFile)>>12,count++); + chan = Tcl_CreateChannel(&vfsChannelType, zName, + (ClientData)pInfo, TCL_READABLE); + + pInfo->uBuf = (void *)Tcl_Alloc(pInfo->nByte); + /* Read and decompress the file contents */ + if (pInfo->uBuf) { + pInfo->uBuf[0] = 0; + vfsRead(pInfo, pInfo->uBuf, pInfo->nByte, &errCode); pInfo->readSoFar = 0; - Tcl_Seek(chan, INT16(zBuf, 26) + INT16(zBuf, 28), SEEK_CUR); - pInfo->startOfData = Tcl_Tell(chan); - sprintf(zName, "zvfs_%x",count++); - chan = Tcl_CreateChannel(&vfsChannelType, zName, pInfo, TCL_READABLE); - return chan; + } + + return chan; +} + +Tcl_Channel Tobe_FSOpenFileChannelProc + _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode, int permissions)) { + int len; + /* if (mode != O_RDONLY) return NULL; */ + return ZvfsFileOpen(interp, Tcl_GetStringFromObj(pathPtr,&len), 0, + permissions); } /* - * This routine does a stat() system call for a ZVFS file. - */ -static int -Tobe_FSStatProc( - Tcl_Obj *pathObj, - Tcl_StatBuf *buf) -{ - char *path=Tcl_GetString(pathObj); +** This routine does a stat() system call for a ZVFS file. +*/ +int Tobe_FSStatProc _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)) { + char *path=Tcl_GetString(pathPtr); ZvfsFile *pFile; pFile = ZvfsLookup(path); @@ -1343,13 +1339,10 @@ Tobe_FSStatProc( } /* - * This routine does an access() system call for a ZVFS file. - */ -static int -Tobe_FSAccessProc( - Tcl_Obj *pathPtr, - int mode) -{ +** This routine does an access() system call for a ZVFS file. +*/ +int Tobe_FSAccessProc _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)) { + int len; char *path=Tcl_GetString(pathPtr); ZvfsFile *pFile; @@ -1360,116 +1353,139 @@ Tobe_FSAccessProc( if (pFile == 0) { return -1; } - return 0; -} - -Tcl_Channel -Tobe_FSOpenFileChannelProc( - Tcl_Interp *interp, - Tcl_Obj *pathPtr, - int mode, - int permissions) -{ - static int inopen=0; - Tcl_Channel chan; - - if (inopen) { - puts("recursive zvfs open"); - return NULL; - } - inopen = 1; - /* if (mode != O_RDONLY) return NULL; */ - chan = ZvfsFileOpen(interp, Tcl_GetString(pathPtr), 0, permissions); - inopen = 0; - return chan; + return 0; } Tcl_Obj* Tobe_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) { return Tcl_NewStringObj("/",-1);; } -/* - * Function to process a 'Tobe_FSMatchInDirectory()'. If not implemented, - * then glob and recursive copy functionality will be lacking in the - * filesystem. - */ -int -Tobe_FSMatchInDirectoryProc( +/* Function to process a +* 'Tobe_FSMatchInDirectory()'. If not +* implemented, then glob and recursive +* copy functionality will be lacking in +* the filesystem. */ +int Tobe_FSMatchInDirectoryProc ( Tcl_Interp* interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, - Tcl_GlobTypeData * types) -{ + Tcl_GlobTypeData * types +) { Tcl_HashEntry *pEntry; Tcl_HashSearch sSearch; - int scnt, len, l, dirglob, dirmnt; - char *zPattern = NULL, *zp=Tcl_GetStringFromObj(pathPtr,&len); - - if (!zp) { - return TCL_ERROR; + int scnt=0, pathlen=0, patternlen=0, dirglob=0, fileglob=0, mntglob=0; + int nullpattern=(pattern == NULL || (*pattern=='\0')); + char *zPattern = NULL; + char *zp=NULL; + + if(types && types->type) { + dirglob = (types->type&TCL_GLOB_TYPE_DIR); + fileglob = (types->type & TCL_GLOB_TYPE_FILE); + mntglob = (types->type&TCL_GLOB_TYPE_MOUNT); } - if (pattern != NULL) { - l = strlen(pattern); - if (!zp) { - zPattern = Tcl_Alloc(len + 1); - memcpy(zPattern, pattern, len + 1); - } else { - zPattern = Tcl_Alloc(len + l + 3); - sprintf(zPattern, "%s%s%s", zp, zp[len-1]=='/'?"":"/", pattern); - } - scnt = strchrcnt(zPattern, '/'); + if(!nullpattern) { + patternlen=strlen(pattern); } - dirglob = (types && types->type && (types->type&TCL_GLOB_TYPE_DIR)); - dirmnt = (types && types->type && (types->type&TCL_GLOB_TYPE_MOUNT)); - if (strcmp(zp, "/") == 0 && strcmp(zPattern, ".*") == 0) { - /*TODO: What goes here?*/ + if(pathPtr) { + zp=Tcl_GetStringFromObj(pathPtr,&pathlen); +#ifdef __WIN32__ + if (isalpha(zp[0]) && zp[1]==':') { + zp+=2; + } +#endif } - for (pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); - pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){ - ZvfsFile *pFile = Tcl_GetHashValue(pEntry); - char *z = pFile->zName; - - if (zPattern != NULL) { - if (Tcl_StringCaseMatch(z, zPattern, 0) == 0 || - (scnt != pFile->depth /* && !dirglob */)) { // TODO: ??? - continue; - } - } else { - if (strcmp(zp, z)) { - continue; - } - } - if (dirmnt) { - if (pFile->isdir != 1) { - continue; - } - } else if (dirglob) { - if (!pFile->isdir) { - continue; - } - } else if (types && !(types->type & TCL_GLOB_TYPE_DIR)) { - if (pFile->isdir) { - continue; - } - } - Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z, -1)); + if(mntglob) { return TCL_OK; } + if (mntglob) { + /* Look for a directory mount */ + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_Obj *pVols=0, *pVol; + char mountpt[200]; + int i=1; + mountpt[0]='/'; + if(pathPtr) { + for(i=1;izMountPoint; + Tcl_Obj *pTail=NULL; + int match=0; + match=(strcmp(mountpt, z)==0); + if(!match) continue; + pTail=Tcl_NewStringObj(z, -1); + Tcl_ListObjAppendElement(interp, result, pTail); + //Tcl_DecrRefCount(pTail); + } + } + } else { + int idx=0; + if(!zp && nullpattern) { + zPattern=NULL; + } else { + Tcl_DString dTempPath; + Tcl_DStringInit(&dTempPath); + zPattern=(char*)Tcl_Alloc(pathlen+patternlen+3); + memset(zPattern,0,pathlen+patternlen+3); + if(zp) { + Tcl_DStringAppend(&dTempPath,zp,-1); + } + if (zp && !nullpattern) { + if (pathlen > 1 || zPattern[0] != '/') { + Tcl_DStringAppend(&dTempPath,"/",-1); + idx++; + } + } + if (!nullpattern) { + Tcl_DStringAppend(&dTempPath,pattern,patternlen); + } + zPattern=strdup(Tcl_DStringValue(&dTempPath)); + Tcl_DStringFree(&dTempPath); + scnt = strchrcnt(zPattern, '/'); + } + for ( + pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch); + pEntry; + pEntry = Tcl_NextHashEntry(&sSearch) + ){ + ZvfsFile *pFile = Tcl_GetHashValue(pEntry); + if(pFile) { + char *z = pFile->zName; + Tcl_Obj *pTail=NULL; + int match=0; + if (dirglob && !pFile->isdir) continue; + if (fileglob && pFile->isdir) continue; + if(scnt != pFile->depth) continue; + match=Tcl_StringCaseMatch(z, zPattern, 0); + if(!match) continue; + pTail=Tcl_NewStringObj(z, -1); + Tcl_ListObjAppendElement(interp, result, pTail); + } + } } +done: if (zPattern) { - Tcl_Free(zPattern); + free(zPattern); } return TCL_OK; } -/* - * Function to check whether a path is in this filesystem. This is the most - * important filesystem procedure. - */ -int -Tobe_FSPathInFilesystemProc( - Tcl_Obj *pathPtr, - ClientData *clientDataPtr) -{ +/* Function to check whether a path is in +* this filesystem. This is the most +* important filesystem procedure. */ +int Tobe_FSPathInFilesystemProc _ANSI_ARGS_((Tcl_Obj *pathPtr, + ClientData *clientDataPtr)) { ZvfsFile *zFile; char *path = Tcl_GetString(pathPtr); @@ -1483,30 +1499,37 @@ Tobe_FSPathInFilesystemProc( return -1; } -Tcl_Obj * -Tobe_FSListVolumesProc(void) -{ - Tcl_HashEntry *pEntry; /* Hash table entry */ - Tcl_HashSearch zSearch; /* Search all mount points */ - ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_Obj *pVols = NULL, *pVol; - - pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch); +Tcl_Obj *Tobe_FSListVolumesProc _ANSI_ARGS_((void)) { + Tcl_HashEntry *pEntry; /* Hash table entry */ + Tcl_HashSearch zSearch; /* Search all mount points */ + ZvfsArchive *pArchive; /* The ZIP archive being mounted */ + Tcl_Obj *pVols=0, *pVol; + char mountpt[200]; + + pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch); while (pEntry) { pArchive = Tcl_GetHashValue(pEntry); if (pArchive) { if (!pVols) { - pVols = Tcl_NewListObj(0, 0); + pVols=Tcl_NewListObj(0,0); Tcl_IncrRefCount(pVols); } - pVol = Tcl_NewStringObj(pArchive->zMountPoint, -1); - Tcl_ListObjAppendElement(NULL, pVols, pVol); + sprintf(mountpt, "zvfs:%s", pArchive->zMountPoint); + pVol=Tcl_NewStringObj(mountpt,-1); + Tcl_IncrRefCount(pVol); + Tcl_ListObjAppendElement(NULL, pVols,pVol); + /* Tcl_AppendResult(interp,pArchive->zMountPoint," ",pArchive->zName," ",0);*/ } - pEntry = Tcl_NextHashEntry(&zSearch); + pEntry=Tcl_NextHashEntry(&zSearch); } return pVols; } +int Tobe_FSChdirProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { + /* Someday, we should actually check if this is a valid path. */ + return TCL_OK; +} + const char * const* Tobe_FSFileAttrStringsProc( Tcl_Obj *pathPtr, @@ -1515,11 +1538,11 @@ Tobe_FSFileAttrStringsProc( char *path = Tcl_GetString(pathPtr); #ifdef __WIN32__ static const char *attrs[] = { - "-archive", "-hidden", "-readonly", "-system", "-shortname", 0 + "uncompsize", "compsize", "offset", "mount", "archive","-archive", "-hidden", "-readonly", "-system", "-shortname", 0 }; #else static const char *attrs[] = { - "-group", "-owner", "-permissions", 0 + "uncompsize", "compsize", "offset", "mount", "archive","-group", "-owner", "-permissions", 0 }; #endif if (ZvfsLookup(path) == 0) { @@ -1528,1090 +1551,286 @@ Tobe_FSFileAttrStringsProc( return attrs; } -int -Tobe_FSFileAttrsGetProc( - Tcl_Interp *interp, - int index, - Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef) -{ - char *path = Tcl_GetString(pathPtr); -#ifndef __WIN32__ - char buf[50]; -#endif - ZvfsFile *zFile = ZvfsLookup(path); - - if (zFile == 0) { +int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((Tcl_Interp *interp, + int index, Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef)) { + char *zFilename; + ZvfsFile *pFile; + zFilename = Tcl_GetString(pathPtr); + pFile = ZvfsLookup(zFilename); + if(!pFile) return TCL_ERROR; - } - - switch (index) { + switch (index) { + case 0: + *objPtrRef=Tcl_NewIntObj(pFile->nByteCompr); + return TCL_OK; + case 1: + *objPtrRef= Tcl_NewIntObj(pFile->nByte); + return TCL_OK; + case 2: + *objPtrRef= Tcl_NewIntObj(pFile->nByte); + return TCL_OK; + case 3: + *objPtrRef= Tcl_NewStringObj(pFile->pArchive->zMountPoint,-1); + return TCL_OK; + case 4: + *objPtrRef= Tcl_NewStringObj(pFile->pArchive->zName,-1); + return TCL_OK; #ifdef __WIN32__ - case 0: /* -archive */ + case 5: /* -archive */ *objPtrRef = Tcl_NewStringObj("0", -1); break; - case 1: /* -hidden */ + case 6: /* -hidden */ *objPtrRef = Tcl_NewStringObj("0", -1); break; - case 2: /* -readonly */ + case 7: /* -readonly */ *objPtrRef = Tcl_NewStringObj("", -1); break; - case 3: /* -system */ + case 8: /* -system */ *objPtrRef = Tcl_NewStringObj("", -1); break; - case 4: /* -shortname */ + case 9: /* -shortname */ *objPtrRef = Tcl_NewStringObj("", -1); #else - case 0: /* -group */ + case 5: /* -group */ *objPtrRef = Tcl_NewStringObj("", -1); break; - case 1: /* -owner */ + case 6: /* -owner */ *objPtrRef = Tcl_NewStringObj("", -1); break; - case 2: /* -permissions */ - sprintf(buf, "%03o", zFile->permissions); - *objPtrRef = Tcl_NewStringObj(buf, -1); break; -#endif + case 7: /* -permissions */ { + char buf[32]; + sprintf(buf, "%03o", pFile->permissions); + *objPtrRef = Tcl_NewStringObj(buf, -1); break; } +#endif + default: + return TCL_ERROR; + } + return TCL_OK; +} +int Tobe_FSFileAttrsSetProc _ANSI_ARGS_((Tcl_Interp *interp, + int index, Tcl_Obj *pathPtr, + Tcl_Obj *objPtr)) { return TCL_ERROR; } - return TCL_OK; +Tcl_Obj* Tobe_FSFilesystemPathTypeProc + _ANSI_ARGS_((Tcl_Obj *pathPtr)) { + return Tcl_NewStringObj("zip",-1); } /****************************************************/ -/* - * Function to unload a previously successfully loaded file. If load was - * implemented, then this should also be implemented, if there is any cleanup - * action required. - */ -/* We have to declare the utime structure here. */ -int Tobe_FSUtimeProc(Tcl_Obj *pathPtr, struct utimbuf *tval) { return 0; } -int Tobe_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, - Tcl_Obj *objPtr) { return 0; } - static Tcl_Filesystem Tobe_Filesystem = { - "tobe", /* The name of the filesystem. */ - sizeof(Tcl_Filesystem), /* Length of this structure, so future binary - * compatibility can be assured. */ - TCL_FILESYSTEM_VERSION_1, /* Version of the filesystem type. */ - Tobe_FSPathInFilesystemProc,/* Function to check whether a path is in this - * filesystem. This is the most important - * filesystem procedure. */ - NULL, /* Function to duplicate internal fs rep. May - * be NULL (but then fs is less efficient). */ - NULL, /* Function to free internal fs rep. Must be - * implemented, if internal representations - * need freeing, otherwise it can be NULL. */ + "zvfs", /* The name of the filesystem. */ + sizeof(Tcl_Filesystem), /* Length of this structure, so future + * binary compatibility can be assured. */ + TCL_FILESYSTEM_VERSION_1, + /* Version of the filesystem type. */ + Tobe_FSPathInFilesystemProc, + /* Function to check whether a path is in + * this filesystem. This is the most + * important filesystem procedure. */ + NULL, + /* Function to duplicate internal fs rep. May + * be NULL (but then fs is less efficient). */ + NULL, + /* Function to free internal fs rep. Must + * be implemented, if internal representations + * need freeing, otherwise it can be NULL. */ NULL, - /* Function to convert internal representation - * to a normalized path. Only required if the - * fs creates pure path objects with no - * string/path representation. */ + /* Function to convert internal representation + * to a normalized path. Only required if + * the fs creates pure path objects with no + * string/path representation. */ NULL, - /* Function to create a filesystem-specific - * internal representation. May be NULL if - * paths have no internal representation, or - * if the Tobe_FSPathInFilesystemProc for this - * filesystem always immediately creates an - * internal representation for paths it - * accepts. */ - NULL, /* Function to normalize a path. Should be - * implemented for all filesystems which can - * have multiple string representations for - * the same path object. */ + /* Function to create a filesystem-specific + * internal representation. May be NULL + * if paths have no internal representation, + * or if the Tobe_FSPathInFilesystemProc + * for this filesystem always immediately + * creates an internal representation for + * paths it accepts. */ NULL, - /* Function to determine the type of a path in - * this filesystem. May be NULL. */ + /* Tobe_FSNormalizePathProc (Not needed) + * Function to normalize a path. Should + * be implemented for all filesystems + * which can have multiple string + * representations for the same path + * object. */ + Tobe_FSFilesystemPathTypeProc, + /* Function to determine the type of a + * path in this filesystem. May be NULL. */ Tobe_FSFilesystemSeparatorProc, - /* Function to return the separator - * character(s) for this filesystem. Must be - * implemented. */ - Tobe_FSStatProc, /* Function to process a 'Tobe_FSStat()' call. - * Must be implemented for any reasonable - * filesystem. */ - Tobe_FSAccessProc, /* Function to process a 'Tobe_FSAccess()' - * call. Must be implemented for any - * reasonable filesystem. */ - Tobe_FSOpenFileChannelProc, /* Function to process a - * 'Tobe_FSOpenFileChannel()' call. Must be - * implemented for any reasonable - * filesystem. */ - Tobe_FSMatchInDirectoryProc,/* Function to process a - * 'Tobe_FSMatchInDirectory()'. If not - * implemented, then glob and recursive copy - * functionality will be lacking in the - * filesystem. */ - Tobe_FSUtimeProc, /* Function to process a 'Tobe_FSUtime()' - * call. Required to allow setting (not - * reading) of times with 'file mtime', 'file - * atime' and the open-r/open-w/fcopy - * implementation of 'file copy'. */ - NULL, /* Function to process a 'Tobe_FSLink()' call. - * Should be implemented only if the - * filesystem supports links. */ - Tobe_FSListVolumesProc, /* Function to list any filesystem volumes - * added by this filesystem. Should be - * implemented only if the filesystem adds - * volumes at the head of the filesystem. */ - Tobe_FSFileAttrStringsProc, /* Function to list all attributes strings - * which are valid for this filesystem. If - * not implemented the filesystem will not - * support the 'file attributes' command. - * This allows arbitrary additional - * information to be attached to files in the - * filesystem. */ - Tobe_FSFileAttrsGetProc, /* Function to process a - * 'Tobe_FSFileAttrsGet()' call, used by 'file - * attributes'. */ - Tobe_FSFileAttrsSetProc, /* Function to process a - * 'Tobe_FSFileAttrsSet()' call, used by 'file - * attributes'. */ - NULL, /* Function to process a - * 'Tobe_FSCreateDirectory()' call. Should be - * implemented unless the FS is read-only. */ - NULL, /* Function to process a - * 'Tobe_FSRemoveDirectory()' call. Should be - * implemented unless the FS is read-only. */ - NULL, /* Function to process a 'Tobe_FSDeleteFile()' - * call. Should be implemented unless the FS - * is read-only. */ - NULL, /* Function to process a 'Tobe_FSCopyFile()' - * call. If not implemented Tcl will fall - * back on open-r, open-w and fcopy as a - * copying mechanism. */ - NULL, /* Function to process a 'Tobe_FSRenameFile()' - * call. If not implemented, Tcl will fall - * back on a copy and delete mechanism. */ - NULL, /* Function to process a - * 'Tobe_FSCopyDirectory()' call. If not - * implemented, Tcl will fall back on a - * recursive create-dir, file copy - * mechanism. */ - NULL, /* Function to process a 'Tobe_FSLoadFile()' - * call. If not implemented, Tcl will fall - * back on a copy to native-temp followed by a - * Tobe_FSLoadFile on that temporary copy. */ - NULL, /* Function to unload a previously - * successfully loaded file. If load was - * implemented, then this should also be - * implemented, if there is any cleanup action - * required. */ - NULL, /* Function to process a 'Tobe_FSGetCwd()' - * call. Most filesystems need not implement - * this. It will usually only be called once, - * if 'getcwd' is called before 'chdir'. May - * be NULL. */ - NULL, /* Function to process a 'Tobe_FSChdir()' - * call. If filesystems do not implement this, - * it will be emulated by a series of - * directory access checks. Otherwise, virtual - * filesystems which do implement it need only - * respond with a positive return result if - * the dirName is a valid directory in their - * filesystem. They need not remember the - * result, since that will be automatically - * remembered for use by GetCwd. Real - * filesystems should carry out the correct - * action (i.e. call the correct system - * 'chdir' api). If not implemented, then 'cd' - * and 'pwd' will fail inside the - * filesystem. */ + /* Function to return the separator + * character(s) for this filesystem. Must + * be implemented. */ + Tobe_FSStatProc, + /* + * Function to process a 'Tobe_FSStat()' + * call. Must be implemented for any + * reasonable filesystem. + */ + Tobe_FSAccessProc, + /* + * Function to process a 'Tobe_FSAccess()' + * call. Must be implemented for any + * reasonable filesystem. + */ + Tobe_FSOpenFileChannelProc, + /* + * Function to process a + * 'Tobe_FSOpenFileChannel()' call. Must be + * implemented for any reasonable + * filesystem. + */ + Tobe_FSMatchInDirectoryProc, + /* Function to process a + * 'Tobe_FSMatchInDirectory()'. If not + * implemented, then glob and recursive + * copy functionality will be lacking in + * the filesystem. */ + NULL, + /* Function to process a + * 'Tobe_FSUtime()' call. Required to + * allow setting (not reading) of times + * with 'file mtime', 'file atime' and + * the open-r/open-w/fcopy implementation + * of 'file copy'. */ + NULL, + /* Function to process a + * 'Tobe_FSLink()' call. Should be + * implemented only if the filesystem supports + * links. */ + Tobe_FSListVolumesProc, + /* Function to list any filesystem volumes + * added by this filesystem. Should be + * implemented only if the filesystem adds + * volumes at the head of the filesystem. */ + Tobe_FSFileAttrStringsProc, + /* Function to list all attributes strings + * which are valid for this filesystem. + * If not implemented the filesystem will + * not support the 'file attributes' command. + * This allows arbitrary additional information + * to be attached to files in the filesystem. */ + Tobe_FSFileAttrsGetProc, + /* Function to process a + * 'Tobe_FSFileAttrsGet()' call, used by + * 'file attributes'. */ + Tobe_FSFileAttrsSetProc, + /* Function to process a + * 'Tobe_FSFileAttrsSet()' call, used by + * 'file attributes'. */ + NULL, + /* Function to process a + * 'Tobe_FSCreateDirectory()' call. Should + * be implemented unless the FS is + * read-only. */ + NULL, + /* Function to process a + * 'Tobe_FSRemoveDirectory()' call. Should + * be implemented unless the FS is + * read-only. */ + NULL, + /* Function to process a + * 'Tobe_FSDeleteFile()' call. Should + * be implemented unless the FS is + * read-only. */ + NULL, + /* Function to process a + * 'Tobe_FSCopyFile()' call. If not + * implemented Tcl will fall back + * on open-r, open-w and fcopy as + * a copying mechanism. */ + NULL, + /* Function to process a + * 'Tobe_FSRenameFile()' call. If not + * implemented, Tcl will fall back on + * a copy and delete mechanism. */ + NULL, + /* Function to process a + * 'Tobe_FSCopyDirectory()' call. If + * not implemented, Tcl will fall back + * on a recursive create-dir, file copy + * mechanism. */ + NULL, + /* Function to process a + * 'Tobe_FSLoadFile()' call. If not + * implemented, Tcl will fall back on + * a copy to native-temp followed by a + * Tobe_FSLoadFile on that temporary copy. */ + NULL, + /* Function to unload a previously + * successfully loaded file. If load was + * implemented, then this should also be + * implemented, if there is any cleanup + * action required. */ + NULL, + /* + * Function to process a 'Tobe_FSGetCwd()' + * call. Most filesystems need not + * implement this. It will usually only be + * called once, if 'getcwd' is called + * before 'chdir'. May be NULL. + */ + NULL, + /* + * Function to process a 'Tobe_FSChdir()' + * call. If filesystems do not implement + * this, it will be emulated by a series of + * directory access checks. Otherwise, + * virtual filesystems which do implement + * it need only respond with a positive + * return result if the dirName is a valid + * directory in their filesystem. They + * need not remember the result, since that + * will be automatically remembered for use + * by GetCwd. Real filesystems should + * carry out the correct action (i.e. call + * the correct system 'chdir' api). If not + * implemented, then 'cd' and 'pwd' will + * fail inside the filesystem. + */ }; -////////////////////////////////////////////////////////////// - -void (*Zvfs_PostInit)(Tcl_Interp *) = 0; -static int ZvfsAppendObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); -static int ZvfsAddObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); -static int ZvfsDumpObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); -static int ZvfsStartObjCmd(void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv); +void (*Zvfs_PostInit)(Tcl_Interp *)=0; -static int Zvfs_Common_Init(Tcl_Interp *interp) { - if (local.isInit) return TCL_OK; - /* One-time initialization of the ZVFS */ - if(Tcl_FSRegister(interp, &Tobe_Filesystem)) { - return TCL_ERROR; +int Zvfs_Common_Init(Tcl_Interp *interp) { + if( !local.isInit ){ + /* One-time initialization of the ZVFS */ + Tcl_FSRegister(0, &Tobe_Filesystem); + Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); + local.isInit = 1; } - Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS); - local.isInit = 1; return TCL_OK; } -/* - * Initialize the ZVFS system. - */ -int -Zvfs_doInit( - Tcl_Interp *interp, - int safe) -{ +int Zvfs_Init(Tcl_Interp *interp){ + int n; #ifdef USE_TCL_STUBS - if (Tcl_InitStubs(interp, "8.0", 0) == 0) { - return TCL_ERROR; - } -#endif - Tcl_StaticPackage(interp, "zvfs", TclZvfsInit, Tcl_Zvfs_SafeInit); - if (!safe) { - Tcl_CreateObjCommand(interp, "zvfs::mount", ZvfsMountObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::unmount", ZvfsUnmountObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::append", ZvfsAppendObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::add", ZvfsAddObjCmd, 0, 0); - } - Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::dump", ZvfsDumpObjCmd, 0, 0); - Tcl_CreateObjCommand(interp, "zvfs::start", ZvfsStartObjCmd, 0, 0); - Tcl_SetVar(interp, "::zvfs::auto_ext", - ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY); - /* Tcl_CreateObjCommand(interp, "zip::open", ZipOpenObjCmd, 0, 0); */ - if(Zvfs_Common_Init(interp)) { - return TCL_ERROR; - } - - if (Zvfs_PostInit) { - Zvfs_PostInit(interp); - } - return TCL_OK; -} - -/* -** Boot a shell, mount the executable's VFS, detect main.tcl -*/ -int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *initscript) { - Zvfs_Common_Init(NULL); - if(!vfsmountpoint) { - vfsmountpoint="/zvfs"; - } - if(!initscript) { - initscript="main.tcl"; - } - /* We have to initialize the virtual filesystem before calling - ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find - ** its startup script files. - */ - if(!Tcl_Zvfs_Mount(NULL, archive, vfsmountpoint)) { - Tcl_DString filepath; - Tcl_DString preinit; - - Tcl_Obj *vfsinitscript; - Tcl_Obj *vfstcllib; - Tcl_Obj *vfstklib; - Tcl_Obj *vfspreinit; - - Tcl_DStringInit(&filepath); - Tcl_DStringInit(&preinit); - - Tcl_DStringInit(&filepath); - Tcl_DStringAppend(&filepath,vfsmountpoint,-1); - Tcl_DStringAppend(&filepath,"/",-1); - Tcl_DStringAppend(&filepath,initscript,-1); - vfsinitscript=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); - Tcl_DStringFree(&filepath); - - Tcl_DStringInit(&filepath); - Tcl_DStringAppend(&filepath,vfsmountpoint,-1); - Tcl_DStringAppend(&filepath,"/tcl8.6",-1); - vfstcllib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); - Tcl_DStringFree(&filepath); - - Tcl_DStringInit(&filepath); - Tcl_DStringAppend(&filepath,vfsmountpoint,-1); - Tcl_DStringAppend(&filepath,"/tk8.6",-1); - vfstklib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); - Tcl_DStringFree(&filepath); - - Tcl_IncrRefCount(vfsinitscript); - Tcl_IncrRefCount(vfstcllib); - Tcl_IncrRefCount(vfstklib); - - if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { - /* Startup script should be set before calling Tcl_AppInit */ - Tcl_SetStartupScript(vfsinitscript,NULL); - } - - if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { - /* Startup script should be set before calling Tcl_AppInit */ - Tcl_SetStartupScript(vfsinitscript,NULL); - } else { - Tcl_SetStartupScript(NULL,NULL); - } - if(Tcl_FSAccess(vfstcllib,F_OK)==0) { - Tcl_DStringAppend(&preinit,"\nset tcl_library ",-1); - Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstcllib)); - } - if(Tcl_FSAccess(vfstklib,F_OK)==0) { - Tcl_DStringAppend(&preinit,"\nset tk_library ",-1); - Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstklib)); - } - vfspreinit=Tcl_NewStringObj(Tcl_DStringValue(&preinit),-1); - /* NOTE: We never decr this refcount, lest the contents of the script be deallocated */ - Tcl_IncrRefCount(vfspreinit); - TclSetPreInitScript(Tcl_GetString(vfspreinit)); - - Tcl_DecrRefCount(vfsinitscript); - Tcl_DecrRefCount(vfstcllib); - Tcl_DecrRefCount(vfstklib); + if( Tcl_InitStubs(interp,"8.0",0)==0 ){ + return TCL_ERROR; } +#endif + Tcl_PkgProvide(interp, "zvfs", "1.0"); + Zvfs_Common_Init(interp); + Tcl_CreateObjCommand(interp, "zvfs::mount", ZvfsMountObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::unmount", ZvfsUnmountObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0); + if (Zvfs_PostInit) Zvfs_PostInit(interp); return TCL_OK; } - - -int -TclZvfsInit( - Tcl_Interp *interp) -{ - return Zvfs_doInit(interp, 0); -} - -int -Tcl_Zvfs_SafeInit( - Tcl_Interp *interp) -{ - return Zvfs_doInit(interp, 1); -} - -/************************************************************************/ -/************************************************************************/ -/************************************************************************/ - -/* - * Implement the zvfs::dump command - * - * zvfs::dump ARCHIVE - * - * Each entry in the list returned is of the following form: - * - * {FILENAME DATE-TIME SPECIAL-FLAG OFFSET SIZE COMPRESSED-SIZE} - */ -static int -ZvfsDumpObjCmd( - void *NotUsed, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv) /* Values of all arguments */ -{ - Tcl_Obj *zFilenameObj; - Tcl_Channel chan; - ZFile *pList; - int rc; - Tcl_Obj *pResult; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "FILENAME"); - return TCL_ERROR; - } - zFilenameObj=objv[1]; - chan = Tcl_FSOpenFileChannel(interp, zFilenameObj, "r", 0); - if (chan == 0) { - return TCL_ERROR; - } - rc = ZvfsReadTOC(interp, chan, &pList); - if (rc == TCL_ERROR) { - deleteZFileList(pList); - return rc; - } - Tcl_Close(interp, chan); - pResult = Tcl_GetObjResult(interp); - while (pList) { - Tcl_Obj *pEntry = Tcl_NewObj(); - ZFile *pNext; - char zDateTime[100]; - - Tcl_ListObjAppendElement(interp, pEntry, - Tcl_NewStringObj(pList->zName,-1)); - translateDosTimeDate(zDateTime, pList->dosDate, pList->dosTime); - Tcl_ListObjAppendElement(interp, pEntry, - Tcl_NewStringObj(zDateTime, -1)); - Tcl_ListObjAppendElement(interp, pEntry, - Tcl_NewIntObj(pList->isSpecial)); - Tcl_ListObjAppendElement(interp, pEntry, - Tcl_NewIntObj(pList->iOffset)); - Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByte)); - Tcl_ListObjAppendElement(interp, pEntry, - Tcl_NewIntObj(pList->nByteCompr)); - Tcl_ListObjAppendElement(interp, pResult, pEntry); - pNext = pList->pNext; - Tcl_Free((void *) pList); - pList = pNext; - } - return TCL_OK; -} - -/* - * Write a file record into a ZIP archive at the current position of the write - * cursor for channel "chan". Add a ZFile record for the file to *ppList. If - * an error occurs, leave an error message on interp and return TCL_ERROR. - * Otherwise return TCL_OK. - */ -static int -writeFile( - Tcl_Interp *interp, /* Leave an error message here */ - Tcl_Channel out, /* Write the file here */ - Tcl_Channel in, /* Read data from this file */ - Tcl_Obj *zSrcPtr, /* Name the new ZIP file entry this */ - Tcl_Obj *zDestPtr, /* Name the new ZIP file entry this */ - ZFile **ppList) /* Put a ZFile struct for the new file here */ -{ - char *zDest=Tcl_GetString(zDestPtr); - - z_stream stream; - ZFile *p; - int iEndOfData; - int nameLen; - int skip; - int toOut; - char zHdr[30]; - char zInBuf[100000]; - char zOutBuf[100000]; - struct tm *tm; - time_t now; - Tcl_StatBuf stat; - - /* - * Create a new ZFile structure for this file. - * TODO: fill in date/time etc. - */ - nameLen = strlen(zDest); - p = newZFile(nameLen, ppList); - strcpy(p->zName, zDest); - p->isSpecial = 0; - Tcl_FSStat(zSrcPtr, &stat); - now = stat.st_mtime; - tm = localtime(&now); - UnixTimeDate(tm, &p->dosDate, &p->dosTime); - p->iOffset = Tcl_Tell(out); - p->nByte = 0; - p->nByteCompr = 0; - p->nExtra = 0; - p->iCRC = 0; - p->permissions = stat.st_mode; - - /* - * Fill in as much of the header as we know. - */ - - put32(&zHdr[0], 0x04034b50); - put16(&zHdr[4], 0x0014); - put16(&zHdr[6], 0); - put16(&zHdr[8], 8); - put16(&zHdr[10], p->dosTime); - put16(&zHdr[12], p->dosDate); - put16(&zHdr[26], nameLen); - put16(&zHdr[28], 0); - - /* - * Write the header and filename. - */ - - Tcl_Write(out, zHdr, 30); - Tcl_Write(out, zDest, nameLen); - - /* - * The first two bytes that come out of the deflate compressor are some - * kind of header that ZIP does not use. So skip the first two output - * bytes. - */ - - skip = 2; - - /* - * Write the compressed file. Compute the CRC as we progress. - */ - - stream.zalloc = NULL; - stream.zfree = NULL; - stream.opaque = 0; - stream.avail_in = 0; - stream.next_in = (unsigned char *) zInBuf; - stream.avail_out = sizeof(zOutBuf); - stream.next_out = (unsigned char *) zOutBuf; - deflateInit(&stream, 9); - - - p->iCRC = crc32(0, 0, 0); - while (!Tcl_Eof(in)) { - if (stream.avail_in == 0) { - int amt = Tcl_Read(in, zInBuf, sizeof(zInBuf)); - - if (amt <= 0) { - break; - } - p->iCRC = crc32(p->iCRC, (unsigned char *) zInBuf, amt); - stream.avail_in = amt; - stream.next_in = (unsigned char *) zInBuf; - } - deflate(&stream, 0); - toOut = sizeof(zOutBuf) - stream.avail_out; - if (toOut > skip) { - Tcl_Write(out, &zOutBuf[skip], toOut - skip); - skip = 0; - } else { - skip -= toOut; - } - stream.avail_out = sizeof(zOutBuf); - stream.next_out = (unsigned char *) zOutBuf; - } - - do{ - stream.avail_out = sizeof(zOutBuf); - stream.next_out = (unsigned char *) zOutBuf; - deflate(&stream, Z_FINISH); - toOut = sizeof(zOutBuf) - stream.avail_out; - if (toOut > skip) { - Tcl_Write(out, &zOutBuf[skip], toOut - skip); - skip = 0; - } else { - skip -= toOut; - } - } while (stream.avail_out == 0); - - p->nByte = stream.total_in; - p->nByteCompr = stream.total_out - 2; - deflateEnd(&stream); - Tcl_Flush(out); - - /* - * Remember were we are in the file. Then go back and write the header, - * now that we know the compressed file size. - */ - - iEndOfData = Tcl_Tell(out); - Tcl_Seek(out, p->iOffset, SEEK_SET); - put32(&zHdr[14], p->iCRC); - put32(&zHdr[18], p->nByteCompr); - put32(&zHdr[22], p->nByte); - Tcl_Write(out, zHdr, 30); - Tcl_Seek(out, iEndOfData, SEEK_SET); - - /* - * Close the input file. - */ - - Tcl_Close(interp, in); - return TCL_OK; -} - -/* - * The arguments are two lists of ZFile structures sorted by iOffset. Either - * or both list may be empty. This routine merges the two lists together into - * a single sorted list and returns a pointer to the head of the unified list. - * - * This is part of the merge-sort algorithm. - */ -static ZFile * -mergeZFiles( - ZFile *pLeft, - ZFile *pRight) -{ - ZFile fakeHead; - ZFile *pTail; - - pTail = &fakeHead; - while (pLeft && pRight) { - ZFile *p; - - if (pLeft->iOffset <= pRight->iOffset) { - p = pLeft; - pLeft = p->pNext; - } else { - p = pRight; - pRight = p->pNext; - } - pTail->pNext = p; - pTail = p; - } - if (pLeft) { - pTail->pNext = pLeft; - } else if (pRight) { - pTail->pNext = pRight; - } else { - pTail->pNext = 0; - } - return fakeHead.pNext; -} - -/* - * Sort a ZFile list so in accending order by iOffset. - */ -static ZFile * -sortZFiles( - ZFile *pList) -{ -#define NBIN 30 - int i; - ZFile *p; - ZFile *aBin[NBIN+1]; - - for (i=0; i<=NBIN; i++) { - aBin[i] = 0; - } - while (pList) { - p = pList; - pList = p->pNext; - p->pNext = 0; - for (i=0; ipNext) { - if (pList->isSpecial) { - continue; - } - put32(&zBuf[0], 0x02014b50); - put16(&zBuf[4], 0x0317); - put16(&zBuf[6], 0x0014); - put16(&zBuf[8], 0); - put16(&zBuf[10], pList->nByte>pList->nByteCompr ? 0x0008 : 0x0000); - put16(&zBuf[12], pList->dosTime); - put16(&zBuf[14], pList->dosDate); - put32(&zBuf[16], pList->iCRC); - put32(&zBuf[20], pList->nByteCompr); - put32(&zBuf[24], pList->nByte); - put16(&zBuf[28], strlen(pList->zName)); - put16(&zBuf[30], 0); - put16(&zBuf[32], pList->nExtra); - put16(&zBuf[34], 1); - put16(&zBuf[36], 0); - put32(&zBuf[38], pList->permissions<<16); - put32(&zBuf[42], pList->iOffset); - Tcl_Write(chan, zBuf, 46); - Tcl_Write(chan, pList->zName, strlen(pList->zName)); - for (i=pList->nExtra; i>0; i-=40) { - int toWrite = i<40 ? i : 40; - - /* CAREFUL! String below is intentionally 40 spaces! */ - Tcl_Write(chan," ", - toWrite); - } - nEntry++; - } - iTocEnd = Tcl_Tell(chan); - put32(&zBuf[0], 0x06054b50); - put16(&zBuf[4], 0); - put16(&zBuf[6], 0); - put16(&zBuf[8], nEntry); - put16(&zBuf[10], nEntry); - put32(&zBuf[12], iTocEnd - iTocStart); - put32(&zBuf[16], iTocStart); - put16(&zBuf[20], 0); - Tcl_Write(chan, zBuf, 22); - Tcl_Flush(chan); -} - -/* - * Implementation of the zvfs::append command. - * - * zvfs::append ARCHIVE (SOURCE DESTINATION)* - * - * This command reads SOURCE files and appends them (using the name - * DESTINATION) to the zip archive named ARCHIVE. A new zip archive is created - * if it does not already exist. If ARCHIVE refers to a file which exists but - * is not a zip archive, then this command turns ARCHIVE into a zip archive by - * appending the necessary records and the table of contents. Treat all files - * as binary. - * - * Note: No dup checking is done, so multiple occurances of the same file is - * allowed. - */ -static int -ZvfsAppendObjCmd( - void *NotUsed, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv) /* Values of all arguments */ -{ - Tcl_Obj *zArchiveObj; - Tcl_Channel chan; - ZFile *pList = NULL, *pToc; - int rc = TCL_OK, i; - - /* - * Open the archive and read the table of contents - */ - - if (objc<2 || (objc&1)!=0) { - Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE (SRC DEST)+"); - return TCL_ERROR; - } - - zArchiveObj=objv[1]; - chan = Tcl_FSOpenFileChannel(interp, zArchiveObj, "r+", 0644); - if (chan == 0) { - chan = Tcl_FSOpenFileChannel(interp, zArchiveObj, "w+", 0644); - if (chan == 0) { - return TCL_ERROR; - } - } - if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") - || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ - /* this should never happen */ - Tcl_Close(0, chan); - return TCL_ERROR; - } - - if (Tcl_Seek(chan, 0, SEEK_END) == 0) { - /* Null file is ok, we're creating new one. */ - } else { - Tcl_Seek(chan, 0, SEEK_SET); - if (ZvfsReadTOC(interp, chan, &pList) == TCL_ERROR) { - deleteZFileList(pList); - Tcl_Close(interp, chan); - return TCL_ERROR; - } - rc = TCL_OK; - } - - /* - * Move the file pointer to the start of the table of contents. - */ - for (pToc=pList; pToc; pToc=pToc->pNext) { - if (pToc->isSpecial && strcmp(pToc->zName, "*TOC*") == 0) { - break; - } - } - if (pToc) { - Tcl_Seek(chan, pToc->iOffset, SEEK_SET); - } else { - Tcl_Seek(chan, 0, SEEK_END); - } - - /* - * Add new files to the end of the archive. - */ - - for (i=2; rc==TCL_OK && i p)) { - p = NULL; - } - return p; -} - -/* - * Implementation of the zvfs::add command. - * - * zvfs::add ?-fconfigure optpairs? ARCHIVE FILE1 FILE2 ... - * - * This command is similar to append in that it adds files to the zip archive - * named ARCHIVE, however file names are relative the current directory. In - * addition, fconfigure is used to apply option pairs to set upon opening of - * each file. Otherwise, default translation is allowed for those file - * extensions listed in the ::zvfs::auto_ext var. Binary translation will be - * used for unknown extensions. - * - * NOTE Use '-fconfigure {}' to use auto translation for all. - */ -static int -ZvfsAddObjCmd( - void *NotUsed, /* Client data for this command */ - Tcl_Interp *interp, /* The interpreter used to report errors */ - int objc, /* Number of arguments */ - Tcl_Obj *const* objv) /* Values of all arguments */ -{ - Tcl_Obj *zArchiveObj; - Tcl_Channel chan; - ZFile *pList = NULL, *pToc; - int rc = TCL_OK, i, j, oLen; - char *zOpts = NULL; - Tcl_Obj *confOpts = NULL; - int tobjc; - Tcl_Obj **tobjv; - Tcl_Obj *varObj = NULL; - - /* - * Open the archive and read the table of contents - */ - - if (objc > 3) { - zOpts = Tcl_GetStringFromObj(objv[1], &oLen); - if (!strncmp("-fconfigure", zOpts, oLen)) { - confOpts = objv[2]; - if (TCL_OK != Tcl_ListObjGetElements(interp, confOpts, - &tobjc, &tobjv) || (tobjc%2)) { - return TCL_ERROR; - } - objc -= 2; - objv += 2; - } - } - if (objc == 2) { - return TCL_OK; - } - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, - "?-fconfigure OPTPAIRS? ARCHIVE FILE1 FILE2 .."); - return TCL_ERROR; - } - - zArchiveObj = objv[1]; - chan = Tcl_FSOpenFileChannel(interp, zArchiveObj, "r+", 0644); - if (chan == 0) { - chan = Tcl_FSOpenFileChannel(interp, zArchiveObj, "w+", 0644); - if (chan == 0) { - return TCL_ERROR; - } - } - if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") - || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")){ - /* this should never happen */ - Tcl_Close(0, chan); - return TCL_ERROR; - } - - if (Tcl_Seek(chan, 0, SEEK_END) == 0) { - /* Null file is ok, we're creating new one. */ - } else { - Tcl_Seek(chan, 0, SEEK_SET); - if (ZvfsReadTOC(interp, chan, &pList) == TCL_ERROR) { - deleteZFileList(pList); - Tcl_Close(interp, chan); - return TCL_ERROR; - } - rc = TCL_OK; - } - - /* - * Move the file pointer to the start of the table of contents. - */ - - for (pToc=pList; pToc; pToc=pToc->pNext) { - if (pToc->isSpecial && strcmp(pToc->zName, "*TOC*") == 0) { - break; - } - } - if (pToc) { - Tcl_Seek(chan, pToc->iOffset, SEEK_SET); - } else { - Tcl_Seek(chan, 0, SEEK_END); - } - - /* - * Add new files to the end of the archive. - */ - - for (i=2; rc==TCL_OK && i= tobjc) { - ext = NULL; - } - } - } - if (ext == NULL) { - if (Tcl_SetChannelOption(interp, in, "-translation", "binary") - || Tcl_SetChannelOption(interp, in, "-encoding", - "binary")) { - /* this should never happen */ - Tcl_Close(0, in); - rc = TCL_ERROR; - break; - } - } - } else { - for (j=0; j +#include "tclInt.h" +#include "tclFileSystem.h" + +int Zvfs_Common_Init(Tcl_Interp *); +int Zvfs_Mount(Tcl_Interp *,CONST char *,CONST char *); + + +/* +** Boot a shell, mount the executable's VFS, detect main.tcl +*/ +int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *initscript) { + Zvfs_Common_Init(NULL); + if(!vfsmountpoint) { + vfsmountpoint="/zvfs"; + } + if(!initscript) { + initscript="main.tcl"; + } + /* We have to initialize the virtual filesystem before calling + ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find + ** its startup script files. + */ + if(!Zvfs_Mount(NULL, archive, vfsmountpoint)) { + Tcl_DString filepath; + Tcl_DString preinit; + + Tcl_Obj *vfsinitscript; + Tcl_Obj *vfstcllib; + Tcl_Obj *vfstklib; + Tcl_Obj *vfspreinit; + Tcl_DStringInit(&filepath); + Tcl_DStringInit(&preinit); + + Tcl_DStringInit(&filepath); + Tcl_DStringAppend(&filepath,vfsmountpoint,-1); + Tcl_DStringAppend(&filepath,"/",-1); + Tcl_DStringAppend(&filepath,initscript,-1); + vfsinitscript=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); + Tcl_DStringFree(&filepath); + + Tcl_DStringInit(&filepath); + Tcl_DStringAppend(&filepath,vfsmountpoint,-1); + Tcl_DStringAppend(&filepath,"/boot/tcl",-1); + vfstcllib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); + Tcl_DStringFree(&filepath); + + Tcl_DStringInit(&filepath); + Tcl_DStringAppend(&filepath,vfsmountpoint,-1); + Tcl_DStringAppend(&filepath,"/boot/tk",-1); + vfstklib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); + Tcl_DStringFree(&filepath); + + Tcl_IncrRefCount(vfsinitscript); + Tcl_IncrRefCount(vfstcllib); + Tcl_IncrRefCount(vfstklib); + + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } + /* Record the mountpoint for scripts to refer back to */ + Tcl_DStringAppend(&preinit,"\nset ::tcl_boot_vfs ",-1); + Tcl_DStringAppendElement(&preinit,vfsmountpoint); + Tcl_DStringAppend(&preinit,"\nset ::SRCDIR ",-1); + Tcl_DStringAppendElement(&preinit,vfsmountpoint); + + if(Tcl_FSAccess(vfstcllib,F_OK)==0) { + Tcl_DStringAppend(&preinit,"\nset tcl_library ",-1); + Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstcllib)); + } + if(Tcl_FSAccess(vfstklib,F_OK)==0) { + Tcl_DStringAppend(&preinit,"\nset tk_library ",-1); + Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstklib)); + } + vfspreinit=Tcl_NewStringObj(Tcl_DStringValue(&preinit),-1); + /* NOTE: We never decr this refcount, lest the contents of the script be deallocated */ + Tcl_IncrRefCount(vfspreinit); + TclSetPreInitScript(Tcl_GetString(vfspreinit)); + + Tcl_DecrRefCount(vfsinitscript); + Tcl_DecrRefCount(vfstcllib); + Tcl_DecrRefCount(vfstklib); + } + return TCL_OK; +} diff --git a/unix/Makefile.in b/unix/Makefile.in index bbe0ae5..a9c74b1 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -367,7 +367,7 @@ ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ -TCLKIT_OBJS = tclKitInit.o tclZipVfs.o +TCLKIT_OBJS = tclKitInit.o tclZipVfs.o tclZipVfsBoot.o OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ @@ -670,7 +670,7 @@ null.zip: tclkit.vfs: @echo "Building VFS File system in tclkit.vfs" @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ - "$(UNIX_DIR)/tclkit.vfs/tcl$(VERSION)" "$(TOP_DIR)" unix + "$(UNIX_DIR)/tclkit.vfs/boot/tcl" "$(TOP_DIR)" unix tclkit: ${TCLKIT_EXE} @@ -1376,6 +1376,9 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c tclZipVfs.o: $(GENERIC_DIR)/tclZipVfs.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclZipVfs.c +tclZipVfsBoot.o: $(GENERIC_DIR)/tclZipVfsBoot.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclZipVfsBoot.c + tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 4df6387..1be1ce3 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -42,7 +42,9 @@ MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); MODULE_SCOPE int main(int, char **); #ifdef TCL_ZIPVFS MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); - MODULE_SCOPE int TclZvfsInit(Tcl_Interp *); + MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); + MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); + #endif /* TCL_ZIPVFS */ /* * The following #if block allows you to change how Tcl finds the startup @@ -122,7 +124,8 @@ Tcl_AppInit( } #ifdef TCL_ZIPVFS /* Load the ZipVfs package */ - if (TclZvfsInit(interp) == TCL_ERROR) { + Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit); + if(Zvfs_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #endif diff --git a/win/Makefile.in b/win/Makefile.in index d667c51..745fa58 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -411,7 +411,7 @@ ZLIB_OBJS = \ TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ -TCLKIT_OBJS = tclKitInit.$(OBJEXT) tclZipVfs.$(OBJEXT) +TCLKIT_OBJS = tclKitInit.$(OBJEXT) tclZipVfs.$(OBJEXT) tclZipVfsBoot.$(OBJEXT) TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 6f49afa..7fd4c32 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -29,7 +29,8 @@ extern Tcl_PackageInitProc Tcltest_SafeInit; #ifdef TCL_ZIPVFS MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); - MODULE_SCOPE int TclZvfsInit(Tcl_Interp *); + MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); + MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); #endif /* TCL_ZIPVFS */ #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES @@ -167,8 +168,9 @@ Tcl_AppInit( } #ifdef TCL_ZIPVFS /* Load the ZipVfs package */ - if (TclZvfsInit(interp) == TCL_ERROR) { - return TCL_ERROR; + Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit); + if(Zvfs_Init(interp) == TCL_ERROR) { + return TCL_ERROR; } #endif #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES -- cgit v0.12 From 2b022e697945f65efc1e421e0149ec206434e353 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sun, 19 Oct 2014 20:20:09 +0000 Subject: Added a "_bare" stage to capture the kit executable before the VFS is wrapped to it. --- unix/Makefile.in | 17 +++++++++++------ win/Makefile.in | 12 ++++++++---- 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index a9c74b1..16721a9 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -674,15 +674,20 @@ tclkit.vfs: tclkit: ${TCLKIT_EXE} -# Builds an executable linked to the Tcl dynamic library -${TCLKIT_EXE}: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} null.zip tclkit.vfs +${TCLKIT_BASE}_bare: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${CC} ${CFLAGS} ${LDFLAGS} \ ${TCLKIT_OBJS} \ @TCL_BUILD_LIB_SPEC@ \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} - cat null.zip >> ${TCLKIT_EXE} - cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . + ${CC_SEARCH_FLAGS} -o ${TCLKIT_BASE}_bare + + +# Builds an executable linked to the Tcl dynamic library +${TCLKIT_EXE}: ${TCLKIT_BASE}_bare null.zip tclkit.vfs + cp -f ${TCLKIT_BASE}_bare ${TCLKIT_BASE}.zip + cat null.zip >> ${TCLKIT_BASE}.zip + cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_BASE}.zip . + mv ${TCLKIT_BASE}.zip ${TCLKIT_EXE} # Builds an executable directly from the Tcl sources tclkit-static: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs @@ -701,7 +706,7 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: clean-packages rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ - ${TCLKIT_EXE} + ${TCLKIT_EXE} tclkit* rm -rf tclkit.vfs null.zip cd dltest ; $(MAKE) clean diff --git a/win/Makefile.in b/win/Makefile.in index 745fa58..0fba203 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -443,12 +443,16 @@ tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows -$(TCLKIT): $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs +tclkit_bare: $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ - cat null.zip >> $(TCLKIT) - cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . + +$(TCLKIT): tclkit_bare null.zip tclkit.vfs + cp tclkit_bare tclkit.zip + cat null.zip >> tclkit.zip + cd tclkit.vfs ; zip -rAq $(WIN_DIR)/tclkit.zip . + mv tclkit.zip $(TCLKIT) # Builds an executable directly from the Tcl sources tclkit-direct: $(TCLKIT_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs @@ -778,7 +782,7 @@ cleanhelp: clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(TCLKIT) null.zip - $(RM) *.pch *.ilk *.pdb + $(RM) *.pch *.ilk *.pdb tclkit* $(RMDIR) tclkit.vfs distclean: distclean-packages clean -- cgit v0.12 From 963de5ae2a73c26d2f1faabe43cbc6eb2c066b97 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Oct 2014 01:20:54 +0000 Subject: Added thread mutex/release calls around the potentially contested regions of the code: Mounting a file system Unmounting a file system Reading data from an archive file The mutexes, as implemented, allow only one thread at a time access to the innards of ZipVfs. It does not try to handle the cases where two archives may be open by two different threads. (One will still have to wait until the other has finished.) Removed all of the compiler warnings under Unix (Still have to test the code under Windows.) --- generic/tclZipVfs.c | 94 ++++++++++++++++++++++------------------------------- 1 file changed, 39 insertions(+), 55 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index c9160ba..d4f8f68 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -57,6 +57,8 @@ #include #include "tcl.h" +TCL_DECLARE_MUTEX(ArchiveFileAccess) + #undef ZIPVFSCRYPT #ifdef ZIPVFSCRYPT /* Some modifications to support encrypted files */ @@ -79,8 +81,9 @@ extern const unsigned long *crc_32_tab; */ #define COMPR_BUF_SIZE 32768 static int openarch = 0; /* Set to 1 when opening archive. */ +#ifdef __WIN32__ static int maptolower=0; - +#endif /* ** All static variables are collected into a structure named "local". ** That way, it is clear in the code when we are using a static @@ -140,19 +143,6 @@ typedef struct ZvfsFile { #define INT16(B, N) (B[N] + (B[N+1]<<8)) #define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24)) -/* -** Write a 16- or 32-bit integer as little-endian into the given buffer. -*/ -static void put16(char *z, int v){ - z[0] = v & 0xff; - z[1] = (v>>8) & 0xff; -} -static void put32(char *z, int v){ - z[0] = v & 0xff; - z[1] = (v>>8) & 0xff; - z[2] = (v>>16) & 0xff; - z[3] = (v>>24) & 0xff; -} /* Convert DOS time to unix time. */ static time_t DosTimeDate(int dosDate, int dosTime){ @@ -169,25 +159,6 @@ static time_t DosTimeDate(int dosDate, int dosTime){ return mktime(tm); } -/* -** Translate a DOS time and date stamp into a human-readable string. -*/ -static void translateDosTimeDate(char *zStr, int dosDate, int dosTime){ - static char *zMonth[] = { "nil", - "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", - }; - - sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", - dosDate & 0x1f, - zMonth[ ((dosDate&0x1e0)>>5) ], - ((dosDate&0xfe00)>>9) + 1980, - (dosTime&0xf800)>>11, - (dosTime&0x7e)>>5, - dosTime&0x1f - ); -} - /* Return count of char ch in str */ int strchrcnt(char *str, char ch) { int cnt=0; @@ -476,15 +447,17 @@ int Zvfs_Mount( Tcl_Free((char *)zTrueName); return TCL_OK; } + Tcl_MutexLock(&ArchiveFileAccess); chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0); if (!chan) { - return TCL_ERROR; + Tcl_MutexUnlock(&ArchiveFileAccess); + return TCL_ERROR; } if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){ - return TCL_ERROR; + goto closeReleaseDie; } if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) { - return TCL_ERROR; + goto closeReleaseDie; } /* @@ -496,7 +469,7 @@ int Zvfs_Mount( Tcl_Read(chan, (char *) zBuf, 22); if (memcmp(zBuf, "\120\113\05\06", 4)) { if(interp) Tcl_AppendResult(interp, "not a ZIP archive", NULL); - return TCL_ERROR; + goto closeReleaseDie; } /* @@ -510,9 +483,7 @@ int Zvfs_Mount( if (interp) { Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint,0); } - Tcl_Free(zArchiveName); - Tcl_Close(interp, chan); - return TCL_ERROR; + goto closeReleaseDie; } /* @@ -641,11 +612,16 @@ int Zvfs_Mount( Tcl_Seek(chan, lenExtra, SEEK_CUR); } Tcl_Close(interp, chan); - if (zTrueName) { Tcl_Free(zTrueName); } + Tcl_MutexUnlock(&ArchiveFileAccess); return TCL_OK; + +closeReleaseDie: + Tcl_Close(interp, chan); + Tcl_MutexUnlock(&ArchiveFileAccess); + return TCL_ERROR; } /* @@ -682,6 +658,7 @@ static int Zvfs_Unmount( if (pEntry == 0) { return 0; } + Tcl_MutexLock(&ArchiveFileAccess); pArchive = Tcl_GetHashValue(pEntry); Tcl_DeleteHashEntry(pEntry); Tcl_Free(pArchive->zName); @@ -705,6 +682,7 @@ static int Zvfs_Unmount( Tcl_Free(pFile->zName); Tcl_Free((void *) pFile); } + Tcl_MutexUnlock(&ArchiveFileAccess); return 1; } @@ -980,6 +958,7 @@ static int vfsClose( Tcl_Close(interp, pInfo->chan); Tcl_DeleteExitHandler(vfsExit, pInfo); } + Tcl_MutexUnlock(&ArchiveFileAccess); Tcl_Free((char*)pInfo); return TCL_OK; } @@ -1019,12 +998,14 @@ static int vfsRead ( int *pErrorCode /* Location of error flag */ ){ /* Read and decompress all data for the associated file into the specified buffer */ ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData; + int len; +#ifdef ZIPVFSCRYPT unsigned char encryptHdr[12]; int C; int temp; int i; - int len; char pwdbuf[20]; +#endif if( (unsigned long)toRead > pInfo->nByte ){ toRead = pInfo->nByte; @@ -1054,7 +1035,7 @@ static int vfsRead ( if( pInfo->isCompressed ){ int err = Z_OK; z_stream *stream = &pInfo->stream; - stream->next_out = buf; + stream->next_out = (unsigned char *)buf; stream->avail_out = toRead; while (stream->avail_out) { if (!stream->avail_in) { @@ -1062,7 +1043,7 @@ static int vfsRead ( if (len > COMPR_BUF_SIZE) { len = COMPR_BUF_SIZE; } - len = Tcl_Read(pInfo->chan, pInfo->zBuf, len); + len = Tcl_Read(pInfo->chan, (char *)pInfo->zBuf, len); #ifdef ZIPVFSCRYPT if (pInfo->isEncrypted) { @@ -1224,6 +1205,8 @@ static Tcl_Channel ZvfsFileOpen( return NULL; } openarch = 1; + + Tcl_MutexLock(&ArchiveFileAccess); chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0); openarch = 0; @@ -1231,23 +1214,22 @@ static Tcl_Channel ZvfsFileOpen( local.firstMount = pFile->pArchive->zName; } if( chan==0 ){ + Tcl_MutexUnlock(&ArchiveFileAccess); return 0; } if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") || Tcl_SetChannelOption(interp, chan, "-encoding", "binary") ){ /* this should never happen */ - Tcl_Close(0, chan); - return 0; + goto closeReleaseDie; } Tcl_Seek(chan, pFile->iOffset, SEEK_SET); - Tcl_Read(chan, zBuf, 30); + Tcl_Read(chan, (char *)zBuf, 30); if( memcmp(zBuf, "\120\113\03\04", 4) ){ if( interp ){ Tcl_AppendResult(interp, "local header mismatch: ", NULL); } - Tcl_Close(interp, chan); - return 0; + goto closeReleaseDie; } pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) ); pInfo->chan = chan; @@ -1297,11 +1279,17 @@ static Tcl_Channel ZvfsFileOpen( /* Read and decompress the file contents */ if (pInfo->uBuf) { pInfo->uBuf[0] = 0; - vfsRead(pInfo, pInfo->uBuf, pInfo->nByte, &errCode); + vfsRead(pInfo, (char *)pInfo->uBuf, pInfo->nByte, &errCode); pInfo->readSoFar = 0; } return chan; + +closeReleaseDie: + Tcl_Close(interp, chan); + Tcl_MutexUnlock(&ArchiveFileAccess); + return NULL; + } Tcl_Channel Tobe_FSOpenFileChannelProc @@ -1342,7 +1330,6 @@ int Tobe_FSStatProc _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)) { ** This routine does an access() system call for a ZVFS file. */ int Tobe_FSAccessProc _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)) { - int len; char *path=Tcl_GetString(pathPtr); ZvfsFile *pFile; @@ -1401,7 +1388,6 @@ int Tobe_FSMatchInDirectoryProc ( Tcl_HashEntry *pEntry; /* Hash table entry */ Tcl_HashSearch zSearch; /* Search all mount points */ ZvfsArchive *pArchive; /* The ZIP archive being mounted */ - Tcl_Obj *pVols=0, *pVol; char mountpt[200]; int i=1; mountpt[0]='/'; @@ -1474,7 +1460,7 @@ int Tobe_FSMatchInDirectoryProc ( } } } -done: + if (zPattern) { free(zPattern); } @@ -1801,7 +1787,6 @@ int Zvfs_Common_Init(Tcl_Interp *interp) { } int Zvfs_Init(Tcl_Interp *interp){ - int n; #ifdef USE_TCL_STUBS if( Tcl_InitStubs(interp,"8.0",0)==0 ){ return TCL_ERROR; @@ -1819,7 +1804,6 @@ int Zvfs_Init(Tcl_Interp *interp){ } int Zvfs_SafeInit(Tcl_Interp *interp){ - int n; #ifdef USE_TCL_STUBS if( Tcl_InitStubs(interp,"8.0",0)==0 ){ return TCL_ERROR; -- cgit v0.12 From 307bb5f72d17a66308509ba1001fc8ca502100c8 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Oct 2014 01:23:11 +0000 Subject: Removed the dual ported canonical path mapping scheme to allow Odie and FreeWrap to coexist. The results of both functions were functionally identical. --- generic/tclZipVfs.c | 100 ---------------------------------------------------- 1 file changed, 100 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index d4f8f68..80230c3 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -167,105 +167,6 @@ int strchrcnt(char *str, char ch) { return cnt; } -#ifdef FREEWRAP -/* -** Concatenate zTail onto zRoot to form a pathname. zRoot will begin -** with "/". After concatenation, simplify the pathname be removing -** unnecessary ".." and "." directories. Under windows, make all -** characters lower case. -** -** Resulting pathname is returned. Space to hold the returned path is -** obtained from Tcl_Alloc() and should be freed by the calling function. -*/ -static char *CanonicalPath(const char *zRoot, const char *zTail){ - char *zPath; - int i, j, c; - -#ifdef __WIN32__ - if( isalpha(zTail[0]) && zTail[1]==':' ){ zTail += 2; } - if( zTail[0]=='\\' ){ zRoot = ""; zTail++; } - if( zTail[0]=='\\' ){ zRoot = "/"; zTail++; } // account for UNC style path -#endif - if( zTail[0]=='/' ){ zRoot = ""; zTail++; } - if( zTail[0]=='/' ){ zRoot = "/"; zTail++; } // account for UNC style path - zPath = (void *)Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 ); - if( zPath==0 ) return 0; - sprintf(zPath, "%s/%s", zRoot, zTail); - for(i=j=0; (c = zPath[i])!=0; i++){ -#ifdef __WIN32__ - if( isupper(c) ) { if (maptolower) c = tolower(c); } - else if( c=='\\' ) c = '/'; -#endif - if( c=='/' ){ - int c2 = zPath[i+1]; - if( c2=='/' ) continue; - if( c2=='.' ){ - int c3 = zPath[i+2]; - if( c3=='/' || c3==0 ){ - i++; - continue; - } - if( c3=='.' && (zPath[i+3]=='.' || zPath[i+3]==0) ){ - i += 2; - while( j>0 && zPath[j-1]!='/' ){ j--; } - continue; - } - } - } - zPath[j++] = c; - } - if( j==0 ){ zPath[j++] = '/'; } - zPath[j] = 0; - return zPath; -} -/* -** Construct an absolute pathname in memory obtained from Tcl_Alloc -** that means the same file as the pathname given. -** -** Under windows, all backslash (\) charaters are converted to foward -** slash (/) and all upper case letters are converted to lower case. -** The drive letter (if present) is preserved. -*/ -static char *AbsolutePath(const char *z){ - Tcl_DString pwd; - char *zResult; - Tcl_DStringInit(&pwd); - if( *z!='/' -#ifdef __WIN32__ - && *z!='\\' && (!isalpha(*z) || z[1]!=':') -#endif - ){ - /* Case 1: "z" is a relative path. So prepend the current working - ** directory in order to generate an absolute path. Note that the - ** CanonicalPath() function takes care of converting upper to lower - ** case and (\) to (/) under windows. - */ - Tcl_GetCwd(0, &pwd); - zResult = CanonicalPath( Tcl_DStringValue(&pwd), z); - Tcl_DStringFree(&pwd); - } else { - /* Case 2: "z" is an absolute path already. We just need to make - ** a copy of it. Under windows, we need to convert upper to lower - ** case and (\) into (/) on the copy. - */ - zResult = (void *)Tcl_Alloc( strlen(z) + 1 ); - if( zResult==0 ) return 0; - strcpy(zResult, z); -#ifdef __WIN32__ - { - int i, c; - for(i=0; (c=zResult[i])!=0; i++){ - if( isupper(c) ) { - // zResult[i] = tolower(c); - } - else if( c=='\\' ) zResult[i] = '/'; - } - } -#endif - } - return zResult; -} -#else /* ** Concatenate zTail onto zRoot to form a pathname. zRoot will begin ** with "/". After concatenation, simplify the pathname be removing @@ -379,7 +280,6 @@ AbsolutePath( } return zResult; } -#endif /* ** Read a ZIP archive and make entries in the virutal file hash table for all -- cgit v0.12 From b2164040ac3124d35041c71e5ba733563db32443 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Oct 2014 19:59:19 +0000 Subject: Renamed "tclkit" to "tclzsh" Removed tclzsh from "make binaries". (It the user wants it, they have to ask for it. It requires a working Tclsh and an exernal Zip) --- unix/Makefile.in | 58 ++++++++++++++++++++++++++++---------------------------- win/Makefile.in | 50 ++++++++++++++++++++++++------------------------ 2 files changed, 54 insertions(+), 54 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 16721a9..918e9fc 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -169,11 +169,11 @@ INSTALL_DATA_DIR = ${INSTALL} -d -m 755 EXE_SUFFIX = @EXEEXT@ TCL_EXE = tclsh${EXE_SUFFIX} ifeq ($(SHARED_BUILD),0) -TCLKIT_BASE = tclkits +TCLZSH_BASE = tclzshs else -TCLKIT_BASE = tclkitd +TCLZSH_BASE = tclzshd endif -TCLKIT_EXE = ${TCLKIT_BASE}${EXE_SUFFIX} +TCLZSH_EXE = ${TCLZSH_BASE}${EXE_SUFFIX} TCLTEST_EXE = tcltest${EXE_SUFFIX} NATIVE_TCLSH = @TCLSH_PROG@ @@ -367,7 +367,7 @@ ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ -TCLKIT_OBJS = tclKitInit.o tclZipVfs.o tclZipVfsBoot.o +TCLZSH_OBJS = tclZipShInit.o tclZipVfs.o tclZipVfsBoot.o OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ @@ -624,7 +624,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ all: binaries libraries doc packages -binaries: ${LIB_FILE} ${TCL_EXE} ${TCLKIT_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} libraries: @@ -667,36 +667,36 @@ null.zip: # Rather than force an install, pack the files we need into a # file system under our control -tclkit.vfs: - @echo "Building VFS File system in tclkit.vfs" +tclzsh.vfs: + @echo "Building VFS File system in tclzsh.vfs" @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ - "$(UNIX_DIR)/tclkit.vfs/boot/tcl" "$(TOP_DIR)" unix + "$(UNIX_DIR)/tclzsh.vfs/boot/tcl" "$(TOP_DIR)" unix -tclkit: ${TCLKIT_EXE} +tclzsh: ${TCLZSH_EXE} -${TCLKIT_BASE}_bare: ${TCLKIT_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} +${TCLZSH_BASE}_bare: ${TCLZSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLKIT_OBJS} \ + ${TCLZSH_OBJS} \ @TCL_BUILD_LIB_SPEC@ \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLKIT_BASE}_bare + ${CC_SEARCH_FLAGS} -o ${TCLZSH_BASE}_bare # Builds an executable linked to the Tcl dynamic library -${TCLKIT_EXE}: ${TCLKIT_BASE}_bare null.zip tclkit.vfs - cp -f ${TCLKIT_BASE}_bare ${TCLKIT_BASE}.zip - cat null.zip >> ${TCLKIT_BASE}.zip - cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_BASE}.zip . - mv ${TCLKIT_BASE}.zip ${TCLKIT_EXE} +${TCLZSH_EXE}: ${TCLZSH_BASE}_bare null.zip tclzsh.vfs + cp -f ${TCLZSH_BASE}_bare ${TCLZSH_BASE}.zip + cat null.zip >> ${TCLZSH_BASE}.zip + cd tclzsh.vfs ; zip -rAq ${UNIX_DIR}/${TCLZSH_BASE}.zip . + mv ${TCLZSH_BASE}.zip ${TCLZSH_EXE} # Builds an executable directly from the Tcl sources -tclkit-static: ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclkit.vfs +tclzsh-static: ${TCLZSH_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclzsh.vfs ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLKIT_OBJS} ${OBJS} ${ZLIB_OBJS} \ + ${TCLZSH_OBJS} ${OBJS} ${ZLIB_OBJS} \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLKIT_EXE} - cat null.zip >> ${TCLKIT_EXE} - cd tclkit.vfs ; zip -rAq ${UNIX_DIR}/${TCLKIT_EXE} . + ${CC_SEARCH_FLAGS} -o ${TCLZSH_EXE} + cat null.zip >> ${TCLZSH_EXE} + cd tclzsh.vfs ; zip -rAq ${UNIX_DIR}/${TCLZSH_EXE} . Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status @@ -706,8 +706,8 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: clean-packages rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ - ${TCLKIT_EXE} tclkit* - rm -rf tclkit.vfs null.zip + ${TCLZSH_EXE} tclzsh* + rm -rf tclzsh.vfs null.zip cd dltest ; $(MAKE) clean distclean: distclean-packages clean @@ -851,8 +851,8 @@ install-binaries: binaries @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" - @echo "Installing ${TCLKIT_EXE} as $(BIN_INSTALL_DIR)/${TCLKIT_BASE}$(VERSION)${EXE_SUFFIX}" - @$(INSTALL_PROGRAM) ${TCLKIT_EXE} "$(BIN_INSTALL_DIR)/${TCLKIT_BASE}$(VERSION)${EXE_SUFFIX}" + @echo "Installing ${TCLZSH_EXE} as $(BIN_INSTALL_DIR)/${TCLZSH_BASE}$(VERSION)${EXE_SUFFIX}" + @$(INSTALL_PROGRAM) ${TCLZSH_EXE} "$(BIN_INSTALL_DIR)/${TCLZSH_BASE}$(VERSION)${EXE_SUFFIX}" @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/" @@ -1076,9 +1076,9 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} mv tclAppInit.sav tclAppInit.o; \ fi; -tclKitInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} +tclZipShInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE} $(CC) -c $(APP_CC_SWITCHES) \ - -DTCL_ZIPVFS $(UNIX_DIR)/tclAppInit.c -o tclKitInit.o + -DTCL_ZIPVFS $(UNIX_DIR)/tclAppInit.c -o tclZipShInit.o # Object files used on all Unix systems: @@ -2186,7 +2186,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages -.PHONY: tclkit-static tclkit +.PHONY: tclzsh-static tclzsh #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/win/Makefile.in b/win/Makefile.in index 0fba203..6877938 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -149,7 +149,7 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} -TCLKIT = tclkit$(VER)${EXESUFFIX} +TCLZSH = tclzsh$(VER)${EXESUFFIX} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -411,7 +411,7 @@ ZLIB_OBJS = \ TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ -TCLKIT_OBJS = tclKitInit.$(OBJEXT) tclZipVfs.$(OBJEXT) tclZipVfsBoot.$(OBJEXT) +TCLZSH_OBJS = tclZipShInit.$(OBJEXT) tclZipVfs.$(OBJEXT) tclZipVfsBoot.$(OBJEXT) TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] @@ -419,7 +419,7 @@ all: binaries libraries doc packages tcltest: $(TCLSH) $(TEST_DLL_FILE) -binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) $(TCLKIT) +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) libraries: @@ -430,7 +430,7 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -tclkit: $(TCLKIT) +tclzsh: $(TCLZSH) null.zip: touch .empty @@ -438,33 +438,33 @@ null.zip: # Rather than force an install, pack the files we need into a # file system under our control -tclkit.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) - @echo "Building VFS File system in tclkit.vfs" +tclzsh.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) + @echo "Building VFS File system in tclzsh.vfs" @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ - "$(WIN_DIR)/tclkit.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows + "$(WIN_DIR)/tclzsh.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows -tclkit_bare: $(TCLKIT_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLKIT_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ +tclzsh_bare: $(TCLZSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLZSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -$(TCLKIT): tclkit_bare null.zip tclkit.vfs - cp tclkit_bare tclkit.zip - cat null.zip >> tclkit.zip - cd tclkit.vfs ; zip -rAq $(WIN_DIR)/tclkit.zip . - mv tclkit.zip $(TCLKIT) +$(TCLZSH): tclzsh_bare null.zip tclzsh.vfs + cp tclzsh_bare tclzsh.zip + cat null.zip >> tclzsh.zip + cd tclzsh.vfs ; zip -rAq $(WIN_DIR)/tclzsh.zip . + mv tclzsh.zip $(TCLZSH) # Builds an executable directly from the Tcl sources -tclkit-direct: $(TCLKIT_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclkit.vfs +tclzsh-direct: $(TCLZSH_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclzsh.vfs rm *.$(OBJEXT) - $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLKIT_OBJS) \ + $(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLZSH_OBJS) \ ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} \ $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ rm *.$(OBJEXT) - cat null.zip >> $(TCLKIT) - cd tclkit.vfs ; zip -rAq $(WIN_DIR)/$(TCLKIT) . + cat null.zip >> $(TCLZSH) + cd tclzsh.vfs ; zip -rAq $(WIN_DIR)/$(TCLZSH) . cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -529,7 +529,7 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) -tclKitInit.${OBJEXT}: tclAppInit.c +tclZipShInit.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_ZIPVFS @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. @@ -616,7 +616,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH) $(TCLKIT); \ + @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH) $(TCLZSH); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ @@ -781,9 +781,9 @@ cleanhelp: clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) $(TCLKIT) null.zip - $(RM) *.pch *.ilk *.pdb tclkit* - $(RMDIR) tclkit.vfs + $(RM) $(TCLSH) $(CAT32) $(TCLZSH) null.zip + $(RM) *.pch *.ilk *.pdb tclzsh* + $(RMDIR) tclzsh.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ @@ -915,8 +915,8 @@ html-tk: $(TCLSH) .PHONY: install-doc install-private-headers test test-tcl runtest shell .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html -.PHONY: html-tcl html-tk tclkit -.PHONY: tclkit-direct tclkit-dynamic tclkit-kitlib +.PHONY: html-tcl html-tk tclzsh +.PHONY: tclzsh-direct tclzsh-dynamic tclzsh-kitlib # DO NOT DELETE THIS LINE -- make depend depends on it. -- cgit v0.12 From 6826dbab466f01f5d52b4ff477e810297aa96991 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Oct 2014 20:54:05 +0000 Subject: Added the zipfile::encode routine from Tcllib, and a rudimentary zipfile decode as a package "zvfstools" --- library/zvfstools/pkgIndex.tcl | 2 + library/zvfstools/zvfstools.tcl | 309 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 311 insertions(+) create mode 100644 library/zvfstools/pkgIndex.tcl create mode 100644 library/zvfstools/zvfstools.tcl diff --git a/library/zvfstools/pkgIndex.tcl b/library/zvfstools/pkgIndex.tcl new file mode 100644 index 0000000..23a8040 --- /dev/null +++ b/library/zvfstools/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide zvfs] 1.0]} {return} +package ifneeded zvfstools 0.1 [list source [file join $dir zvfstools.tcl]] diff --git a/library/zvfstools/zvfstools.tcl b/library/zvfstools/zvfstools.tcl new file mode 100644 index 0000000..05119c6 --- /dev/null +++ b/library/zvfstools/zvfstools.tcl @@ -0,0 +1,309 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Copyright (c) 2008-2009 ActiveState Software Inc. +## Andreas Kupries +## Copyright (C) 2009 Pat Thoyts +## Copyright (C) 2014 Sean Woods +## +## BSD License +## +# Package providing commands for: +# * the generation of a zip archive, +# * building a zip archive from a file system +# * building a file system from a zip archive + +package require Tcl 8.6 +package require zvfs 1.0 +# Cop +# +# Create ZIP archives in Tcl. +# +# Create a zipkit using mkzip filename.zkit -zipkit -directory xyz.vfs +# or a zipfile using mkzip filename.zip -directory dirname -exclude "*~" +# + +proc ::zvfs::setbinary chan { + fconfigure $chan \ + -encoding binary \ + -translation binary \ + -eofchar {} + +} + +# zip::timet_to_dos +# +# Convert a unix timestamp into a DOS timestamp for ZIP times. +# +# DOS timestamps are 32 bits split into bit regions as follows: +# 24 16 8 0 +# +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +# |Y|Y|Y|Y|Y|Y|Y|m| |m|m|m|d|d|d|d|d| |h|h|h|h|h|m|m|m| |m|m|m|s|s|s|s|s| +# +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +# +proc ::zvfs::timet_to_dos {time_t} { + set s [clock format $time_t -format {%Y %m %e %k %M %S}] + scan $s {%d %d %d %d %d %d} year month day hour min sec + expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) + | ($hour << 11) | ($min << 5) | ($sec >> 1)} +} + +# zip::pop -- +# +# Pop an element from a list +# +proc ::zvfs::pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +# zip::walk -- +# +# Walk a directory tree rooted at 'path'. The excludes list can be +# a set of glob expressions to match against files and to avoid. +# The match arg is internal. +# eg: walk library {CVS/* *~ .#*} to exclude CVS and emacs cruft. +# +proc ::zvfs::walk {base {excludes ""} {match *} {path {}}} { + set result {} + set imatch [file join $path $match] + set files [glob -nocomplain -tails -types f -directory $base $imatch] + foreach file $files { + set excluded 0 + foreach glob $excludes { + if {[string match $glob $file]} { + set excluded 1 + break + } + } + if {!$excluded} {lappend result $file} + } + foreach dir [glob -nocomplain -tails -types d -directory $base $imatch] { + set subdir [walk $base $excludes $match $dir] + if {[llength $subdir]>0} { + set result [concat $result [list $dir] $subdir] + } + } + return $result +} + +# zvfs::add_file_to_archive -- +# +# Add a single file to a zip archive. The zipchan channel should +# already be open and binary. You may provide a comment for the +# file The return value is the central directory record that +# will need to be used when finalizing the zip archive. +# +# FIX ME: should handle the current offset for non-seekable channels +# +proc ::zvfs::add_file_to_archive {zipchan base path {comment ""}} { + set fullpath [file join $base $path] + set mtime [timet_to_dos [file mtime $fullpath]] + if {[file isdirectory $fullpath]} { + append path / + } + set utfpath [encoding convertto utf-8 $path] + set utfcomment [encoding convertto utf-8 $comment] + set flags [expr {(1<<11)}] ;# utf-8 comment and path + set method 0 ;# store 0, deflate 8 + set attr 0 ;# text or binary (default binary) + set version 20 ;# minumum version req'd to extract + set extra "" + set crc 0 + set size 0 + set csize 0 + set data "" + set seekable [expr {[tell $zipchan] != -1}] + if {[file isdirectory $fullpath]} { + set attrex 0x41ff0010 ;# 0o040777 (drwxrwxrwx) + } elseif {[file executable $fullpath]} { + set attrex 0x81ff0080 ;# 0o100777 (-rwxrwxrwx) + } else { + set attrex 0x81b60020 ;# 0o100666 (-rw-rw-rw-) + if {[file extension $fullpath] in {".tcl" ".txt" ".c"}} { + set attr 1 ;# text + } + } + + if {[file isfile $fullpath]} { + set size [file size $fullpath] + if {!$seekable} {set flags [expr {$flags | (1 << 3)}]} + } + + set offset [tell $zipchan] + set local [binary format a4sssiiiiss PK\03\04 \ + $version $flags $method $mtime $crc $csize $size \ + [string length $utfpath] [string length $extra]] + append local $utfpath $extra + puts -nonewline $zipchan $local + + if {[file isfile $fullpath]} { + # If the file is under 2MB then zip in one chunk, otherwize we use + # streaming to avoid requiring excess memory. This helps to prevent + # storing re-compressed data that may be larger than the source when + # handling PNG or JPEG or nested ZIP files. + if {$size < 0x00200000} { + set fin [::open $fullpath rb] + setbinary $fin + set data [::read $fin] + set crc [::zlib crc32 $data] + set cdata [::zlib deflate $data] + if {[string length $cdata] < $size} { + set method 8 + set data $cdata + } + close $fin + set csize [string length $data] + puts -nonewline $zipchan $data + } else { + set method 8 + set fin [::open $fullpath rb] + setbinary $fin + set zlib [::zlib stream deflate] + while {![eof $fin]} { + set data [read $fin 4096] + set crc [zlib crc32 $data $crc] + $zlib put $data + if {[string length [set zdata [$zlib get]]]} { + incr csize [string length $zdata] + puts -nonewline $zipchan $zdata + } + } + close $fin + $zlib finalize + set zdata [$zlib get] + incr csize [string length $zdata] + puts -nonewline $zipchan $zdata + $zlib close + } + + if {$seekable} { + # update the header if the output is seekable + set local [binary format a4sssiiii PK\03\04 \ + $version $flags $method $mtime $crc $csize $size] + set current [tell $zipchan] + seek $zipchan $offset + puts -nonewline $zipchan $local + seek $zipchan $current + } else { + # Write a data descriptor record + set ddesc [binary format a4iii PK\7\8 $crc $csize $size] + puts -nonewline $zipchan $ddesc + } + } + + set hdr [binary format a4ssssiiiisssssii PK\01\02 0x0317 \ + $version $flags $method $mtime $crc $csize $size \ + [string length $utfpath] [string length $extra]\ + [string length $utfcomment] 0 $attr $attrex $offset] + append hdr $utfpath $extra $utfcomment + return $hdr +} + +# zvfs::mkzip -- +# +# Create a zip archive in 'filename'. If a file already exists it will be +# overwritten by a new file. If '-directory' is used, the new zip archive +# will be rooted in the provided directory. +# -runtime can be used to specify a prefix file. For instance, +# zip myzip -runtime unzipsfx.exe -directory subdir +# will create a self-extracting zip archive from the subdir/ folder. +# The -comment parameter specifies an optional comment for the archive. +# +# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt +# +proc ::zvfs::mkzip {filename args} { + array set opts { + -zipkit 0 -runtime "" -comment "" -directory "" + -exclude {CVS/* */CVS/* *~ ".#*" "*/.#*"} + } + + while {[string match -* [set option [lindex $args 0]]]} { + switch -exact -- $option { + -zipkit { set opts(-zipkit) 1 } + -comment { set opts(-comment) [encoding convertto utf-8 [pop args 1]] } + -runtime { set opts(-runtime) [pop args 1] } + -directory {set opts(-directory) [file normalize [pop args 1]] } + -exclude {set opts(-exclude) [pop args 1] } + -- { pop args ; break } + default { + break + } + } + pop args + } + + set zf [::open $filename wb] + setbinary $zf + if {$opts(-runtime) ne ""} { + set rt [::open $opts(-runtime) rb] + setbinary $rt + fcopy $rt $zf + close $rt + } elseif {$opts(-zipkit)} { + set zkd "#!/usr/bin/env tclkit\n\# This is a zip-based Tcl Module\n" + append zkd "package require vfs::zip\n" + append zkd "vfs::zip::Mount \[info script\] \[info script\]\n" + append zkd "if {\[file exists \[file join \[info script\] main.tcl\]\]} \{\n" + append zkd " source \[file join \[info script\] main.tcl\]\n" + append zkd "\}\n" + append zkd \x1A + puts -nonewline $zf $zkd + } + + set count 0 + set cd "" + + if {$opts(-directory) ne ""} { + set paths [walk $opts(-directory) $opts(-exclude)] + } else { + set paths [glob -nocomplain {*}$args] + } + foreach path $paths { + puts $path + append cd [add_file_to_archive $zf $opts(-directory) $path] + incr count + } + set cdoffset [tell $zf] + set endrec [binary format a4ssssiis PK\05\06 0 0 \ + $count $count [string length $cd] $cdoffset\ + [string length $opts(-comment)]] + append endrec $opts(-comment) + puts -nonewline $zf $cd + puts -nonewline $zf $endrec + close $zf + + return +} + +### +# Decode routines +### +proc ::zvfs::copy_file {zipbase destbase file} { + set l [string length $zipbase] + set relname [string trimleft [string range $file $l end] /] + if {[file isdirectory $file]} { + foreach sfile [glob -nocomplain $file/*] { + file mkdir [file join $destbase $relname] + copy_file $zipbase $destbase $sfile + } + return + } + file copy -force $file [file join $destbase $relname] +} + +# ### ### ### ######### ######### ######### +## Convenience command, decode and copy to dir +proc ::zvfs::unzip {in out} { + set root /ziptmp#[incr ::zvfs::count] + zvfs::mount $in $root + set out [file normalize $out] + foreach file [glob $root/*] { + copy_file $root $out $file + } + zvfs::unmount $in + return +} + +package provide zvfstools 0.1 -- cgit v0.12 From 9171dde34641416c1530c7a8ba9aa49ca267a55c Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Oct 2014 01:04:07 +0000 Subject: Replaced calls to zip with calls to the new pure-tcl zipfile encoder embedded in zvfstools. Fixed a bug in the encoder for zvfstools. It was exporting files, but not directories. This lack of directories was causing the bootloader to miss that /zvfs/boot/tcl/init.tcl existed, because it was checking for the existance of /zvfs/boot/tcl. I compared the archives created by zvfstools::mkzip to the archives created by zip, and the difference came down to the fact that zip did create TOC entries for directories and zvfstools::mkzip was failing to do so. (So I'm pretty sure the new behavior is "standard.") --- library/zvfstools/zvfstools.tcl | 28 ++++++++++++++++++++-------- tools/mkzip.tcl | 6 ++++++ unix/Makefile.in | 15 +++++---------- win/Makefile.in | 12 ++++++------ 4 files changed, 37 insertions(+), 24 deletions(-) create mode 100644 tools/mkzip.tcl diff --git a/library/zvfstools/zvfstools.tcl b/library/zvfstools/zvfstools.tcl index 05119c6..f755283 100644 --- a/library/zvfstools/zvfstools.tcl +++ b/library/zvfstools/zvfstools.tcl @@ -80,6 +80,7 @@ proc ::zvfs::walk {base {excludes ""} {match *} {path {}}} { if {!$excluded} {lappend result $file} } foreach dir [glob -nocomplain -tails -types d -directory $base $imatch] { + lappend result $dir set subdir [walk $base $excludes $match $dir] if {[llength $subdir]>0} { set result [concat $result [list $dir] $subdir] @@ -137,7 +138,7 @@ proc ::zvfs::add_file_to_archive {zipchan base path {comment ""}} { [string length $utfpath] [string length $extra]] append local $utfpath $extra puts -nonewline $zipchan $local - + if {[file isfile $fullpath]} { # If the file is under 2MB then zip in one chunk, otherwize we use # streaming to avoid requiring excess memory. This helps to prevent @@ -242,12 +243,24 @@ proc ::zvfs::mkzip {filename args} { fcopy $rt $zf close $rt } elseif {$opts(-zipkit)} { - set zkd "#!/usr/bin/env tclkit\n\# This is a zip-based Tcl Module\n" - append zkd "package require vfs::zip\n" - append zkd "vfs::zip::Mount \[info script\] \[info script\]\n" - append zkd "if {\[file exists \[file join \[info script\] main.tcl\]\]} \{\n" - append zkd " source \[file join \[info script\] main.tcl\]\n" - append zkd "\}\n" + set zkd {#!/usr/bin/env tclsh +# This is a zip-based Tcl Module +if {![package vsatisfies [package provide zvfs] 1.0]} { + package require vfs::zip + vfs::zip::Mount [info script] [info script] +} else { + zvfs::mount [info script] [info script] +} +# Load any CLIP file present +if {[file exists [file join [info script] pkgIndex.tcl]] } { + set dir [info script] + source [file join [info script] pkgIndex.tcl] +} +# Run any main.tcl present +if {[file exists [file join [info script] main.tcl]] } { + source [file join [info script] main.tcl] +} + } append zkd \x1A puts -nonewline $zf $zkd } @@ -261,7 +274,6 @@ proc ::zvfs::mkzip {filename args} { set paths [glob -nocomplain {*}$args] } foreach path $paths { - puts $path append cd [add_file_to_archive $zf $opts(-directory) $path] incr count } diff --git a/tools/mkzip.tcl b/tools/mkzip.tcl new file mode 100644 index 0000000..e53bae3 --- /dev/null +++ b/tools/mkzip.tcl @@ -0,0 +1,6 @@ +### +# Wrapper to allow access to Tcl's zvfs::mkzip command from Makefiles +### +package require zvfs +source [file join [file dirname [file normalize [info script]]] .. library zvfstools zvfstools.tcl] +zvfs::mkzip {*}$argv diff --git a/unix/Makefile.in b/unix/Makefile.in index 918e9fc..b635c0a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -661,10 +661,6 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above ${NATIVE_TCLSH}: -null.zip: - touch .empty - zip null.zip .empty - # Rather than force an install, pack the files we need into a # file system under our control tclzsh.vfs: @@ -681,13 +677,12 @@ ${TCLZSH_BASE}_bare: ${TCLZSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCLZSH_BASE}_bare - # Builds an executable linked to the Tcl dynamic library -${TCLZSH_EXE}: ${TCLZSH_BASE}_bare null.zip tclzsh.vfs - cp -f ${TCLZSH_BASE}_bare ${TCLZSH_BASE}.zip - cat null.zip >> ${TCLZSH_BASE}.zip - cd tclzsh.vfs ; zip -rAq ${UNIX_DIR}/${TCLZSH_BASE}.zip . - mv ${TCLZSH_BASE}.zip ${TCLZSH_EXE} +${TCLZSH_EXE}: ${TCLZSH_BASE}_bare tclzsh.vfs + ./${TCLZSH_BASE}_bare ../tools/mkzip.tcl ${TCLZSH_EXE} \ + -runtime ${TCLZSH_BASE}_bare \ + -directory tclzsh.vfs + chmod a+x ${TCLZSH_EXE} # Builds an executable directly from the Tcl sources tclzsh-static: ${TCLZSH_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclzsh.vfs diff --git a/win/Makefile.in b/win/Makefile.in index 6877938..0b34570 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -441,18 +441,18 @@ null.zip: tclzsh.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE) @echo "Building VFS File system in tclzsh.vfs" @$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \ - "$(WIN_DIR)/tclzsh.vfs/tcl$(VERSION)" "$(ROOT_DIR)" windows + "$(WIN_DIR)/tclzsh.vfs/boot/tcl" "$(ROOT_DIR)" windows tclzsh_bare: $(TCLZSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLZSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -$(TCLZSH): tclzsh_bare null.zip tclzsh.vfs - cp tclzsh_bare tclzsh.zip - cat null.zip >> tclzsh.zip - cd tclzsh.vfs ; zip -rAq $(WIN_DIR)/tclzsh.zip . - mv tclzsh.zip $(TCLZSH) +$(TCLZSH): tclzsh_bare tclzsh.vfs + ./${TCLZSH_BASE}_bare ../tools/mkzip.tcl ${TCLZSH_EXE} \ + -runtime ${TCLZSH_BASE}_bare \ + -directory tclzsh.vfs + chmod a+x ${TCLZSH_EXE} # Builds an executable directly from the Tcl sources tclzsh-direct: $(TCLZSH_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclzsh.vfs -- cgit v0.12 From bdc43f824155a8ac53c6e6d3c332f4776dd81c9e Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Oct 2014 01:11:22 +0000 Subject: Tweaked zvfstools to always allows the zvfs::mkzip command, and defer the check for the rest of the zvfs tools until the first call to zvfs::unzip --- library/zvfstools/pkgIndex.tcl | 1 - library/zvfstools/zvfstools.tcl | 6 ++++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/library/zvfstools/pkgIndex.tcl b/library/zvfstools/pkgIndex.tcl index 23a8040..824d5b3 100644 --- a/library/zvfstools/pkgIndex.tcl +++ b/library/zvfstools/pkgIndex.tcl @@ -1,2 +1 @@ -if {![package vsatisfies [package provide zvfs] 1.0]} {return} package ifneeded zvfstools 0.1 [list source [file join $dir zvfstools.tcl]] diff --git a/library/zvfstools/zvfstools.tcl b/library/zvfstools/zvfstools.tcl index f755283..26f17c4 100644 --- a/library/zvfstools/zvfstools.tcl +++ b/library/zvfstools/zvfstools.tcl @@ -13,7 +13,6 @@ # * building a file system from a zip archive package require Tcl 8.6 -package require zvfs 1.0 # Cop # # Create ZIP archives in Tcl. @@ -307,7 +306,11 @@ proc ::zvfs::copy_file {zipbase destbase file} { # ### ### ### ######### ######### ######### ## Convenience command, decode and copy to dir +## This routine relies on zvfs::mount, so we only load +## it when the zvfs package is present +## proc ::zvfs::unzip {in out} { + package require zvfs 1.0 set root /ziptmp#[incr ::zvfs::count] zvfs::mount $in $root set out [file normalize $out] @@ -317,5 +320,4 @@ proc ::zvfs::unzip {in out} { zvfs::unmount $in return } - package provide zvfstools 0.1 -- cgit v0.12 From 6b423f0d9ebf71415e7d74789128eb873a77ef3a Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Oct 2014 01:20:10 +0000 Subject: Fixes to allow a standard tclsh build to do the zip file encoding, instead of having to do it all through the zip enabled shell. --- library/zvfstools/zvfstools.tcl | 2 ++ tools/mkzip.tcl | 1 - unix/Makefile.in | 4 ++-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/library/zvfstools/zvfstools.tcl b/library/zvfstools/zvfstools.tcl index 26f17c4..274d5a1 100644 --- a/library/zvfstools/zvfstools.tcl +++ b/library/zvfstools/zvfstools.tcl @@ -21,6 +21,8 @@ package require Tcl 8.6 # or a zipfile using mkzip filename.zip -directory dirname -exclude "*~" # +namespace eval ::zvfs {} + proc ::zvfs::setbinary chan { fconfigure $chan \ -encoding binary \ diff --git a/tools/mkzip.tcl b/tools/mkzip.tcl index e53bae3..ba10908 100644 --- a/tools/mkzip.tcl +++ b/tools/mkzip.tcl @@ -1,6 +1,5 @@ ### # Wrapper to allow access to Tcl's zvfs::mkzip command from Makefiles ### -package require zvfs source [file join [file dirname [file normalize [info script]]] .. library zvfstools zvfstools.tcl] zvfs::mkzip {*}$argv diff --git a/unix/Makefile.in b/unix/Makefile.in index b635c0a..0819197 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -624,7 +624,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ all: binaries libraries doc packages -binaries: ${LIB_FILE} ${TCL_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} ${TCLZSH_EXE} libraries: @@ -679,7 +679,7 @@ ${TCLZSH_BASE}_bare: ${TCLZSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} # Builds an executable linked to the Tcl dynamic library ${TCLZSH_EXE}: ${TCLZSH_BASE}_bare tclzsh.vfs - ./${TCLZSH_BASE}_bare ../tools/mkzip.tcl ${TCLZSH_EXE} \ + @$(TCL_EXE) ../tools/mkzip.tcl ${TCLZSH_EXE} \ -runtime ${TCLZSH_BASE}_bare \ -directory tclzsh.vfs chmod a+x ${TCLZSH_EXE} -- cgit v0.12 From 85442c797ca8332eedf0a57984b72eb987eacb06 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 13 Nov 2014 14:30:26 +0000 Subject: Tweak to delete the tclzsh.vfs directory before the rm -rf tclvfs* statement in "make clean" --- unix/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 0819197..119bf9a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -699,10 +699,10 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in # $(SHELL) config.status clean: clean-packages + rm -rf tclzsh.vfs null.zip rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ ${TCLZSH_EXE} tclzsh* - rm -rf tclzsh.vfs null.zip cd dltest ; $(MAKE) clean distclean: distclean-packages clean -- cgit v0.12 From 3b50f8bcd682651d5ea2b8c0d5ba72b800a1b268 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 13 Nov 2014 14:58:01 +0000 Subject: Removed _ANSI_ARGS_ macros. They were not compiling in Tk for some reason today... --- generic/tclZipVfs.c | 46 +++++++++++++++++++++++++++++----------------- 1 file changed, 29 insertions(+), 17 deletions(-) diff --git a/generic/tclZipVfs.c b/generic/tclZipVfs.c index 80230c3..e1dea4f 100755 --- a/generic/tclZipVfs.c +++ b/generic/tclZipVfs.c @@ -1192,9 +1192,12 @@ closeReleaseDie: } -Tcl_Channel Tobe_FSOpenFileChannelProc - _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, - int mode, int permissions)) { +Tcl_Channel Tobe_FSOpenFileChannelProc ( + Tcl_Interp *interp, + Tcl_Obj *pathPtr, + int mode, + int permissions +) { int len; /* if (mode != O_RDONLY) return NULL; */ return ZvfsFileOpen(interp, Tcl_GetStringFromObj(pathPtr,&len), 0, @@ -1204,7 +1207,10 @@ Tcl_Channel Tobe_FSOpenFileChannelProc /* ** This routine does a stat() system call for a ZVFS file. */ -int Tobe_FSStatProc _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)) { +int Tobe_FSStatProc ( + Tcl_Obj *pathPtr, + Tcl_StatBuf *buf +) { char *path=Tcl_GetString(pathPtr); ZvfsFile *pFile; @@ -1229,7 +1235,7 @@ int Tobe_FSStatProc _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)) { /* ** This routine does an access() system call for a ZVFS file. */ -int Tobe_FSAccessProc _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)) { +int Tobe_FSAccessProc (Tcl_Obj *pathPtr, int mode) { char *path=Tcl_GetString(pathPtr); ZvfsFile *pFile; @@ -1370,8 +1376,10 @@ int Tobe_FSMatchInDirectoryProc ( /* Function to check whether a path is in * this filesystem. This is the most * important filesystem procedure. */ -int Tobe_FSPathInFilesystemProc _ANSI_ARGS_((Tcl_Obj *pathPtr, - ClientData *clientDataPtr)) { +int Tobe_FSPathInFilesystemProc ( + Tcl_Obj *pathPtr, + ClientData *clientDataPtr +) { ZvfsFile *zFile; char *path = Tcl_GetString(pathPtr); @@ -1385,7 +1393,7 @@ int Tobe_FSPathInFilesystemProc _ANSI_ARGS_((Tcl_Obj *pathPtr, return -1; } -Tcl_Obj *Tobe_FSListVolumesProc _ANSI_ARGS_((void)) { +Tcl_Obj *Tobe_FSListVolumesProc (void) { Tcl_HashEntry *pEntry; /* Hash table entry */ Tcl_HashSearch zSearch; /* Search all mount points */ ZvfsArchive *pArchive; /* The ZIP archive being mounted */ @@ -1411,7 +1419,7 @@ Tcl_Obj *Tobe_FSListVolumesProc _ANSI_ARGS_((void)) { return pVols; } -int Tobe_FSChdirProc _ANSI_ARGS_((Tcl_Obj *pathPtr)) { +int Tobe_FSChdirProc (Tcl_Obj *pathPtr) { /* Someday, we should actually check if this is a valid path. */ return TCL_OK; } @@ -1437,9 +1445,12 @@ Tobe_FSFileAttrStringsProc( return attrs; } -int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((Tcl_Interp *interp, - int index, Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef)) { +int Tobe_FSFileAttrsGetProc ( + Tcl_Interp *interp, + int index, + Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef +) { char *zFilename; ZvfsFile *pFile; zFilename = Tcl_GetString(pathPtr); @@ -1489,12 +1500,13 @@ int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((Tcl_Interp *interp, } return TCL_OK; } -int Tobe_FSFileAttrsSetProc _ANSI_ARGS_((Tcl_Interp *interp, - int index, Tcl_Obj *pathPtr, - Tcl_Obj *objPtr)) { return TCL_ERROR; } +int Tobe_FSFileAttrsSetProc ( + Tcl_Interp *interp, + int index, + Tcl_Obj *pathPtr, + Tcl_Obj *objPtr) { return TCL_ERROR; } -Tcl_Obj* Tobe_FSFilesystemPathTypeProc - _ANSI_ARGS_((Tcl_Obj *pathPtr)) { +Tcl_Obj* Tobe_FSFilesystemPathTypeProc (Tcl_Obj *pathPtr) { return Tcl_NewStringObj("zip",-1); } -- cgit v0.12 From 9cbfbd034eadccd7a7b0e8dbca255772563e12a1 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 13 Nov 2014 15:50:08 +0000 Subject: Add a mode for injecting the TkDll into the VFS --- tools/mkVfs.tcl | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl index bc6f3aa..e670775 100644 --- a/tools/mkVfs.tcl +++ b/tools/mkVfs.tcl @@ -60,6 +60,8 @@ if {[llength $argv] < 3} { set TCL_SCRIPT_DIR [lindex $argv 0] set TCLSRC_ROOT [lindex $argv 1] set PLATFORM [lindex $argv 2] +set TKDLL [lindex $argv 3] +set TKVER [lindex $argv 4] puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} @@ -89,5 +91,9 @@ puts $fout {# # set VFSROOT $dir } +if {$TKDLL ne {} && [file exists $TKDLL]} { + file copy $TKDLL ${TCL_SCRIPT_DIR} + puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"] +} pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} close $fout -- cgit v0.12 From 59490956934d2a83726ccbf16c5ce01fe269156a Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 15 Nov 2014 00:12:00 +0000 Subject: For the feature branch we now enable Zip file functions for all shells in Unix, and explicitly name a new executable "basekit", which is a statically linked tclsh with an attached library VFS --- unix/Makefile.in | 58 +++++++++++++++++++------------------------------------ unix/tclAppInit.c | 12 +++--------- 2 files changed, 23 insertions(+), 47 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 119bf9a..291f73b 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -168,12 +168,7 @@ INSTALL_DATA_DIR = ${INSTALL} -d -m 755 # Do not use SHELL_ENV for NATIVE_TCLSH unless it is the tclsh being built. EXE_SUFFIX = @EXEEXT@ TCL_EXE = tclsh${EXE_SUFFIX} -ifeq ($(SHARED_BUILD),0) -TCLZSH_BASE = tclzshs -else -TCLZSH_BASE = tclzshd -endif -TCLZSH_EXE = ${TCLZSH_BASE}${EXE_SUFFIX} +BASEKIT_EXE = basekit${EXE_SUFFIX} TCLTEST_EXE = tcltest${EXE_SUFFIX} NATIVE_TCLSH = @TCLSH_PROG@ @@ -290,7 +285,7 @@ LIBS = @TCL_LIBS@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ -TCLSH_OBJS = tclAppInit.o +TCLSH_OBJS = tclAppInit.o tclZipVfs.o tclZipVfsBoot.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o @@ -367,8 +362,6 @@ ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ -TCLZSH_OBJS = tclZipShInit.o tclZipVfs.o tclZipVfsBoot.o - OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ TCL_DECLS = \ @@ -624,7 +617,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ all: binaries libraries doc packages -binaries: ${LIB_FILE} ${TCL_EXE} ${TCLZSH_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} ${BASEKIT_EXE} libraries: @@ -663,35 +656,24 @@ ${NATIVE_TCLSH}: # Rather than force an install, pack the files we need into a # file system under our control -tclzsh.vfs: - @echo "Building VFS File system in tclzsh.vfs" +basekit.vfs: + @echo "Building VFS File system in basekit.vfs" @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ - "$(UNIX_DIR)/tclzsh.vfs/boot/tcl" "$(TOP_DIR)" unix + "$(UNIX_DIR)/basekit.vfs/boot/tcl" "$(TOP_DIR)" unix -tclzsh: ${TCLZSH_EXE} +# Builds an executable directly from the Tcl sources +${BASEKIT_EXE}: ${TCLSH_OBJS} ${OBJS} ${ZLIB_OBJS} basekit.vfs -${TCLZSH_BASE}_bare: ${TCLZSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLZSH_OBJS} \ - @TCL_BUILD_LIB_SPEC@ \ + ${TCLSH_OBJS} ${OBJS} ${ZLIB_OBJS} \ ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLZSH_BASE}_bare + ${CC_SEARCH_FLAGS} -o ${BASEKIT_EXE}_bare + @echo zipping... + @$(TCL_EXE) ../tools/mkzip.tcl ${BASEKIT_EXE} \ + -runtime ${BASEKIT_EXE}_bare \ + -directory basekit.vfs + chmod a+x ${BASEKIT_EXE} -# Builds an executable linked to the Tcl dynamic library -${TCLZSH_EXE}: ${TCLZSH_BASE}_bare tclzsh.vfs - @$(TCL_EXE) ../tools/mkzip.tcl ${TCLZSH_EXE} \ - -runtime ${TCLZSH_BASE}_bare \ - -directory tclzsh.vfs - chmod a+x ${TCLZSH_EXE} - -# Builds an executable directly from the Tcl sources -tclzsh-static: ${TCLZSH_OBJS} ${OBJS} ${ZLIB_OBJS} null.zip tclzsh.vfs - ${CC} ${CFLAGS} ${LDFLAGS} \ - ${TCLZSH_OBJS} ${OBJS} ${ZLIB_OBJS} \ - ${LIBS} @EXTRA_TCLSH_LIBS@ \ - ${CC_SEARCH_FLAGS} -o ${TCLZSH_EXE} - cat null.zip >> ${TCLZSH_EXE} - cd tclzsh.vfs ; zip -rAq ${UNIX_DIR}/${TCLZSH_EXE} . Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status @@ -699,10 +681,10 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in # $(SHELL) config.status clean: clean-packages - rm -rf tclzsh.vfs null.zip + rm -rf basekit.vfs null.zip rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ - ${TCLZSH_EXE} tclzsh* + ${BASEKIT_EXE} basekit* cd dltest ; $(MAKE) clean distclean: distclean-packages clean @@ -846,8 +828,9 @@ install-binaries: binaries @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" - @echo "Installing ${TCLZSH_EXE} as $(BIN_INSTALL_DIR)/${TCLZSH_BASE}$(VERSION)${EXE_SUFFIX}" - @$(INSTALL_PROGRAM) ${TCLZSH_EXE} "$(BIN_INSTALL_DIR)/${TCLZSH_BASE}$(VERSION)${EXE_SUFFIX}" + @echo "Installing ${BASEKIT_EXE} as $(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}" + @$(INSTALL_PROGRAM) ${BASEKIT_EXE} "$(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}" + @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/" @@ -2181,7 +2164,6 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages -.PHONY: tclzsh-static tclzsh #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 1be1ce3..4b5d1f6 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -40,12 +40,10 @@ extern Tcl_PackageInitProc Tclxttest_Init; #endif MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); MODULE_SCOPE int main(int, char **); -#ifdef TCL_ZIPVFS - MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); - MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); - MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); +MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); +MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); +MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); -#endif /* TCL_ZIPVFS */ /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, etc., @@ -85,13 +83,11 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif -#ifdef TCL_ZIPVFS #define TCLKIT_INIT "main.tcl" #define TCLKIT_VFSMOUNT "/zvfs" Tcl_FindExecutable(argv[0]); CONST char *cp=Tcl_GetNameOfExecutable(); Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT); -#endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -122,13 +118,11 @@ Tcl_AppInit( if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } -#ifdef TCL_ZIPVFS /* Load the ZipVfs package */ Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit); if(Zvfs_Init(interp) == TCL_ERROR) { return TCL_ERROR; } -#endif #ifdef TCL_XT_TEST if (Tclxttest_Init(interp) == TCL_ERROR) { return TCL_ERROR; -- cgit v0.12 From ded95f89d34b0a06df4a2faed54558431643170f Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 17 Nov 2014 15:04:05 +0000 Subject: Added the zvfstools file to the installer --- unix/Makefile.in | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 291f73b..be769a4 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -617,7 +617,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ all: binaries libraries doc packages -binaries: ${LIB_FILE} ${TCL_EXE} ${BASEKIT_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} ${BASEKIT_EXE}_bare basekit.zip libraries: @@ -661,6 +661,10 @@ basekit.vfs: @$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \ "$(UNIX_DIR)/basekit.vfs/boot/tcl" "$(TOP_DIR)" unix +basekit.zip: basekit.vfs + @$(TCL_EXE) ../tools/mkzip.tcl basekit.zip \ + -directory basekit.vfs + # Builds an executable directly from the Tcl sources ${BASEKIT_EXE}: ${TCLSH_OBJS} ${OBJS} ${ZLIB_OBJS} basekit.vfs @@ -828,8 +832,12 @@ install-binaries: binaries @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}" - @echo "Installing ${BASEKIT_EXE} as $(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}" - @$(INSTALL_PROGRAM) ${BASEKIT_EXE} "$(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}" + @echo "Installing ${BASEKIT_EXE}_bare as $(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}" + @$(INSTALL_PROGRAM) ${BASEKIT_EXE}_bare "$(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}" + + @echo "Installing basekit.zip as $(BIN_INSTALL_DIR)/basekit$(VERSION).zip" + @$(INSTALL_PROGRAM) basekit.zip "$(BIN_INSTALL_DIR)/basekit$(VERSION).zip" + @echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh" @@ -890,6 +898,9 @@ install-libraries: libraries @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm; + @echo "Installing package zvfstools 0.1 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/zvfstools/zvfstools.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/zvfstools-0.1.tm; + @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"; @for i in $(TOP_DIR)/library/encoding/*.enc ; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \ -- cgit v0.12 From dd60d528143a4f125200655aee2defc814066401 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 17 Jan 2015 18:40:19 +0000 Subject: apply contributed patch which fixes a segfault --- generic/tclCmdMZ.c | 4 ++++ generic/tclStringObj.c | 31 ++++++++++++++++++++++++------- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 4ed353e..58196a3 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1085,6 +1085,10 @@ Tcl_SplitObjCmd( for ( ; stringPtr < end; stringPtr += len) { len = TclUtfToUniChar(stringPtr, &ch); + + if (!len) { + continue; + } /* * Assume Tcl_UniChar is an integral type... diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2df6dd8..0ae5a7c 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -672,6 +672,7 @@ Tcl_GetRange( { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; + int i, firstoffset = 0, lastoffset = 0; /* * Optimize the case where we're really dealing with a bytearray object @@ -716,7 +717,17 @@ Tcl_GetRange( stringPtr = GET_STRING(objPtr); } - return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); + for (i = 0; i <= last + lastoffset + firstoffset; i++) { + if ((stringPtr->unicode[i] & 0xfc00) == 0xd800) { + if (i < first + firstoffset) { + firstoffset++; + } else { + lastoffset++; + } + } + } + + return Tcl_NewUnicodeObj(stringPtr->unicode + first + firstoffset, last-first+1 + lastoffset + firstoffset); } /* @@ -2866,8 +2877,8 @@ ExtendUnicodeRepWithString( int numAppendChars) { String *stringPtr = GET_STRING(objPtr); - int needed, numOrigChars = 0; - Tcl_UniChar *dst; + int incr, needed, numOrigChars = 0; + Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; @@ -2890,7 +2901,12 @@ ExtendUnicodeRepWithString( numAppendChars = 0; } for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { - bytes += TclUtfToUniChar(bytes, dst); + bytes += (incr = TclUtfToUniChar(bytes, &unichar)); + *dst = unichar; + if (!incr) { + bytes += TclUtfToUniChar(bytes, &unichar); + *++dst = unichar; + } } *dst = 0; } @@ -3095,7 +3111,7 @@ ExtendStringRepWithUnicode( * Pre-condition: this is the "string" Tcl_ObjType. */ - int i, origLength, size = 0; + int incr, i, origLength, size = 0, offset = 0; char *dst, buf[TCL_UTF_MAX]; String *stringPtr = GET_STRING(objPtr); @@ -3121,8 +3137,9 @@ ExtendStringRepWithUnicode( goto copyBytes; } - for (i = 0; i < numChars && size >= 0; i++) { - size += Tcl_UniCharToUtf((int) unicode[i], buf); + for (i = 0; i < numChars + offset && size >= 0; i++) { + size += (incr = Tcl_UniCharToUtf((int) unicode[i], buf)); + if (!incr) offset++; } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); -- cgit v0.12 From 5821708a49af0c4260a0ca87452b1eb8abd61e3e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Jun 2015 20:58:00 +0000 Subject: Fix win compile --- win/tclWinSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 08de678..2e4df0a 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -340,7 +340,7 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix) void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; -- cgit v0.12 From adceea62b6fc04fb2a4d41dd0a31adb3011c3147 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 21 Jun 2015 22:29:11 +0000 Subject: Branch for androwish, as help to keep track on which android-specific changes could be included into the core without harm. --- Android.mk | 202 ++++ debian/changelog | 23 + debian/compat | 1 + debian/control | 37 + debian/copyright | 141 +++ debian/rules | 131 ++ debian/sdltcl8.6-dev.dirs | 2 + debian/sdltcl8.6-dev.files | 2 + debian/sdltcl8.6-doc.files | 2 + debian/sdltcl8.6.files | 18 + debian/shlibs.local | 1 + generic/tclEncoding.c | 10 + generic/tclIOUtil.c | 74 +- generic/tclInt.decls | 12 + generic/tclIntDecls.h | 19 + generic/tclMain.c | 146 ++- generic/tclPkgConfig.c | 20 + generic/tclStubInit.c | 9 + generic/zcrypt.h | 131 ++ generic/zipfs.c | 2867 ++++++++++++++++++++++++++++++++++++++++++++ generic/zipfs.h | 43 + pkgs/Android.mk | 1 + tcl-config.mk | 60 + unix/Makefile.in | 11 +- unix/tclLoadDl.c | 40 +- unix/tclUnixFCmd.c | 21 + unix/tclUnixInit.c | 5 + unix/tclUnixPort.h | 2 + unix/tclUnixTime.c | 5 +- win/Makefile.in | 5 +- 30 files changed, 4027 insertions(+), 14 deletions(-) create mode 100644 Android.mk create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/copyright create mode 100755 debian/rules create mode 100644 debian/sdltcl8.6-dev.dirs create mode 100644 debian/sdltcl8.6-dev.files create mode 100644 debian/sdltcl8.6-doc.files create mode 100644 debian/sdltcl8.6.files create mode 100644 debian/shlibs.local create mode 100644 generic/zcrypt.h create mode 100644 generic/zipfs.c create mode 100644 generic/zipfs.h create mode 100644 pkgs/Android.mk create mode 100644 tcl-config.mk diff --git a/Android.mk b/Android.mk new file mode 100644 index 0000000..9d8ce27 --- /dev/null +++ b/Android.mk @@ -0,0 +1,202 @@ +LOCAL_PATH := $(call my-dir) + +########################### +# +# Tcl shared library +# +########################### + +include $(CLEAR_VARS) + +tcl_path := $(LOCAL_PATH) + +include $(tcl_path)/tcl-config.mk + +LOCAL_MODULE := tcl + +LOCAL_ARM_MODE := arm + +LOCAL_C_INCLUDES := $(tcl_includes) $(LOCAL_PATH)/libtommath + +LOCAL_EXPORT_C_INCLUDES := $(LOCAL_C_INCLUDES) + +LOCAL_SRC_FILES := \ + libtommath/bncore.c \ + libtommath/bn_reverse.c \ + libtommath/bn_fast_s_mp_mul_digs.c \ + libtommath/bn_fast_s_mp_sqr.c \ + libtommath/bn_mp_add.c \ + libtommath/bn_mp_add_d.c \ + libtommath/bn_mp_and.c \ + libtommath/bn_mp_clamp.c \ + libtommath/bn_mp_clear.c \ + libtommath/bn_mp_clear_multi.c \ + libtommath/bn_mp_cmp.c \ + libtommath/bn_mp_cmp_d.c \ + libtommath/bn_mp_cmp_mag.c \ + libtommath/bn_mp_copy.c \ + libtommath/bn_mp_cnt_lsb.c \ + libtommath/bn_mp_count_bits.c \ + libtommath/bn_mp_div.c \ + libtommath/bn_mp_div_d.c \ + libtommath/bn_mp_div_2.c \ + libtommath/bn_mp_div_2d.c \ + libtommath/bn_mp_div_3.c \ + libtommath/bn_mp_exch.c \ + libtommath/bn_mp_expt_d.c \ + libtommath/bn_mp_grow.c \ + libtommath/bn_mp_init.c \ + libtommath/bn_mp_init_copy.c \ + libtommath/bn_mp_init_multi.c \ + libtommath/bn_mp_init_set.c \ + libtommath/bn_mp_init_set_int.c \ + libtommath/bn_mp_init_size.c \ + libtommath/bn_mp_karatsuba_mul.c \ + libtommath/bn_mp_karatsuba_sqr.c \ + libtommath/bn_mp_lshd.c \ + libtommath/bn_mp_mod.c \ + libtommath/bn_mp_mod_2d.c \ + libtommath/bn_mp_mul.c \ + libtommath/bn_mp_mul_2.c \ + libtommath/bn_mp_mul_2d.c \ + libtommath/bn_mp_mul_d.c \ + libtommath/bn_mp_neg.c \ + libtommath/bn_mp_or.c \ + libtommath/bn_mp_radix_size.c \ + libtommath/bn_mp_radix_smap.c \ + libtommath/bn_mp_read_radix.c \ + libtommath/bn_mp_rshd.c \ + libtommath/bn_mp_set.c \ + libtommath/bn_mp_set_int.c \ + libtommath/bn_mp_shrink.c \ + libtommath/bn_mp_sqr.c \ + libtommath/bn_mp_sqrt.c \ + libtommath/bn_mp_sub.c \ + libtommath/bn_mp_sub_d.c \ + libtommath/bn_mp_to_unsigned_bin.c \ + libtommath/bn_mp_to_unsigned_bin_n.c \ + libtommath/bn_mp_toom_mul.c \ + libtommath/bn_mp_toom_sqr.c \ + libtommath/bn_mp_toradix_n.c \ + libtommath/bn_mp_unsigned_bin_size.c \ + libtommath/bn_mp_xor.c \ + libtommath/bn_mp_zero.c \ + libtommath/bn_s_mp_add.c \ + libtommath/bn_s_mp_mul_digs.c \ + libtommath/bn_s_mp_sqr.c \ + libtommath/bn_s_mp_sub.c \ + generic/regcomp.c \ + generic/regexec.c \ + generic/regfree.c \ + generic/regerror.c \ + generic/tclAlloc.c \ + generic/tclAssembly.c \ + generic/tclAsync.c \ + generic/tclBasic.c \ + generic/tclBinary.c \ + generic/tclCkalloc.c \ + generic/tclClock.c \ + generic/tclCmdAH.c \ + generic/tclCmdIL.c \ + generic/tclCmdMZ.c \ + generic/tclCompCmds.c \ + generic/tclCompCmdsGR.c \ + generic/tclCompCmdsSZ.c \ + generic/tclCompExpr.c \ + generic/tclCompile.c \ + generic/tclConfig.c \ + generic/tclDate.c \ + generic/tclDictObj.c \ + generic/tclDisassemble.c \ + generic/tclEncoding.c \ + generic/tclEnsemble.c \ + generic/tclEnv.c \ + generic/tclEvent.c \ + generic/tclExecute.c \ + generic/tclFCmd.c \ + generic/tclFileName.c \ + generic/tclGet.c \ + generic/tclHash.c \ + generic/tclHistory.c \ + generic/tclIndexObj.c \ + generic/tclInterp.c \ + generic/tclIO.c \ + generic/tclIOCmd.c \ + generic/tclIOGT.c \ + generic/tclIOSock.c \ + generic/tclIOUtil.c \ + generic/tclIORChan.c \ + generic/tclIORTrans.c \ + generic/tclLink.c \ + generic/tclListObj.c \ + generic/tclLiteral.c \ + generic/tclLoad.c \ + generic/tclMain.c \ + generic/tclNamesp.c \ + generic/tclNotify.c \ + generic/tclObj.c \ + generic/tclOptimize.c \ + generic/tclPanic.c \ + generic/tclParse.c \ + generic/tclPathObj.c \ + generic/tclPipe.c \ + generic/tclPkg.c \ + generic/tclPkgConfig.c \ + generic/tclPosixStr.c \ + generic/tclPreserve.c \ + generic/tclProc.c \ + generic/tclRegexp.c \ + generic/tclResolve.c \ + generic/tclResult.c \ + generic/tclScan.c \ + generic/tclStubInit.c \ + generic/tclStringObj.c \ + generic/tclStrToD.c \ + generic/tclThread.c \ + generic/tclThreadAlloc.c \ + generic/tclThreadJoin.c \ + generic/tclThreadStorage.c \ + generic/tclTimer.c \ + generic/tclTomMathInterface.c \ + generic/tclTrace.c \ + generic/tclUtil.c \ + generic/tclUtf.c \ + generic/tclVar.c \ + generic/tclZlib.c \ + generic/tclOO.c \ + generic/tclOOBasic.c \ + generic/tclOOCall.c \ + generic/tclOODefineCmds.c \ + generic/tclOOInfo.c \ + generic/tclOOMethod.c \ + generic/tclOOStubInit.c \ + generic/tclStubLib.c \ + generic/tclTomMathStubLib.c \ + generic/tclOOStubLib.c \ + generic/zipfs.c \ + unix/tclAppInit.c \ + unix/tclLoadDl.c \ + unix/tclUnixChan.c \ + unix/tclUnixCompat.c \ + unix/tclUnixEvent.c \ + unix/tclUnixFCmd.c \ + unix/tclUnixFile.c \ + unix/tclUnixInit.c \ + unix/tclUnixNotfy.c \ + unix/tclUnixPipe.c \ + unix/tclUnixSock.c \ + unix/tclUnixTest.c \ + unix/tclUnixThrd.c \ + unix/tclUnixTime.c + +LOCAL_CFLAGS := $(tcl_cflags) \ + -DPACKAGE_NAME="\"tcl\"" \ + -DPACKAGE_VERSION="\"8.6\"" \ + -DBUILD_tcl=1 \ + -Dmain=tclsh \ + -O2 + +LOCAL_LDLIBS := -ldl -lz -llog + +include $(BUILD_SHARED_LIBRARY) + diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..caad3ba --- /dev/null +++ b/debian/changelog @@ -0,0 +1,23 @@ +sdltcl8.6 (8.6.4-1) unstable; urgency=low + + * Update to 8.6.4 + + -- Christian Werner Thu, 12 Mar 2015 22:00:00 +0100 + +sdltcl8.6 (8.6.3-1) unstable; urgency=low + + * Update to 8.6.3 + + -- Christian Werner Wed, 12 Nov 2014 20:00:00 +0100 + +sdltcl8.6 (8.6.2-1) unstable; urgency=low + + * Update to 8.6.2 + + -- Christian Werner Thu, 28 Aug 2014 07:10:10 +0200 + +sdltcl8.6 (8.6.1-1) unstable; urgency=low + + * Initial packaging + + -- Christian Werner Sat, 05 Apr 2014 14:44:48 +0200 diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +5 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..3434297 --- /dev/null +++ b/debian/control @@ -0,0 +1,37 @@ +Source: sdltcl8.6 +Section: libs +Priority: optional +Maintainer: +Build-Depends: debhelper (>= 5.0.0), quilt +Standards-Version: 3.8.3 +Homepage: http://www.tcl.tk/ + +Package: sdltcl8.6 +Section: interpreters +Priority: optional +Architecture: any +Depends: ${shlibs:Depends} +Description: Tcl (the Tool Command Language) v8.6 - run-time files + Tcl is a powerful, easy to use, embeddable, cross-platform interpreted + scripting language. This package contains everything you need to run + Tcl scripts and Tcl-enabled apps. This version includes thread support. + +Package: sdltcl8.6-doc +Section: doc +Priority: optional +Architecture: all +Suggests: sdltcl8.6 +Description: Tcl (the Tool Command Language) v8.6 - manual pages + Tcl is a powerful, easy-to-use, embeddable, cross-platform interpreted + scripting language. This package contains the man pages for Tcl commands. + +Package: sdltcl8.6-dev +Section: devel +Priority: optional +Architecture: any +Depends: sdltcl8.6 (= ${binary:Version}) +Suggests: sdltcl8.6-doc +Description: Tcl (the Tool Command Language) v8.6 - development files + Tcl is a powerful, easy-to-use, embeddable, cross-platform interpreted + scripting language. This package contains the headers and libraries + needed to embed or extend Tcl. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..075c312 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,141 @@ +This package was originally debianized by David Engel +from sources obtained at http://prdownloads.sourceforge.net/tcl + +List of copyright holders mentioned in individual files: + +Copyright 1983, 1988-1994 The Regents of the University of California +Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans +Copyright 1992-1996 Free Software Foundation, Inc. +Copyright 1993-1994 Lockheed Missle & Space Company, AI Center +Copyright 1993-1997 Bell Labs Innovations for Lucent Technologies +Copyright 1993-1997 Lucent Technologies +Copyright 1994-1998 Sun Microsystems, Inc. +Copyright 1995 General Electric Company +Copyright 1995 Dave Nebinger +Copyright 1995-1997 Roger E. Critchlow Jr +Copyright 1996 Lucent Technologies and Jim Ingham +Copyright 1997-2000 Ajuba Solutions +Copyright 1998-2000 Scriptics Corporation +Copyright 1998-1999 Henry Spencer +Copyright 1998 Paul Duffin +Copyright 1998 Mark Harrison +Copyright 1999 America Online, Inc. +Copyright 1999-2000 Andreas Kupries +Copyright 2000-2001 ActiveState Corporation, et al +Copyright 2001 ActiveState Tool Corp. +Copyright 2001-2002 Apple Computer, Inc. +Copyright 2001-2002 ActiveState Corporation +Copyright 2001-2002 Vincent Darley +Copyright 2001-2002 Donal K. Fellows +Copyright 2001-2003 Kevin B. Kenny +Copyright 2001-2002 David Gravereaux +Contributions from Don Porter, NIST, 2002-2003. (not subject to US copyright) +Copyright 2005 Tcl Core Team +Copyright 2005 Daniel A. Steffen + +Copyright: + +This software is copyrighted by the Regents of the University of +California, Sun Microsystems, Inc., Scriptics Corporation, +and other parties. The following terms apply to all files associated +with the software unless explicitly disclaimed in individual files. + +The authors hereby grant permission to use, copy, modify, distribute, +and license this software and its documentation for any purpose, provided +that existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written agreement, +license, or royalty fee is required for any of the authorized uses. +Modifications to this software may be copyrighted by their authors +and need not follow the licensing terms described here, provided that +the new terms are clearly indicated on the first page of each file where +they apply. + +IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +MODIFICATIONS. + +GOVERNMENT USE: If you are acquiring this software on behalf of the +U.S. government, the Government shall have only "Restricted Rights" +in the software and related documentation as defined in the Federal +Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you +are acquiring the software on behalf of the Department of Defense, the +software shall be classified as "Commercial Computer Software" and the +Government shall have only "Restricted Rights" as defined in Clause +252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the +authors grant the U.S. Government and others acting in its behalf +permission to use and distribute the software in accordance with the +terms specified in this license. + +Several files are distributed under other conditions: + +compat/strftime.c: +/* + * strftime.c -- + * + * This file contains a modified version of the BSD 4.4 strftime + * function. + * + * This file is a modified version of the strftime.c file from the BSD 4.4 + * source. See the copyright notice below for details on redistribution + * restrictions. The "license.terms" file does not apply to this file. + * + * Changes 2002 Copyright (c) 2002 ActiveState Corporation. + * + * RCS: @(#) $Id: strftime.c,v 1.10.2.3 2005/11/04 18:18:04 kennykb Exp $ + */ + +/* + * Copyright (c) 1989 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +compat/dlfcn.h and unix/tclLoadAix.c: + * This file is subject to the following copyright notice, which is + * different from the notice used elsewhere in Tcl but rougly + * equivalent in meaning. + * + * Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH + * Not derived from licensed software. + * + * Permission is granted to freely use, copy, modify, and redistribute + * this software, provided that the author is not construed to be liable + * for any results of using the software, alterations are clearly marked + * as such, and this notice is not modified. + diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..7a0214c --- /dev/null +++ b/debian/rules @@ -0,0 +1,131 @@ +#!/usr/bin/make -f +# debian/rules that uses debhelper. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + +DEB_HOST_GNU_TYPE := $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE) +DEB_BUILD_GNU_TYPE := $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) + +export QUILT_PATCHES := debian/patches + +v = 8.6 + +ifneq (,$(findstring debug,$(DEB_BUILD_OPTIONS))) +CFLAGS=-g -O0 +else +# See bug #446335 +CFLAGS=-g -O2 -fno-unit-at-a-time +endif + +CFLAGS+=-DZIPFS_IN_TCL=1 + +unpatch: + dh_testdir + quilt pop -a || test $$? = 2 + rm -rf patch-stamp .pc + +patch: patch-stamp +patch-stamp: + dh_testdir + quilt push -a || test $$? = 2 + touch patch-stamp + +build: build-stamp +build-stamp: patch-stamp + dh_testdir +# So so ugly but it works... + touch generic/tclStubInit.c + cd unix && \ + CFLAGS="$(CFLAGS)" \ + ac_cv_func_strtod=yes \ + tcl_cv_strtod_buggy=1 \ + ./configure --host=$(DEB_HOST_GNU_TYPE) \ + --build=$(DEB_BUILD_GNU_TYPE) \ + --prefix=/opt/sdltk86 \ + --includedir=/opt/sdltk86/include \ + --enable-shared \ + --mandir=/opt/sdltk86/man \ + --enable-man-symlinks \ + --enable-man-compression=gzip \ + --enable-threads \ + --without-tzdata && \ + touch ../generic/tclStubInit.c && \ + $(MAKE) +# Build the static library. + cd unix && \ + ar cr libtcl$(v).a *.o && \ + ar d libtcl$(v).a tclAppInit.o && \ + ranlib libtcl$(v).a + touch build-stamp + +clean: clean-patched unpatch + dh_testdir + dh_testroot + dh_clean + +clean-patched: + dh_testdir + dh_testroot + rm -f build-stamp install-stamp + cd unix && [ ! -f Makefile ] || $(MAKE) distclean +# Remove forgotten files + rm -f tests/pkg/pkga.so unix/config.log unix/Tcltest.so + +install: install-stamp +install-stamp: build-stamp + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + cd unix && \ + GZIP=-9 \ + $(MAKE) INSTALL_ROOT=`pwd`/../debian/tmp \ + MAN_INSTALL_DIR=`pwd`/../debian/tmp/opt/sdltk86/man \ + install install-private-headers install-packages +# Fix up the libraries. + cp unix/libtcl$(v).a debian/tmp/opt/sdltk86/lib + touch install-stamp + +# Build architecture-independent files here. +binary-indep: build install + dh_testdir -i + dh_testroot -i + dh_movefiles -i + dh_installdocs -i + dh_installchangelogs -i ChangeLog + dh_compress -i + dh_fixperms -i + dh_installdeb -i + dh_gencontrol -i + dh_md5sums -i + dh_builddeb -i + +# Build architecture-dependent files here. +binary-arch: build install + dh_testdir -a + dh_testroot -a + dh_movefiles -a +# now, fix up file locations for .sh + mv debian/sdltcl$(v)/opt/sdltk86/lib/tclConfig.sh \ + debian/sdltcl$(v)-dev/opt/sdltk86/lib + dh_installdocs -a + dh_installmenu -a + dh_installchangelogs -a ChangeLog + dh_fixperms -a + dh_strip -a + dh_compress -a + dh_makeshlibs -a -V 'sdltcl$(v) (>= 8.6.2)' -XTcltest + dh_installdeb -a + dh_shlibdeps -a -ldebian/sdltcl$(v)/opt/sdltk86/lib + dh_gencontrol -a + dh_md5sums -a + dh_builddeb -a + +source diff: + @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false + +binary: binary-indep binary-arch + +.PHONY: patch unpatch clean-patched build clean binary-indep binary-arch binary install + diff --git a/debian/sdltcl8.6-dev.dirs b/debian/sdltcl8.6-dev.dirs new file mode 100644 index 0000000..4de4819 --- /dev/null +++ b/debian/sdltcl8.6-dev.dirs @@ -0,0 +1,2 @@ +opt/sdltk86/lib +opt/sdltk86/include diff --git a/debian/sdltcl8.6-dev.files b/debian/sdltcl8.6-dev.files new file mode 100644 index 0000000..5cd0878 --- /dev/null +++ b/debian/sdltcl8.6-dev.files @@ -0,0 +1,2 @@ +opt/sdltk86/include +opt/sdltk86/lib/*.a diff --git a/debian/sdltcl8.6-doc.files b/debian/sdltcl8.6-doc.files new file mode 100644 index 0000000..56ca7e7 --- /dev/null +++ b/debian/sdltcl8.6-doc.files @@ -0,0 +1,2 @@ +opt/sdltk86/man/man3 +opt/sdltk86/man/mann diff --git a/debian/sdltcl8.6.files b/debian/sdltcl8.6.files new file mode 100644 index 0000000..501d10a --- /dev/null +++ b/debian/sdltcl8.6.files @@ -0,0 +1,18 @@ +opt/sdltk86/bin +opt/sdltk86/lib/tcl8 +opt/sdltk86/lib/tcl8/* +opt/sdltk86/lib/tcl8.6 +opt/sdltk86/lib/tcl8.6/* +opt/sdltk86/lib/*.so +opt/sdltk86/lib/*.sh +opt/sdltk86/lib/itcl* +opt/sdltk86/lib/itcl*/* +opt/sdltk86/lib/pkgconfig +opt/sdltk86/lib/pkgconfig/* +opt/sdltk86/lib/sqlite* +opt/sdltk86/lib/sqlite*/* +opt/sdltk86/lib/tdbc* +opt/sdltk86/lib/tdbc*/* +opt/sdltk86/lib/thread* +opt/sdltk86/lib/thread*/* +opt/sdltk86/man/man1 diff --git a/debian/shlibs.local b/debian/shlibs.local new file mode 100644 index 0000000..7da5dd4 --- /dev/null +++ b/debian/shlibs.local @@ -0,0 +1 @@ +libtcl8.6 1 diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index a7ef199..35caf11 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -496,7 +496,11 @@ FillEncodingFileMap(void) Tcl_Obj *directory, *matchFileList = Tcl_NewObj(); Tcl_Obj **filev; Tcl_GlobTypeData readableFiles = { +#ifdef ZIPFS_IN_TCL + TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_DIR, TCL_GLOB_PERM_R, NULL, NULL +#else TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL +#endif }; Tcl_ListObjIndex(NULL, searchPath, i, &directory); @@ -508,7 +512,13 @@ FillEncodingFileMap(void) Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev); for (j=0; jnextPtr) { +#ifdef ZIPFS_IN_TCL + if (fsRecPtr->fsPtr == &zipfsFilesystem) { + ClientData clientData = NULL; + /* + * Allow mounted zipfs filesystem to overtake entire normalisation. + * This is needed on unix for mounts on symlinks right below root. + */ + + if (fsRecPtr->fsPtr->pathInFilesystemProc != NULL) { + if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, + &clientData)!=-1) { + TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); + break; + } + } + continue; + } +#endif if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; } @@ -1423,6 +1455,11 @@ TclFSNormalizeToUniquePath( if (fsRecPtr->fsPtr == &tclNativeFilesystem) { continue; } +#ifdef ZIPFS_IN_TCL + if (fsRecPtr->fsPtr == &zipfsFilesystem) { + continue; + } +#endif if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, @@ -2890,15 +2927,32 @@ int Tcl_FSChdir( Tcl_Obj *pathPtr) { - const Tcl_Filesystem *fsPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL; int retVal = -1; + if (tsdPtr->cwdPathPtr != NULL) { + oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); + } if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) { Tcl_SetErrno(ENOENT); return retVal; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); + + if ((fsPtr != NULL) && (fsPtr != &tclNativeFilesystem)) { + /* + * Watch out for tilde substitution. + * Only valid in native filesystem. + */ + char *name = Tcl_GetString(pathPtr); + + if ((name != NULL) && (*name == '~')) { + fsPtr = &tclNativeFilesystem; + } + } + if (fsPtr != NULL) { if (fsPtr->chdirProc != NULL) { /* @@ -3009,6 +3063,14 @@ Tcl_FSChdir( } else { FsUpdateCwd(normDirName, NULL); } + + /* + * If the filesystem changed between old and new cwd + * force filesystem refresh on path objects. + */ + if (oldFsPtr != NULL && fsPtr != oldFsPtr) { + Tcl_FSMountsChanged(NULL); + } } return retVal; diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 9f7b106..6298708 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1012,6 +1012,18 @@ declare 251 { int TclRegisterLiteral(void *envPtr, char *bytes, int length, int flags) } + +declare 252 { + int Tclzipfs_Init(Tcl_Interp *interp) +} +declare 253 { + int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, + const char *mntpt, const char *passwd) +} +declare 254 { + int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) +} + ############################################################################## diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index f95f999..3e74bbb 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -617,6 +617,16 @@ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, /* 251 */ EXTERN int TclRegisterLiteral(void *envPtr, char *bytes, int length, int flags); +/* 252 */ +EXTERN int Tclzipfs_Init(Tcl_Interp *interp); +/* 253 */ +EXTERN int Tclzipfs_Mount(Tcl_Interp *interp, + const char *zipname, const char *mntpt, + const char *passwd); +/* 254 */ +EXTERN int Tclzipfs_Unmount(Tcl_Interp *interp, + const char *zipname); + typedef struct TclIntStubs { int magic; @@ -874,6 +884,9 @@ typedef struct TclIntStubs { char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */ + int (*tclzipfs_Init) (Tcl_Interp *interp); /* 252 */ + int (*tclzipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 253 */ + int (*tclzipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 254 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; @@ -1305,6 +1318,12 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */ #define TclRegisterLiteral \ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ +#define Tclzipfs_Init \ + (tclIntStubsPtr->tclzipfs_Init) /* 252 */ +#define Tclzipfs_Mount \ + (tclIntStubsPtr->tclzipfs_Mount) /* 253 */ +#define Tclzipfs_Unmount \ + (tclIntStubsPtr->tclzipfs_Unmount) /* 254 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclMain.c b/generic/tclMain.c index 360f5e9..2c40c3f 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -34,6 +34,10 @@ #include "tclInt.h" +#ifdef ZIPFS_IN_TCL +#include "zipfs.h" +#endif + /* * The default prompt used when the user has not overridden it. */ @@ -51,6 +55,7 @@ # define TCHAR char # define TEXT(arg) arg # define _tcscmp strcmp +# define _tcsncmp strncmp #endif /* @@ -308,10 +313,16 @@ Tcl_MainEx( { Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; - int code, exitCode = 0; + int code, length, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; Tcl_Channel chan; InteractiveState is; + const char *zipFile = NULL; + Tcl_Obj *zipval = NULL; + int autoRun = 1; +#ifdef ZIPFS_IN_TCL + int zipOk = TCL_ERROR; +#endif TclpSetInitialEncodings(); TclpFindExecutable((const char *)argv[0]); @@ -344,6 +355,24 @@ Tcl_MainEx( Tcl_DecrRefCount(value); argc -= 3; argv += 3; + } else if (argc > 2) { + length = strlen((char *) argv[1]); + if ((length >= 2) && + (0 == _tcsncmp(TEXT("-zip"), argv[1], length))) { + argc--; + argv++; + if ((argc > 1) && (argv[1][0] != (TCHAR) '-')) { + zipval = NewNativeObj(argv[1], -1); + zipFile = Tcl_GetString(zipval); + autoRun = 0; + argc--; + argv++; + } + } else if ('-' != argv[1][0]) { + Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); + argc--; + argv++; + } } else if ((argc > 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; @@ -377,6 +406,51 @@ Tcl_MainEx( Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); +#ifdef ZIPFS_IN_TCL + zipOk = Tclzipfs_Init(interp); + if (zipOk == TCL_OK) { + int relax = 0; + + if (zipFile == NULL) { + relax = 1; +#ifdef ANDROID + zipFile = getenv("PACKAGE_CODE_PATH"); + if (zipFile == NULL) { + zipFile = Tcl_GetNameOfExecutable(); + } +#else + zipFile = Tcl_GetNameOfExecutable(); +#endif + } + if (zipFile != NULL) { + zipOk = Tclzipfs_Mount(interp, zipFile, "", NULL); + if (!relax && (zipOk != TCL_OK)) { + exitCode = 1; + goto done; + } + } else { + zipOk = TCL_ERROR; + } + Tcl_ResetResult(interp); + } + if (zipOk == TCL_OK) { + char *tcl_lib = "/assets/tcl" TCL_VERSION; + char *tcl_pkg = "/assets"; + + Tcl_SetVar2(interp, "env", "TCL_LIBRARY", tcl_lib, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_libPath", tcl_lib, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_library", tcl_lib, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_pkgPath", tcl_pkg, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "auto_path", tcl_lib, + TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT); + + } +#endif + if (zipval != NULL) { + Tcl_DecrRefCount(zipval); + zipval = NULL; + } + /* * Invoke application-specific initialization. */ @@ -406,6 +480,76 @@ Tcl_MainEx( Tcl_CreateExitHandler(FreeMainInterp, interp); } +#ifdef ZIPFS_IN_TCL + /* + * Setup auto loading info to point to mounted ZIP file. + */ + + if (zipOk == TCL_OK) { + char *tcl_lib = "/assets/tcl" TCL_VERSION; + char *tcl_pkg = "/assets"; + + Tcl_SetVar(interp, "tcl_libPath", tcl_lib, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_library", tcl_lib, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_pkgPath", tcl_pkg, TCL_GLOBAL_ONLY); + + /* + * We need to re-init encoding (after initializing Tcl), + * otherwise "encoding system" will return "identity" + */ + + TclpSetInitialEncodings(); + } + + /* + * Set embedded application startup file, if any. + */ + + if ((zipOk == TCL_OK) && autoRun) { + char *filename; + Tcl_Channel chan; + + filename = "/assets/app/main.tcl"; + chan = Tcl_OpenFileChannel(NULL, filename, "r", 0); + if (chan != (Tcl_Channel) NULL) { + Tcl_Obj *arg; + + Tcl_Close(NULL, chan); + + /* + * Push back script file to argv, if any. + */ + if ((arg = Tcl_GetStartupScript(NULL)) != NULL) { + Tcl_Obj *v, *no; + + no = Tcl_NewStringObj("argv", 4); + v = Tcl_ObjGetVar2(interp, no, NULL, TCL_GLOBAL_ONLY); + if (v != NULL) { + Tcl_Obj **objv, *nv; + int objc, i; + + objc = 0; + Tcl_ListObjGetElements(NULL, v, &objc, &objv); + nv = Tcl_NewListObj(1, &arg); + for (i = 0; i < objc; i++) { + Tcl_ListObjAppendElement(NULL, nv, objv[i]); + } + Tcl_IncrRefCount(nv); + if (Tcl_ObjSetVar2(interp, no, NULL, nv, TCL_GLOBAL_ONLY) + != NULL) { + Tcl_GlobalEval(interp, "incr argc"); + } + Tcl_DecrRefCount(nv); + } + Tcl_DecrRefCount(no); + } + Tcl_SetStartupScript(Tcl_NewStringObj(filename, -1), NULL); + Tcl_SetVar(interp, "argv0", filename, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); + } + } +#endif + /* * Invoke the script specified on the command line, if any. Must fetch it * again, as the appInitProc might have reset it. diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c index 466d535..3f8178e 100644 --- a/generic/tclPkgConfig.c +++ b/generic/tclPkgConfig.c @@ -100,19 +100,35 @@ static Tcl_Config const cfg[] = { /* Runtime paths to various stuff */ +#ifdef ANDROID + {"libdir,runtime", ""}, + {"bindir,runtime", ""}, + {"scriptdir,runtime", ""}, + {"includedir,runtime", ""}, + {"docdir,runtime", ""}, +#else {"libdir,runtime", CFG_RUNTIME_LIBDIR}, {"bindir,runtime", CFG_RUNTIME_BINDIR}, {"scriptdir,runtime", CFG_RUNTIME_SCRDIR}, {"includedir,runtime", CFG_RUNTIME_INCDIR}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, +#endif /* Installation paths to various stuff */ +#ifdef ANDROID + {"libdir,install", ""}, + {"bindir,install", ""}, + {"scriptdir,install", ""}, + {"includedir,install", ""}, + {"docdir,install", ""}, +#else {"libdir,install", CFG_INSTALL_LIBDIR}, {"bindir,install", CFG_INSTALL_BINDIR}, {"scriptdir,install", CFG_INSTALL_SCRDIR}, {"includedir,install", CFG_INSTALL_INCDIR}, {"docdir,install", CFG_INSTALL_DOCDIR}, +#endif /* Last entry, closes the array */ {NULL, NULL} @@ -123,6 +139,10 @@ TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp) /* Interpreter the configuration command is * registered in. */ { +#if defined(ANDROID) && !defined(TCL_CFGVAL_ENCODING) +#define TCL_CFGVAL_ENCODING "utf-8" +#endif + Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7a84cba..d3e0afa 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -560,6 +560,15 @@ static const TclIntStubs tclIntStubs = { TclDoubleDigits, /* 249 */ TclSetSlaveCancelFlags, /* 250 */ TclRegisterLiteral, /* 251 */ +#ifdef ZIPFS_IN_TCL + Tclzipfs_Init, /* 252 */ + Tclzipfs_Mount, /* 253 */ + Tclzipfs_Unmount, /* 254 */ +#else + 0, /* 252 */ + 0, /* 253 */ + 0, /* 254 */ +#endif }; static const TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/zcrypt.h b/generic/zcrypt.h new file mode 100644 index 0000000..eb9865b --- /dev/null +++ b/generic/zcrypt.h @@ -0,0 +1,131 @@ +/* crypt.h -- base code for crypt/uncrypt ZIPfile + + + Version 1.01e, February 12th, 2005 + + Copyright (C) 1998-2005 Gilles Vollant + + This code is a modified version of crypting code in Infozip distribution + + The encryption/decryption parts of this source code (as opposed to the + non-echoing password parts) were originally written in Europe. The + whole source package can be freely distributed, including from the USA. + (Prior to January 2000, re-export from the US was a violation of US law.) + + This encryption code is a direct transcription of the algorithm from + Roger Schlafly, described by Phil Katz in the file appnote.txt. This + file (appnote.txt) is distributed with the PKZIP program (even in the + version without encryption capabilities). + + If you don't need crypting in your application, just define symbols + NOCRYPT and NOUNCRYPT. + + This code support the "Traditional PKWARE Encryption". + + The new AES encryption added on Zip format by Winzip (see the page + http://www.winzip.com/aes_info.htm ) and PKWare PKZip 5.x Strong + Encryption is not supported. +*/ + +#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8)) + +/*********************************************************************** + * Return the next byte in the pseudo-random sequence + */ +static int decrypt_byte(unsigned long* pkeys, const unsigned int* pcrc_32_tab) +{ + unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an + * unpredictable manner on 16-bit systems; not a problem + * with any known compiler so far, though */ + + temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2; + return (int)(((temp * (temp ^ 1)) >> 8) & 0xff); +} + +/*********************************************************************** + * Update the encryption keys with the next byte of plain text + */ +static int update_keys(unsigned long* pkeys,const unsigned int* pcrc_32_tab,int c) +{ + (*(pkeys+0)) = CRC32((*(pkeys+0)), c); + (*(pkeys+1)) += (*(pkeys+0)) & 0xff; + (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; + { + register int keyshift = (int)((*(pkeys+1)) >> 24); + (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); + } + return c; +} + + +/*********************************************************************** + * Initialize the encryption keys and the random header according to + * the given password. + */ +static void init_keys(const char* passwd,unsigned long* pkeys,const unsigned int* pcrc_32_tab) +{ + *(pkeys+0) = 305419896L; + *(pkeys+1) = 591751049L; + *(pkeys+2) = 878082192L; + while (*passwd != '\0') { + update_keys(pkeys,pcrc_32_tab,(int)*passwd); + passwd++; + } +} + +#define zdecode(pkeys,pcrc_32_tab,c) \ + (update_keys(pkeys,pcrc_32_tab,c ^= decrypt_byte(pkeys,pcrc_32_tab))) + +#define zencode(pkeys,pcrc_32_tab,c,t) \ + (t=decrypt_byte(pkeys,pcrc_32_tab), update_keys(pkeys,pcrc_32_tab,c), t^(c)) + +#ifdef INCLUDECRYPTINGCODE_IFCRYPTALLOWED + +#define RAND_HEAD_LEN 12 + /* "last resort" source for second part of crypt seed pattern */ +# ifndef ZCR_SEED2 +# define ZCR_SEED2 3141592654UL /* use PI as default pattern */ +# endif + +static int crypthead(const char* passwd, /* password string */ + unsigned char* buf, /* where to write header */ + int bufSize, + unsigned long* pkeys, + const unsigned int* pcrc_32_tab, + unsigned long crcForCrypting) +{ + int n; /* index in random header */ + int t; /* temporary */ + int c; /* random byte */ + unsigned char header[RAND_HEAD_LEN-2]; /* random header */ + static unsigned calls = 0; /* ensure different random header each time */ + + if (bufSize> 7) & 0xff; + header[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, c, t); + } + /* Encrypt random header (last two bytes is high word of crc) */ + init_keys(passwd, pkeys, pcrc_32_tab); + for (n = 0; n < RAND_HEAD_LEN-2; n++) + { + buf[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, header[n], t); + } + buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 16) & 0xff, t); + buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 24) & 0xff, t); + return n; +} + +#endif diff --git a/generic/zipfs.c b/generic/zipfs.c new file mode 100644 index 0000000..ec58d9f --- /dev/null +++ b/generic/zipfs.c @@ -0,0 +1,2867 @@ +#if !defined(_WIN32) && !defined(_WIN64) +#include +#endif +#include +#include +#include +#include +#include +#include +#ifdef HAVE_ZLIB +#include "zlib.h" +#include "zcrypt.h" +#endif +#include "tclInt.h" +#include "tclFileSystem.h" +#include "zipfs.h" + +#ifdef HAVE_ZLIB + +#define ZIP_SIG_LEN 4 + +#define ZIP_LOCAL_HEADER_SIG 0x04034b50 +#define ZIP_LOCAL_HEADER_LEN 30 +#define ZIP_LOCAL_SIG_OFFS 0 +#define ZIP_LOCAL_VERSION_OFFS 4 +#define ZIP_LOCAL_FLAGS_OFFS 6 +#define ZIP_LOCAL_COMPMETH_OFFS 8 +#define ZIP_LOCAL_MTIME_OFFS 10 +#define ZIP_LOCAL_MDATE_OFFS 12 +#define ZIP_LOCAL_CRC32_OFFS 14 +#define ZIP_LOCAL_COMPLEN_OFFS 18 +#define ZIP_LOCAL_UNCOMPLEN_OFFS 22 +#define ZIP_LOCAL_PATHLEN_OFFS 26 +#define ZIP_LOCAL_EXTRALEN_OFFS 28 + +#define ZIP_CENTRAL_HEADER_SIG 0x02014b50 +#define ZIP_CENTRAL_HEADER_LEN 46 +#define ZIP_CENTRAL_SIG_OFFS 0 +#define ZIP_CENTRAL_VERSIONMADE_OFFS 4 +#define ZIP_CENTRAL_VERSION_OFFS 6 +#define ZIP_CENTRAL_FLAGS_OFFS 8 +#define ZIP_CENTRAL_COMPMETH_OFFS 10 +#define ZIP_CENTRAL_MTIME_OFFS 12 +#define ZIP_CENTRAL_MDATE_OFFS 14 +#define ZIP_CENTRAL_CRC32_OFFS 16 +#define ZIP_CENTRAL_COMPLEN_OFFS 20 +#define ZIP_CENTRAL_UNCOMPLEN_OFFS 24 +#define ZIP_CENTRAL_PATHLEN_OFFS 28 +#define ZIP_CENTRAL_EXTRALEN_OFFS 30 +#define ZIP_CENTRAL_FCOMMENTLEN_OFFS 32 +#define ZIP_CENTRAL_DISKFILE_OFFS 34 +#define ZIP_CENTRAL_IATTR_OFFS 36 +#define ZIP_CENTRAL_EATTR_OFFS 38 +#define ZIP_CENTRAL_LOCALHDR_OFFS 42 + +#define ZIP_CENTRAL_END_SIG 0x06054b50 +#define ZIP_CENTRAL_END_LEN 22 +#define ZIP_CENTRAL_END_SIG_OFFS 0 +#define ZIP_CENTRAL_DISKNO_OFFS 4 +#define ZIP_CENTRAL_DISKDIR_OFFS 6 +#define ZIP_CENTRAL_ENTS_OFFS 8 +#define ZIP_CENTRAL_TOTALENTS_OFFS 10 +#define ZIP_CENTRAL_DIRSIZE_OFFS 12 +#define ZIP_CENTRAL_DIRSTART_OFFS 16 +#define ZIP_CENTRAL_COMMENTLEN_OFFS 20 + +#define ZIP_MIN_VERSION 20 +#define ZIP_COMPMETH_STORED 0 +#define ZIP_COMPMETH_DEFLATED 8 + +#define ZIP_PASSWORD_END_SIG 0x5a5a4b50 + +#define zip_read_int(p) \ + ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24)) +#define zip_read_short(p) \ + ((p)[0] | ((p)[1] << 8)) + +#define zip_write_int(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ + (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff; +#define zip_write_short(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; + +#if defined(_WIN32) || defined(_WIN64) +static CONST char alpha[] = + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; +#endif + +#if !defined(_WIN32) && !defined(_WIN64) +#ifndef HAVE_LOCALTIME_R +TCL_DECLARE_MUTEX(localtimeMutex) +#endif +#endif + +typedef struct ZipFile { + char *name; /* Archive name */ + Tcl_Channel chan; /* Channel handle or NULL */ + unsigned char *data; /* Memory mapped or malloc'ed file */ + long length; /* Length of memory mapped file */ + unsigned char *tofree; /* Non-NULL if malloc'ed file */ + int nfiles; /* Number of files in archive */ + int baseoffs; /* Archive start */ + int baseoffsp; /* Password start */ + int centoffs; /* Archive directory start */ + char pwbuf[264]; /* Password buffer */ +#if defined(_WIN32) || defined(_WIN64) + HANDLE mh; +#endif + int nopen; /* Number of open files on archive */ + struct ZipEntry *entries; /* List of files in archive */ + struct ZipEntry *topents; /* List of top-level dirs in archive */ + int mntptlen; /* Length of mount point */ + char mntpt[1]; /* Mount point */ +} ZipFile; + +typedef struct ZipEntry { + char *name; /* The full pathname of the virtual file */ + ZipFile *zipfile; /* The ZIP file holding this virtual file */ + long offset; /* Data offset into memory mapped ZIP file */ + int nbyte; /* Uncompressed size of the virtual file */ + int nbytecompr; /* Compressed size of the virtual file */ + int cmeth; /* Compress method */ + int isdir; /* Set to 1 if directory */ + int depth; /* Number of slashes in path. */ + int crc32; /* CRC-32 */ + int timestamp; /* Modification time */ + int isenc; /* True if data is encrypted */ + unsigned char *data; /* File data if written */ + struct ZipEntry *next; /* Next file in the same archive */ + struct ZipEntry *tnext; /* Next top-level dir in archive */ +} ZipEntry; + +typedef struct ZipChannel { + ZipFile *zipfile; /* The ZIP file holding this channel */ + ZipEntry *zipentry; /* Pointer back to virtual file */ + unsigned long nmax; /* Max. size for write */ + unsigned long nbyte; /* Number of bytes of uncompressed data */ + unsigned long nread; /* Pos of next byte to be read from the channel */ + unsigned char *ubuf; /* Pointer to the uncompressed data */ + int iscompr; /* True if data is compressed */ + int isdir; /* Set to 1 if directory */ + int isenc; /* True if data is encrypted */ + int iswr; /* True if open for writing */ + unsigned long keys[3]; /* Key for decryption */ +} ZipChannel; + +static struct { + int initialized; /* True when initialized */ + int lock; /* RW lock, see below */ + int waiters; /* RW lock, see below */ + int wrmax; /* Maximum write size of a file */ + Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ + Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ +} ZipFS = { + 0, 0, 0, 0, +}; + +/* POSIX like rwlock (multiple reader, single writer) */ + +TCL_DECLARE_MUTEX(ZipFSMutex) +static Tcl_Condition ZipFSCond; + +static void +ReadLock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + while (ZipFS.lock < 0) { + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; + } + ZipFS.lock++; + Tcl_MutexUnlock(&ZipFSMutex); +} + +static void +WriteLock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + while (ZipFS.lock != 0) { + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; + } + ZipFS.lock = -1; + Tcl_MutexUnlock(&ZipFSMutex); +} + +static void +Unlock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + if (ZipFS.lock > 0) { + --ZipFS.lock; + } else if (ZipFS.lock < 0) { + ZipFS.lock = 0; + } + if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) { + Tcl_ConditionNotify(&ZipFSCond); + } + Tcl_MutexUnlock(&ZipFSMutex); +} + +static CONST char pwrot[16] = { + 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, + 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 +}; + +static CONST unsigned int crc32tab[256] = { + 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, + 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, + 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, + 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de, + 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856, + 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9, + 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4, + 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b, + 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3, + 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a, + 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599, + 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924, + 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190, + 0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f, + 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e, + 0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01, + 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed, + 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950, + 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3, + 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2, + 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a, + 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5, + 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010, + 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f, + 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17, + 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6, + 0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615, + 0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8, + 0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344, + 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb, + 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a, + 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5, + 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1, + 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c, + 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef, + 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236, + 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe, + 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31, + 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c, + 0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713, + 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b, + 0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242, + 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1, + 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c, + 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278, + 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7, + 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66, + 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9, + 0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605, + 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8, + 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, + 0x2d02ef8d, +}; + +static time_t +DosTimeDate(int dosDate, int dosTime) +{ + time_t now; + struct tm *tmp, tm; + + now = time(NULL); +#if defined(_WIN32) || defined(_WIN64) + tmp = localtime(&now); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&now, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&now); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif + tm.tm_year = (((dosDate & 0xfe00) >> 9) + 80); + tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1; + tm.tm_mday = dosDate & 0x1f; + tm.tm_hour = (dosTime & 0xf800) >> 11; + tm.tm_min = (dosTime & 0x7e) >> 5; + tm.tm_sec = (dosTime & 0x1f) << 1; + return mktime(&tm); +} + +static int +ToDosTime(time_t when) +{ + struct tm *tmp, tm; + +#if defined(_WIN32) || defined(_WIN64) + tmp = localtime(&when); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&when, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&when); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif + return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1); +} + +static int +ToDosDate(time_t when) +{ + struct tm *tmp, tm; + +#if defined(_WIN32) || defined(_WIN64) + tmp = localtime(&when); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&when, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&when); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif + return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday; +} + +static int +CountSlashes(CONST char *string) +{ + int count = 0; + CONST char *p = string; + + while (*p != '\0') { + if (*p == '/') { + count++; + } + p++; + } + return count; +} + +static char * +CanonicalPath(CONST char *root, CONST char *tail, Tcl_DString *dsPtr) +{ + char *path; + int i, j, c, isunc = 0; + +#if defined(_WIN32) || defined(_WIN64) + if ((tail[0] != '\0') && (strchr(alpha, tail[0]) != NULL) && + (tail[1] == ':')) { + tail += 2; + } + /* UNC style path */ + if (tail[0] == '\\') { + root = ""; + ++tail; + } + if (tail[0] == '\\') { + root = "/"; + ++tail; + } +#endif + /* UNC style path */ + if ((root[0] == '/') && (root[1] == '/')) { + isunc = 1; + } + if (tail[0] == '/') { + root = ""; + ++tail; + isunc = 0; + } + if (tail[0] == '/') { + root = "/"; + ++tail; + isunc = 1; + } + i = strlen(root); + j = strlen(tail); + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); +#if defined(_WIN32) || defined(_WIN64) + for (i = 0; path[i] != '\0'; i++) { + if (path[i] == '\\') { + path[i] = '/'; + } + } +#endif + for (i = j = 0; (c = path[i]) != '\0'; i++) { + if (c == '/') { + int c2 = path[i + 1]; + + if (c2 == '/') { + continue; + } + if (c2 == '.') { + int c3 = path[i + 2]; + + if ((c3 == '/') || (c3 == '\0')) { + i++; + continue; + } + if ((c3 == '.') && + ((path[i + 3] == '/') || (path [i + 3] == '\0'))) { + i += 2; + while ((j > 0) && (path[j - 1] != '/')) { + j--; + } + if (j > isunc) { + --j; + while ((j > 1 + isunc) && (path[j - 2] == '/')) { + j--; + } + } + continue; + } + } + } + path[j++] = c; + } + if (j == 0) { + path[j++] = '/'; + } + path[j] = 0; + Tcl_DStringSetLength(dsPtr, j); + return Tcl_DStringValue(dsPtr); +} + +static char * +AbsolutePath(CONST char *path, Tcl_DString *dsPtr) +{ + char *result; + + if (*path == '~') { + Tcl_DStringAppend(dsPtr, path, -1); + return Tcl_DStringValue(dsPtr); + } + if ((*path != '/') +#if defined(_WIN32) || defined(_WIN64) + && (*path != '\\') && + (((*path != '\0') && (strchr(alpha, *path) == NULL)) || + (path[1] != ':')) +#endif + ) { + Tcl_DString pwd; + + /* relative path */ + Tcl_DStringInit(&pwd); + Tcl_GetCwd(NULL, &pwd); + result = Tcl_DStringValue(&pwd); +#if defined(_WIN32) || defined(_WIN64) + if ((result[0] != '\0') && (strchr(alpha, result[0]) != NULL) && + (result[1] == ':')) { + result += 2; + } +#endif + result = CanonicalPath(result, path, dsPtr); + Tcl_DStringFree(&pwd); + } else { + /* absolute path */ + result = CanonicalPath("", path, dsPtr); + } + return result; +} + +static ZipEntry * +ZipFSLookup(char *filename) +{ + char *realname; + Tcl_HashEntry *hPtr; + ZipEntry *z; + Tcl_DString ds; + + Tcl_DStringInit(&ds); + realname = AbsolutePath(filename, &ds); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, realname); + z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; + Tcl_DStringFree(&ds); + return z; +} + +#ifdef NEVER_USED +static int +ZipFSLookupMount(char *filename) +{ + char *realname; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + Tcl_DString ds; + int match = 0; + + Tcl_DStringInit(&ds); + realname = AbsolutePath(filename, &ds); + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (strcmp(zf->mntpt, realname) == 0) { + match = 1; + break; + } + } + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_DStringFree(&ds); + return match; +} +#endif + +static void +ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) +{ +#if defined(_WIN32) || defined(_WIN64) + if ((zf->data != NULL) && (zf->tofree == NULL)) { + UnmapViewOfFile(zf->data); + zf->data = NULL; + } + if (zf->mh != INVALID_HANDLE_VALUE) { + CloseHandle(zf->mh); + } +#else + if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) { + munmap(zf->data, zf->length); + zf->data = MAP_FAILED; + } +#endif + if (zf->tofree != NULL) { + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; + } + Tcl_Close(interp, zf->chan); + zf->chan = NULL; +} + +static int +ZipFSOpenArchive(Tcl_Interp *interp, CONST char *zipname, int needZip, + ZipFile *zf) +{ + int i; + ClientData handle; + unsigned char *p, *q; + +#if defined(_WIN32) || defined(_WIN64) + zf->data = NULL; + zf->mh = INVALID_HANDLE_VALUE; +#else + zf->data = MAP_FAILED; +#endif + zf->length = 0; + zf->nfiles = 0; + zf->baseoffs = zf->baseoffsp = 0; + zf->tofree = NULL; + zf->pwbuf[0] = 0; + zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0); + if (zf->chan == NULL) { + return TCL_ERROR; + } + if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { + if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") + != TCL_OK) { + goto error; + } + if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") + != TCL_OK) { + goto error; + } + zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); + if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal file size", -1)); + } + goto error; + } + Tcl_Seek(zf->chan, 0, SEEK_SET); + zf->tofree = zf->data = (unsigned char *) Tcl_Alloc(zf->length); + i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); + if (i != zf->length) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file read error", -1)); + } + goto error; + } + Tcl_Close(interp, zf->chan); + zf->chan = NULL; + } else { +#if defined(_WIN32) || defined(_WIN64) + zf->length = GetFileSize((HANDLE) handle, 0); + if ((zf->length == INVALID_FILE_SIZE) || + (zf->length < ZIP_CENTRAL_END_LEN)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid file size", -1)); + } + goto error; + } + zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0, + zf->length, 0); + if (zf->mh == INVALID_HANDLE_VALUE) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file mapping failed", -1)); + } + goto error; + } + zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length); + if (zf->data == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file mapping failed", -1)); + } + goto error; + } +#else + zf->length = lseek((int) (long) handle, 0, SEEK_END); + if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid file size", -1)); + } + goto error; + } + lseek((int) (long) handle, 0, SEEK_SET); + zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, + MAP_FILE | MAP_PRIVATE, + (int) (long) handle, 0); + if (zf->data == MAP_FAILED) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file mapping failed", -1)); + } + goto error; + } +#endif + } + p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; + while (p >= zf->data) { + if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { + if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { + break; + } + p -= ZIP_SIG_LEN; + } else { + --p; + } + } + if (p < zf->data) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong end signature", -1)); + } + goto error; + } + zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); + if (zf->nfiles == 0) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("empty archive", -1)); + } + goto error; + } + q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); + p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); + if ((p < zf->data) || (p > (zf->data + zf->length)) || + (q < zf->data) || (q > (zf->data + zf->length))) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("archive directory not found", -1)); + } + goto error; + } + zf->baseoffs = zf->baseoffsp = p - q; + zf->centoffs = p - zf->data; + q = p; + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra; + + if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong header length", -1)); + } + goto error; + } + if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong header signature", -1)); + } + goto error; + } + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + q = zf->data + zf->baseoffs; + if ((zf->baseoffs >= 6) && + (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { + i = q[-5]; + if (q - 5 - i > zf->data) { + zf->pwbuf[0] = i; + memcpy(zf->pwbuf + 1, q - 5 - i, i); + zf->baseoffsp -= i ? (5 + i) : 0; + } + } + return TCL_OK; + +error: + ZipFSCloseArchive(interp, zf); + return TCL_ERROR; +} + +int +Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, + CONST char *passwd) +{ + char *realname; + int i, pwlen, isNew; + ZipFile *zf, zf0; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_DString ds, fpBuf; + unsigned char *q; + + ReadLock(); + if (!ZipFS.initialized) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("not initialized", -1)); + } + Unlock(); + return TCL_ERROR; + } + if (zipname == NULL) { + Tcl_HashSearch search; + int ret = TCL_OK; + + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + if (mntpt == NULL) { + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + Tcl_DStringInit(&ds); + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, AbsolutePath(zipname, &ds)); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->mntpt, -1)); + } + } + Unlock(); + Tcl_DStringFree(&ds); + return TCL_OK; + } + Unlock(); + pwlen = 0; + if (passwd != NULL) { + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; + } + } + if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { + return TCL_ERROR; + } + Tcl_DStringInit(&ds); + realname = AbsolutePath(zipname, &ds); + WriteLock(); + hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, realname, &isNew); + Tcl_DStringSetLength(&ds, 0); + if (!isNew) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (interp != NULL) { + Tcl_AppendResult(interp, "already mounted at ", zf->mntpt, + (char *) NULL); + } + goto error; + } + if (strcmp(mntpt, "/") == 0) { + mntpt = ""; + } + zf = (ZipFile *) Tcl_Alloc(sizeof (*zf) + strlen(mntpt) + 1); + *zf = zf0; + zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + strcpy(zf->mntpt, mntpt); + zf->mntptlen = strlen(zf->mntpt); + zf->entries = NULL; + zf->topents = NULL; + zf->nopen = 0; + Tcl_SetHashValue(hPtr, (ClientData) zf); + if ((zf->pwbuf[0] == 0) && pwlen) { + int k = 0; + + i = pwlen; + zf->pwbuf[k++] = i; + while (i > 0) { + zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | + pwrot[(passwd[i - 1] >> 4) & 0x0f]; + k++; + i--; + } + zf->pwbuf[k] = '\0'; + } + if (mntpt[0] != '\0') { + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(mntpt); + z->zipfile = zf; + z->isdir = 1; + z->isenc = 0; + z->offset = zf->baseoffs; + z->crc32 = 0; + z->timestamp = 0; + z->nbyte = z->nbytecompr = 0; + z->cmeth = ZIP_COMPMETH_STORED; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); + if (!isNew) { + /* skip it */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + } + } + q = zf->data + zf->centoffs; + Tcl_DStringInit(&fpBuf); + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; + unsigned char *lq, *gq = NULL; + char *fullpath, *path; + + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); + path = Tcl_DStringValue(&ds); + if ((pathlen > 0) && (path[pathlen - 1] == '/')) { + Tcl_DStringSetLength(&ds, pathlen - 1); + path = Tcl_DStringValue(&ds); + isdir = 1; + } + if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { + goto nextent; + } + lq = zf->data + zf->baseoffs + + zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); + if ((lq < zf->data) || (lq > (zf->data + zf->length))) { + goto nextent; + } + nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); + if (!isdir && (nbcompr == 0) && + (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && + (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { + gq = q; + nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); + } + offs = (lq - zf->data) + + ZIP_LOCAL_HEADER_LEN + + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) + + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); + if ((offs + nbcompr) > zf->length) { + goto nextent; + } + if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { + goto nextent; + } + Tcl_DStringSetLength(&fpBuf, 0); + fullpath = CanonicalPath(mntpt, path, &fpBuf); + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(fullpath); + z->zipfile = zf; + z->isdir = isdir; + z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) + && (nbcompr > 12); + z->offset = offs; + if (gq != NULL) { + z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); + dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); + dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); + } else { + z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); + dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); + dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); + } + z->nbytecompr = nbcompr; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); + if (!isNew) { + /* skip it */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { + z->tnext = zf->topents; + zf->topents = z; + } + if (!z->isdir && (z->depth > 1)) { + char *dir, *end; + ZipEntry *zd; + + Tcl_DStringSetLength(&ds, strlen(z->name) + 8); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, z->name, -1); + dir = Tcl_DStringValue(&ds); + end = strrchr(dir, '/'); + while ((end != NULL) && (end != dir)) { + Tcl_DStringSetLength(&ds, end - dir); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); + if (hPtr != NULL) { + break; + } + zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); + zd->name = NULL; + zd->tnext = NULL; + zd->depth = CountSlashes(dir); + zd->zipfile = zf; + zd->isdir = 1; + zd->isenc = 0; + zd->offset = z->offset; + zd->crc32 = 0; + zd->timestamp = z->timestamp; + zd->nbyte = zd->nbytecompr = 0; + zd->cmeth = ZIP_COMPMETH_STORED; + zd->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); + if (!isNew) { + /* should never happen but skip it */ + Tcl_Free((char *) zd); + } else { + Tcl_SetHashValue(hPtr, (ClientData) zd); + zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + zd->next = zf->entries; + zf->entries = zd; + if ((mntpt[0] == '\0') && (zd->depth == 1)) { + zd->tnext = zf->topents; + zf->topents = zd; + } + } + end = strrchr(dir, '/'); + } + } + } +nextent: + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + Tcl_DStringFree(&fpBuf); + Tcl_DStringFree(&ds); + Unlock(); + Tcl_FSMountsChanged(NULL); + return TCL_OK; + +error: + Tcl_DStringFree(&ds); + Unlock(); + ZipFSCloseArchive(interp, zf); + Tcl_Free((char *) zf); + return TCL_ERROR; +} + +int +Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname) +{ + char *realname; + ZipFile *zf; + ZipEntry *z, *znext; + Tcl_HashEntry *hPtr; + Tcl_DString ds; + int ret = TCL_OK, unmounted = 0; + + Tcl_DStringInit(&ds); + realname = AbsolutePath(zipname, &ds); + WriteLock(); + if (!ZipFS.initialized) { + goto done; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, realname); + if (hPtr == NULL) { + /* does not report error */ + goto done; + } + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->nopen > 0) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("filesystem is busy", -1)); + } + ret = TCL_ERROR; + goto done; + } + Tcl_DeleteHashEntry(hPtr); + for (z = zf->entries; z; z = znext) { + znext = z->next; + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + Tcl_Free((char *) z); + } + ZipFSCloseArchive(interp, zf); + Tcl_Free((char *) zf); + unmounted = 1; +done: + Unlock(); + Tcl_DStringFree(&ds); + if (unmounted) { + Tcl_FSMountsChanged(NULL); + } + return ret; +} + +static int +ZipFSMountCmd(ClientData clientData, Tcl_Interp *interp, + int argc, CONST char **argv) +{ + if (argc > 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ?zipfile ?mountpoint? ?password???\"", 0); + return TCL_ERROR; + } + return Zipfs_Mount(interp, (argc > 1) ? argv[1] : NULL, + (argc > 2) ? argv[2] : NULL, + (argc > 3) ? argv[3] : NULL); +} + +static int +ZipFSUnmountCmd(ClientData clientData, Tcl_Interp *interp, + int argc, CONST char **argv) +{ + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " zipfile\"", (char *) NULL); + return TCL_ERROR; + } + return Zipfs_Unmount(interp, argv[1]); +} + +static int +ZipFSMkKeyCmd(ClientData clientData, Tcl_Interp *interp, + int argc, CONST char **argv) +{ + int len, i = 0; + char pwbuf[264]; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " password\"", (char *) NULL); + return TCL_ERROR; + } + len = strlen(argv[1]); + if (len == 0) { + return TCL_OK; + } + if ((len > 255) || (strchr(argv[1], 0xff) != NULL)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; + } + while (len > 0) { + int ch = argv[1][len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + Tcl_AppendResult(interp, pwbuf, (char *) NULL); + return TCL_OK; +} + +static int +ZipAddFile(Tcl_Interp *interp, CONST char *path, Tcl_Channel out, + CONST char *passwd, char *buf, int bufsize, Tcl_HashTable *fileHash) +{ + Tcl_Channel in; + Tcl_HashEntry *hPtr; + ZipEntry *z; + z_stream stream; + CONST char *zpath; + int nbyte, nbytecompr, len, crc, flush, pos[3], zpathlen, olen; + int mtime = 0, isNew, align = 0, cmeth; + unsigned long keys[3], keys0[3]; + char obuf[4096]; + + zpath = path; + while (zpath != NULL && zpath[0] == '/') { + zpath++; + } + if ((zpath == NULL) || (zpath[0] == '\0')) { + return TCL_OK; + } + zpathlen = strlen(zpath); + if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { + Tcl_AppendResult(interp, "path too long for \"", path, "\"", + (char *) NULL); + return TCL_ERROR; + } + in = Tcl_OpenFileChannel(interp, path, "r", 0); + if ((in == NULL) || + (Tcl_SetChannelOption(interp, in, "-translation", "binary") + != TCL_OK) || + (Tcl_SetChannelOption(interp, in, "-encoding", "binary") + != TCL_OK)) { +#if defined(_WIN32) || defined(_WIN64) + /* hopefully a directory */ + if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } +#endif + Tcl_Close(interp, in); + return TCL_ERROR; + } else { + Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); + Tcl_StatBuf statBuf; + + Tcl_IncrRefCount(pathObj); + if (Tcl_FSStat(pathObj, &statBuf) != -1) { + mtime = statBuf.st_mtime; + } + Tcl_DecrRefCount(pathObj); + } + Tcl_ResetResult(interp); + crc = 0; + nbyte = nbytecompr = 0; + while ((len = Tcl_Read(in, buf, bufsize)) > 0) { + crc = crc32(crc, (unsigned char *) buf, len); + nbyte += len; + } + if (len == -1) { + if (nbyte == 0) { + if (strcmp("illegal operation on a directory", + Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } + } + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + if (Tcl_Seek(in, 0, SEEK_SET) == -1) { + Tcl_AppendResult(interp, "seek error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + pos[0] = Tcl_Tell(out); + memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); + memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); + len = zpathlen + ZIP_LOCAL_HEADER_LEN; + if (Tcl_Write(out, buf, len) != len) { +wrerr: + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + if ((len + pos[0]) & 3) { + char abuf[8]; + + /* + * Align payload to next 4-byte boundary using a dummy extra + * entry similar to the zipalign tool from Android's SDK. + */ + align = 4 + ((len + pos[0]) & 3); + zip_write_short(abuf, 0xffff); + zip_write_short(abuf + 2, align - 4); + zip_write_int(abuf + 4, 0x03020100); + if (Tcl_Write(out, abuf, align) != align) { + goto wrerr; + } + } + if (passwd != NULL) { + int i, ch, tmp; + unsigned char kvbuf[24]; + Tcl_Obj *ret; + + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + if (Tcl_Eval(interp, "expr int(rand() * 256) % 256") != TCL_OK) { + Tcl_AppendResult(interp, "PRNG error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + ret = Tcl_GetObjResult(interp); + if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) { + Tcl_Close(interp, in); + return TCL_ERROR; + } + kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); + } + Tcl_ResetResult(interp); + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + kvbuf[i] = (unsigned char) zencode(keys, crc32tab, + kvbuf[i + 12], tmp); + } + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); + len = Tcl_Write(out, (char *) kvbuf, 12); + memset(kvbuf, 0, 24); + if (len != 12) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + memcpy(keys0, keys, sizeof (keys0)); + nbytecompr += 12; + } + Tcl_Flush(out); + pos[2] = Tcl_Tell(out); + cmeth = ZIP_COMPMETH_DEFLATED; + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) + != Z_OK) { + Tcl_AppendResult(interp, "compression init error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + do { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + stream.avail_in = len; + stream.next_in = (unsigned char *) buf; + flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; + do { + stream.avail_out = sizeof (obuf); + stream.next_out = (unsigned char *) obuf; + len = deflate(&stream, flush); + if (len == Z_STREAM_ERROR) { + Tcl_AppendResult(interp, "deflate error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + olen = sizeof (obuf) - stream.avail_out; + if (passwd != NULL) { + int i, tmp; + + for (i = 0; i < olen; i++) { + obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); + } + } + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += olen; + } while (stream.avail_out == 0); + } while (flush != Z_FINISH); + deflateEnd(&stream); + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + if (nbyte - nbytecompr <= 0) { + /* + * Compressed file larger than input, + * write it again uncompressed. + */ + if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { + goto seekErr; + } + if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { +seekErr: + Tcl_Close(interp, in); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + nbytecompr = (passwd != NULL) ? 12 : 0; + while (1) { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } else if (len == 0) { + break; + } + if (passwd != NULL) { + int i, tmp; + + for (i = 0; i < len; i++) { + buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); + } + } + if (Tcl_Write(out, buf, len) != len) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += len; + } + cmeth = ZIP_COMPMETH_STORED; + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + Tcl_TruncateChannel(out, pos[1]); + } + Tcl_Close(interp, in); + + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = 0; + z->zipfile = NULL; + z->isdir = 0; + z->isenc = (passwd != NULL) ? 1 : 0; + z->offset = pos[0]; + z->crc32 = crc; + z->timestamp = mtime; + z->nbyte = nbyte; + z->nbytecompr = nbytecompr; + z->cmeth = cmeth; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew); + if (!isNew) { + Tcl_AppendResult(interp, "not unique path name \"", path, "\"", + (char *) NULL); + Tcl_Free((char *) z); + return TCL_ERROR; + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(fileHash, hPtr); + z->next = NULL; + } + + /* + * Write final local header information. + */ + zip_write_int(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG); + zip_write_short(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_LOCAL_FLAGS_OFFS, z->isenc); + zip_write_short(buf + ZIP_LOCAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_LOCAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen); + zip_write_short(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); + if ((int) Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "write error", (char *) NULL); + return TCL_ERROR; + } + Tcl_Flush(out); + if ((int) Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +static int +ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, + int isImg, int argc, CONST char **argv) +{ + Tcl_Channel out; + int len = 0, pwlen = 0, i, ret = TCL_ERROR, largc, pos[3]; + CONST char **largv; + Tcl_DString ds; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_HashTable fileHash; + char pwbuf[264], buf[4096]; + + if ((argc < 3) || (argc > (isImg ? 5 : 4))) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " outfile indir ?password?", + isImg ? " ?infile?\"" : "\"", (char *) NULL); + return TCL_ERROR; + } + pwbuf[0] = 0; + if (argc > 3) { + pwlen = strlen(argv[3]); + if ((pwlen > 255) || (strchr(argv[1], 0xff) != NULL)) { + Tcl_AppendResult(interp, "illegal password", (char *) NULL); + return TCL_ERROR; + } + } + Tcl_DStringInit(&ds); + Tcl_DStringAppendElement(&ds, "::zipfs::find"); + Tcl_DStringAppendElement(&ds, argv[2]); + if (Tcl_Eval(interp, Tcl_DStringValue(&ds)) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + Tcl_DStringFree(&ds); + if (Tcl_SplitList(interp, Tcl_GetStringResult(interp), &largc, &largv) + != TCL_OK) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); + if (largc == 0) { + Tcl_Free((char *) largv); + Tcl_AppendResult(interp, "empty archive", (char *) NULL); + return TCL_ERROR; + } + out = Tcl_OpenFileChannel(interp, argv[1], "w", 0755); + if ((out == NULL) || + (Tcl_SetChannelOption(interp, out, "-translation", "binary") + != TCL_OK) || + (Tcl_SetChannelOption(interp, out, "-encoding", "binary") + != TCL_OK)) { + Tcl_Close(interp, out); + Tcl_Free((char *) largv); + return TCL_ERROR; + } + if (isImg) { + ZipFile zf0; + + if (ZipFSOpenArchive(interp, (argc > 4) ? argv[4] : + Tcl_GetNameOfExecutable(), 0, &zf0) != TCL_OK) { + Tcl_Close(interp, out); + Tcl_Free((char *) largv); + return TCL_ERROR; + } + if (pwlen && (argc > 3)) { + i = 0; + len = pwlen; + while (len > 0) { + int ch = argv[3][len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + } + i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); + if (i != zf0.baseoffsp) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, out); + Tcl_Free((char *) largv); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + ZipFSCloseArchive(interp, &zf0); + len = strlen(pwbuf); + if (len > 0) { + i = Tcl_Write(out, pwbuf, len); + if (i != len) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, out); + Tcl_Free((char *) largv); + return TCL_ERROR; + } + } + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_Flush(out); + } + Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); + pos[0] = Tcl_Tell(out); + for (i = 0; i < largc; i++) { + if (ZipAddFile(interp, largv[i], out, (pwlen > 0) ? argv[3] : NULL, + buf, sizeof (buf), &fileHash) + != TCL_OK) { + goto done; + } + } + pos[1] = Tcl_Tell(out); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); + i = 0; + while (hPtr != NULL) { + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + len = strlen(z->name); + zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); + zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0); + zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len); + zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); + memcpy(buf + ZIP_CENTRAL_HEADER_LEN, z->name, len); + len += ZIP_CENTRAL_HEADER_LEN; + if (Tcl_Write(out, buf, len) != len) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + goto done; + } + hPtr = Tcl_NextHashEntry(&search); + ++i; + } + Tcl_Flush(out); + pos[2] = Tcl_Tell(out); + zip_write_int(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG); + zip_write_short(buf + ZIP_CENTRAL_DISKNO_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_ENTS_OFFS, i); + zip_write_short(buf + ZIP_CENTRAL_TOTALENTS_OFFS, i); + zip_write_int(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]); + zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]); + zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); + if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + goto done; + } + Tcl_Flush(out); + ret = TCL_OK; +done: + Tcl_Free((char *) largv); + Tcl_Close(interp, out); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); + while (hPtr != NULL) { + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + Tcl_Free((char *) z); + Tcl_DeleteHashEntry(hPtr); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); + } + Tcl_DeleteHashTable(&fileHash); + return ret; +} + +static int +ZipFSMkZipCmd(ClientData clientData, Tcl_Interp *interp, + int argc, CONST char **argv) +{ + return ZipFSMkZipOrImgCmd(clientData, interp, 0, argc, argv); +} + +static int +ZipFSMkImgCmd(ClientData clientData, Tcl_Interp *interp, + int argc, CONST char **argv) +{ + return ZipFSMkZipOrImgCmd(clientData, interp, 1, argc, argv); +} + +static int +ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) +{ + char *filename; + int exists; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; + } + filename = Tcl_GetStringFromObj(objv[1], 0); + ReadLock(); + exists = ZipFSLookup(filename) != NULL; + Unlock(); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), exists); + return TCL_OK; +} + +static int +ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) +{ + char *filename; + ZipEntry *z; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; + } + filename = Tcl_GetStringFromObj(objv[1], 0); + ReadLock(); + z = ZipFSLookup(filename); + if (z != NULL) { + Tcl_Obj *result = Tcl_GetObjResult(interp); + + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->zipfile->name, -1)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset)); + } + Unlock(); + return TCL_OK; +} + +static int +ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) +{ + char *pattern = NULL; + Tcl_RegExp regexp = NULL; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *result = Tcl_GetObjResult(interp); + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); + return TCL_ERROR; + } + if (objc == 3) { + int n; + char *what = Tcl_GetStringFromObj(objv[1], &n); + + if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { + pattern = Tcl_GetString(objv[2]); + } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { + regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + if (regexp == NULL) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "unknown option: ", what, (char *) NULL); + return TCL_ERROR; + } + } else if (objc == 2) { + pattern = Tcl_GetStringFromObj(objv[1], 0); + } + ReadLock(); + if (pattern != NULL) { + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if (Tcl_StringMatch(z->name, pattern)) { + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } else if (regexp != NULL) { + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } else { + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->name, -1)); + } + } + Unlock(); + return TCL_OK; +} + +static int +ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) +{ + ZipChannel *info = (ZipChannel *) instanceData; + + if (info->iscompr && (info->ubuf != NULL)) { + Tcl_Free((char *) info->ubuf); + info->ubuf = NULL; + } + if (info->isenc) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + } + if (info->iswr) { + ZipEntry *z = info->zipentry; + unsigned char *newdata; + + newdata = + (unsigned char *) Tcl_Realloc((char *) info->ubuf, info->nread); + if (newdata != NULL) { + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + z->data = newdata; + z->nbyte = z->nbytecompr = info->nbyte; + z->cmeth = ZIP_COMPMETH_STORED; + z->timestamp = time(NULL); + z->isdir = 0; + z->isenc = 0; + z->offset = 0; + z->crc32 = 0; + } else { + Tcl_Free((char *) info->ubuf); + } + } + WriteLock(); + info->zipfile->nopen--; + Unlock(); + Tcl_Free((char *) info); + return TCL_OK; +} + +static int +ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long nextpos; + + if (info->isdir) { + *errloc = EISDIR; + return -1; + } + nextpos = info->nread + toRead; + if (nextpos > info->nbyte) { + toRead = info->nbyte - info->nread; + nextpos = info->nbyte; + } + if (toRead == 0) { + return 0; + } + if (info->isenc) { + int i, ch; + + for (i = 0; i < toRead; i++) { + ch = info->ubuf[i + info->nread]; + buf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(buf, info->ubuf + info->nread, toRead); + } + info->nread = nextpos; + *errloc = 0; + return toRead; +} + +static int +ZipChannelWrite(ClientData instanceData, CONST char *buf, + int toWrite, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long nextpos; + + if (!info->iswr) { + *errloc = EINVAL; + return -1; + } + nextpos = info->nread + toWrite; + if (nextpos > info->nmax) { + toWrite = info->nmax - info->nread; + nextpos = info->nmax; + } + if (toWrite == 0) { + return 0; + } + memcpy(info->ubuf + info->nread, buf, toWrite); + info->nread = nextpos; + if (info->nread > info->nbyte) { + info->nbyte = info->nread; + } + *errloc = 0; + return toWrite; +} + +static int +ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + + if (info->isdir) { + *errloc = EINVAL; + return -1; + } + switch (mode) { + case SEEK_CUR: + offset += info->nread; + break; + case SEEK_END: + offset += info->nbyte; + break; + case SEEK_SET: + break; + default: + *errloc = EINVAL; + return -1; + } + if (info->iswr) { + if (offset > info->nmax) { + *errloc = EINVAL; + return -1; + } + if (offset > info->nbyte) { + info->nbyte = offset; + } + } else if (offset > info->nbyte) { + *errloc = EINVAL; + return -1; + } + if (offset < 0) { + *errloc = EINVAL; + return -1; + } + info->nread = (unsigned long) offset; + return info->nread; +} + +static void +ZipChannelWatchChannel(ClientData instanceData, int mask) +{ + return; +} +static int +ZipChannelGetFile(ClientData instanceData, int direction, + ClientData *handlePtr) +{ + return TCL_ERROR; +} + +static Tcl_ChannelType ZipChannelType = { + "zip", /* Type name. */ +#ifdef TCL_CHANNEL_VERSION_4 + TCL_CHANNEL_VERSION_4, + ZipChannelClose, /* Close channel, clean instance data */ + ZipChannelRead, /* Handle read request */ + ZipChannelWrite, /* Handle write request */ + ZipChannelSeek, /* Move location of access point, NULL'able */ + NULL, /* Set options, NULL'able */ + NULL, /* Get options, NULL'able */ + ZipChannelWatchChannel, /* Initialize notifier */ + ZipChannelGetFile, /* Get OS handle from the channel */ + NULL, /* 2nd version of close channel, NULL'able */ + NULL, /* Set blocking mode for raw channel, NULL'able */ + NULL, /* Function to flush channel, NULL'able */ + NULL, /* Function to handle event, NULL'able */ + NULL, /* Wide seek function, NULL'able */ + NULL, /* Thread action function, NULL'able */ +#else + NULL, /* Set blocking/nonblocking behaviour, NULL'able */ + ZipChannelClose, /* Close channel, clean instance data */ + ZipChannelRead, /* Handle read request */ + ZipChannelWrite, /* Handle write request */ + ZipChannelSeek, /* Move location of access point, NULL'able */ + NULL, /* Set options, NULL'able */ + NULL, /* Get options, NULL'able */ + ZipChannelWatchChannel, /* Initialize notifier */ + ZipChannelGetFile, /* Get OS handle from the channel */ +#endif +}; + +static Tcl_Channel +ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) +{ + ZipEntry *z; + ZipChannel *info; + static int count = 1; + int i, ch, trunc, wr, flags = 0; + char cname[128]; + + if ((mode & O_APPEND) || + ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); + } + return NULL; + } + WriteLock(); + z = ZipFSLookup(filename); + if (z == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + } + goto error; + } + trunc = (mode & O_TRUNC) != 0; + wr = (mode & (O_WRONLY | O_RDWR)) != 0; + if ((z->cmeth != ZIP_COMPMETH_STORED) && + (z->cmeth != ZIP_COMPMETH_DEFLATED)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unsupported compression method", -1)); + } + goto error; + } + if (wr && z->isdir) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unsupported file type", -1)); + } + goto error; + } + if (!trunc) { + flags |= TCL_READABLE; + if (z->isenc && (z->zipfile->pwbuf[0] == 0)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("decryption failed", -1)); + } + goto error; + } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file too large", -1)); + } + goto error; + } + } else { + flags = TCL_WRITABLE; + } + info = (ZipChannel *) Tcl_Alloc (sizeof (*info)); + info->zipfile = z->zipfile; + info->zipentry = z; + info->nread = 0; + if (wr) { + flags |= TCL_WRITABLE; + info->iswr = 1; + info->isdir = 0; + info->nmax = ZipFS.wrmax; + info->iscompr = 0; + info->isenc = 0; + info->ubuf = (unsigned char *) Tcl_Alloc(info->nmax); + memset(info->ubuf, 0, info->nmax); + if (trunc) { + info->nbyte = 0; + } else { + if (z->data != NULL) { + i = z->nbyte; + if (i > info->nmax) { + i = info->nmax; + } + memcpy(info->ubuf, z->data, i); + info->nbyte = i; + } else { + unsigned char *zbuf = z->zipfile->data + z->offset; + + if (z->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + zbuf += i; + } + if (z->cmeth == ZIP_COMPMETH_DEFLATED) { + z_stream stream; + int err; + unsigned char *cbuf = NULL; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (z->isenc) { + stream.avail_in -= 12; + cbuf = (unsigned char *) Tcl_Alloc(stream.avail_in); + for (i = 0; i < stream.avail_in; i++) { + ch = info->ubuf[i]; + cbuf[i] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = cbuf; + } else { + stream.next_in = zbuf; + } + stream.next_out = info->ubuf; + stream.avail_out = info->nmax; + if (inflateInit2(&stream, -15) != Z_OK) { + goto cerror0; + } + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || + ((err == Z_OK) && (stream.avail_in == 0))) { + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + goto wrapchan; + } +cerror0: + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("decompression error", -1)); + } + goto error; + } else if (z->isenc) { + for (i = 0; i < z->nbyte - 12; i++) { + ch = zbuf[i]; + info->ubuf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(info->ubuf, zbuf, z->nbyte); + } + memset(info->keys, 0, sizeof (info->keys)); + goto wrapchan; + } + } + } else if (z->data != NULL) { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = 0; + info->isdir = 0; + info->isenc = 0; + info->nbyte = z->nbyte; + info->nmax = 0; + info->ubuf = z->data; + } else { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED; + info->ubuf = z->zipfile->data + z->offset; + info->isdir = z->isdir; + info->isenc = z->isenc; + info->nbyte = z->nbyte; + info->nmax = 0; + if (info->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + info->ubuf += i; + } + if (info->iscompr) { + z_stream stream; + int err; + unsigned char *ubuf = NULL; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (info->isenc) { + stream.avail_in -= 12; + ubuf = (unsigned char *) Tcl_Alloc(stream.avail_in); + for (i = 0; i < stream.avail_in; i++) { + ch = info->ubuf[i]; + ubuf[i] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = ubuf; + } else { + stream.next_in = info->ubuf; + } + stream.next_out = info->ubuf = + (unsigned char *) Tcl_Alloc(info->nbyte); + stream.avail_out = info->nbyte; + if (inflateInit2(&stream, -15) != Z_OK) { + goto cerror; + } + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || + ((err == Z_OK) && (stream.avail_in == 0))) { + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + goto wrapchan; + } +cerror: + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("decompression error", -1)); + } + goto error; + } + } +wrapchan: + sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, count++); + z->zipfile->nopen++; + Unlock(); + return Tcl_CreateChannel(&ZipChannelType, cname, (ClientData) info, flags); + +error: + Unlock(); + return NULL; +} + +static int +ZipEntryStat(char *path, Tcl_StatBuf *buf) +{ + ZipEntry *z; + int ret = -1; + + ReadLock(); + z = ZipFSLookup(path); + if (z == NULL) { + goto done; + } + memset(buf, 0, sizeof (Tcl_StatBuf)); + if (z->isdir) { + buf->st_mode = S_IFDIR | 0555; + } else { + buf->st_mode = S_IFREG | 0555; + } + buf->st_size = z->nbyte; + buf->st_mtime = z->timestamp; + buf->st_ctime = z->timestamp; + buf->st_atime = z->timestamp; + ret = 0; +done: + Unlock(); + return ret; +} + +static int +ZipEntryAccess(char *path, int mode) +{ + ZipEntry *z; + + if (mode & 3) { + return -1; + } + ReadLock(); + z = ZipFSLookup(path); + Unlock(); + return (z != NULL) ? 0 : -1; +} + +static Tcl_Channel +Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode, int permissions) +{ + int len; + + return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), + mode, permissions); +} + +static int +Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) +{ + int len; + + return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); +} + +static int +Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) +{ + int len; + + return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); +} + +static Tcl_Obj * +Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) +{ + return Tcl_NewStringObj("/", -1); +} + +static int +Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, + Tcl_Obj *pathPtr, CONST char *pattern, + Tcl_GlobTypeData *types) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; + char *pat, *prefix, *path; +#if defined(_WIN32) || defined(_WIN64) + char drivePrefix[3]; +#endif + Tcl_DString ds, dsPref; + +#if defined(_WIN32) || defined(_WIN64) + if ((pattern != NULL) && (pattern[0] != '\0') && + (strchr(alpha, pattern[0]) != NULL) && (pattern[1] == ':')) { + pattern += 2; + } +#endif + if (types != NULL) { + dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; + } + Tcl_DStringInit(&ds); + Tcl_DStringInit(&dsPref); + prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); + Tcl_DStringAppend(&dsPref, prefix, prefixLen); + prefix = Tcl_DStringValue(&dsPref); + path = AbsolutePath(prefix, &ds); + len = Tcl_DStringLength(&ds); + if (strcmp(prefix, path) == 0) { + prefix = NULL; + } else { +#if defined(_WIN32) || defined(_WIN64) + if ((strchr(alpha, prefix[0]) != NULL) && (prefix[1] == ':')) { + if (strcmp(prefix + 2, path) == 0) { + strncpy(drivePrefix, prefix, 3); + drivePrefix[2] = '\0'; + prefix = drivePrefix; + } + } else { + strip = len + 1; + } +#else + strip = len + 1; +#endif + } + if (prefix != NULL) { +#if defined(_WIN32) || defined(_WIN64) + if (prefix == drivePrefix) { + Tcl_DStringSetLength(&dsPref, 0); + Tcl_DStringAppend(&dsPref, drivePrefix, -1); + prefixLen = Tcl_DStringLength(&dsPref); + } else { + Tcl_DStringAppend(&dsPref, "/", 1); + prefixLen++; + } + prefix = Tcl_DStringValue(&dsPref); +#else + Tcl_DStringAppend(&dsPref, "/", 1); + prefixLen++; + prefix = Tcl_DStringValue(&dsPref); +#endif + } + ReadLock(); + if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { + l = CountSlashes(path); + if (path[len - 1] == '/') { + len--; + } else { + l++; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + pattern = "*"; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); + + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + + while (z != NULL) { + int lenz = strlen(z->name); + + if ((lenz > len + 1) && + (strncmp(z->name, path, len) == 0) && + (z->name[len] == '/') && + (CountSlashes(z->name) == l) && + Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, lenz); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, lenz)); + } + } + z = z->tnext; + } + } else if ((zf->mntptlen > len + 1) && + (strncmp(zf->mntpt, path, len) == 0) && + (zf->mntpt[len] == '/') && + (CountSlashes(zf->mntpt) == l) && + Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } + } + hPtr = Tcl_NextHashEntry(&search); + } + goto end; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if ((dirOnly < 0) || + (!dirOnly && !z->isdir) || + (dirOnly && z->isdir)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } + goto end; + } + l = strlen(pattern); + pat = Tcl_Alloc(len + l + 2); + memcpy(pat, path, len); + while ((len > 1) && (pat[len - 1] == '/')) { + --len; + } + if ((len > 1) || (pat[0] != '/')) { + pat[len] = '/'; + ++len; + } + memcpy(pat + len, pattern, l + 1); + scnt = CountSlashes(pat); + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if ((dirOnly >= 0) && + ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) { + continue; + } + if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name + strip, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name + strip, -1)); + } + } + } + Tcl_Free(pat); +end: + Unlock(); + Tcl_DStringFree(&dsPref); + Tcl_DStringFree(&ds); + return TCL_OK; +} + +static int +Zip_FSNormalizePathProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, + int nextCheckpoint) +{ + char *path; + Tcl_DString ds; + int len; + + path = Tcl_GetStringFromObj(pathPtr, &len); + Tcl_DStringInit(&ds); + path = AbsolutePath(path, &ds); + nextCheckpoint = Tcl_DStringLength(&ds); + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + return nextCheckpoint; +} + +static int +Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + int ret = -1, len; + char *path; + Tcl_DString ds; + + path = Tcl_GetStringFromObj(pathPtr, &len); + Tcl_DStringInit(&ds); + path = AbsolutePath(path, &ds); + len = Tcl_DStringLength(&ds); +#if defined(_WIN32) || defined(_WIN64) + if (len && (strchr(alpha, path[0]) != NULL) && (path[1] == ':')) { + path += 2; + len -= 2; + } +#endif + ReadLock(); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ret = TCL_OK; + goto endloop; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + + while (z != NULL) { + int lenz = strlen(z->name); + + if ((len >= lenz) && + (strncmp(path, z->name, lenz) == 0)) { + ret = TCL_OK; + goto endloop; + } + z = z->tnext; + } + } else if ((len >= zf->mntptlen) && + (strncmp(path, zf->mntpt, zf->mntptlen) == 0)) { + ret = TCL_OK; + goto endloop; + } + hPtr = Tcl_NextHashEntry(&search); + } +endloop: + Unlock(); + Tcl_DStringFree(&ds); + return ret; +} + +static Tcl_Obj * +Zip_FSListVolumesProc(void) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + Tcl_Obj *vols = Tcl_NewObj(), *vol; + + ReadLock(); + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + vol = Tcl_NewStringObj(zf->mntpt, zf->mntptlen); + Tcl_ListObjAppendList(NULL, vols, vol); + Tcl_DecrRefCount(vol); + hPtr = Tcl_NextHashEntry(&search); + } + Unlock(); + return vols; +} + +static int +Zip_FSChdirProc(Tcl_Obj *pathPtr) +{ + int len; + char *path; + Tcl_DString ds; + ZipEntry *z; + int ret = TCL_OK; + + path = Tcl_GetStringFromObj(pathPtr, &len); + Tcl_DStringInit(&ds); + path = AbsolutePath(path, &ds); + ReadLock(); + z = ZipFSLookup(path); + if ((z == NULL) || !z->isdir) { + Tcl_SetErrno(ENOENT); + ret = -1; + } + Unlock(); + Tcl_DStringFree(&ds); + return ret; +} + +static CONST char *CONST86 * +Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) +{ + static CONST char *attrs[] = { + "-uncompsize", + "-compsize", + "-offset", + "-mount", + "-archive", + "-permissions", + NULL, + }; + + return attrs; +} + +static int +Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef) +{ + int len, ret = TCL_OK; + char *path; + ZipEntry *z; + + path = Tcl_GetStringFromObj(pathPtr, &len); + ReadLock(); + z = ZipFSLookup(path); + if (z == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + } + ret = TCL_ERROR; + goto done; + } + switch (index) { + case 0: + *objPtrRef = Tcl_NewIntObj(z->nbyte); + goto done; + case 1: + *objPtrRef= Tcl_NewIntObj(z->nbytecompr); + goto done; + case 2: + *objPtrRef= Tcl_NewLongObj(z->offset); + goto done; + case 3: + *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1); + goto done; + case 4: + *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); + goto done; + case 5: + *objPtrRef= Tcl_NewStringObj("0555", -1); + goto done; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown attribute", -1)); + } + ret = TCL_ERROR; +done: + Unlock(); + return ret; +} + +static int +Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj *objPtr) +{ + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); + } + return TCL_ERROR; +} + + +static Tcl_Obj * +Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) +{ + return Tcl_NewStringObj("zip", -1); +} + +#ifndef ANDROID +static int +Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, + Tcl_FSUnloadFileProc **unloadProcPtr, int flags) +{ + Tcl_FSLoadFileProc2 *loadFileProc; + Tcl_Obj *altPath = NULL; + int ret = -1; + + if (Tcl_FSAccess(path, R_OK) == 0) { + /* + * EXDEV should trigger loading by copying to temp store. + */ + Tcl_SetErrno(EXDEV); + return ret; + } else { + Tcl_Obj *objs[2] = { NULL, NULL }; + + objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); + if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { + /* + * Shared object is not in ZIP but its path prefix is, + * thus try to load from directory where the executable + * came from. + */ + TclDecrRefCount(objs[1]); + objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); + objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), + TCL_PATH_DIRNAME); + if (objs[0] != NULL) { + altPath = TclJoinPath(2, objs); + if (altPath != NULL) { + Tcl_IncrRefCount(altPath); + if (Tcl_FSAccess(altPath, R_OK) == 0) { + path = altPath; + } + } + } + } + if (objs[0] != NULL) { + Tcl_DecrRefCount(objs[0]); + } + if (objs[1] != NULL) { + Tcl_DecrRefCount(objs[1]); + } + } + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + if (loadFileProc != NULL) { + ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + } else { + Tcl_SetErrno(ENOENT); + } + if (altPath != NULL) { + Tcl_DecrRefCount(altPath); + } + return ret; +} +#endif + +Tcl_Filesystem zipfsFilesystem = { + "zipfs", + sizeof (Tcl_Filesystem), + TCL_FILESYSTEM_VERSION_2, + Zip_FSPathInFilesystemProc, + NULL, /* dupInternalRepProc */ + NULL, /* freeInternalRepProc */ + NULL, /* internalToNormalizedProc */ + NULL, /* createInternalRepProc */ + Zip_FSNormalizePathProc, + Zip_FSFilesystemPathTypeProc, + Zip_FSFilesystemSeparatorProc, + Zip_FSStatProc, + Zip_FSAccessProc, + Zip_FSOpenFileChannelProc, + Zip_FSMatchInDirectoryProc, + NULL, /* utimeProc */ + NULL, /* linkProc */ + Zip_FSListVolumesProc, + Zip_FSFileAttrStringsProc, + Zip_FSFileAttrsGetProc, + Zip_FSFileAttrsSetProc, + NULL, /* createDirectoryProc */ + NULL, /* removeDirectoryProc */ + NULL, /* deleteFileProc */ + NULL, /* copyFileProc */ + NULL, /* renameFileProc */ + NULL, /* copyDirectoryProc */ + NULL, /* lstatProc */ +#ifdef ANDROID + NULL, /* loadFileProc */ +#else + (Tcl_FSLoadFileProc *) Zip_FSLoadFile, +#endif + NULL, /* getCwdProc */ + Zip_FSChdirProc, +}; + +#endif /* HAVE_ZLIB */ + +static int +Zipfs_doInit(Tcl_Interp *interp, int safe) +{ +#ifdef HAVE_ZLIB + static CONST char findproc[] = + "proc ::zipfs::find d {\n" + " set ret {}\n" + " foreach f [glob -directory $d -tails -nocomplain * .*] {\n" + " if {$f eq \".\" || $f eq \"..\"} {\n" + " continue\n" + " }\n" + " set f [file join $d $f]\n" + " lappend ret $f\n" + " foreach f [::zipfs::find $f] {\n" + " lappend ret $f\n" + " }\n" + " }\n" + " return [lsort $ret]\n" + "}\n"; + +#ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.0", 0) == NULL) { + return TCL_ERROR; + } +#endif + /* one-time initialization */ + WriteLock(); + if (!ZipFS.initialized) { + static const Tcl_Time t = { 0, 0 }; + + /* inflate condition */ + Tcl_MutexLock(&ZipFSMutex); + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); + Tcl_MutexUnlock(&ZipFSMutex); +#ifdef ANDROID + /* force loadFileProc to native one */ + zipfsFilesystem.loadFileProc = tclNativeFilesystem.loadFileProc; +#endif + Tcl_FSRegister(NULL, &zipfsFilesystem); + Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); + ZipFS.initialized = 1; +#if defined(ZIPFS_IN_TCL) || defined(ZIPFS_IN_TK) + Tcl_StaticPackage(interp, "zipfs", Zipfs_Init, Zipfs_SafeInit); +#endif + } + Unlock(); +#if !defined(ZIPFS_IN_TCL) && !defined(ZIPFS_IN_TK) + Tcl_PkgProvide(interp, "zipfs", "1.0"); +#endif + if (!safe) { + Tcl_CreateCommand(interp, "::zipfs::mount", ZipFSMountCmd, 0, 0); + Tcl_CreateCommand(interp, "::zipfs::unmount", ZipFSUnmountCmd, 0, 0); + Tcl_CreateCommand(interp, "::zipfs::mkkey", ZipFSMkKeyCmd, 0, 0); + Tcl_CreateCommand(interp, "::zipfs::mkimg", ZipFSMkImgCmd, 0, 0); + Tcl_CreateCommand(interp, "::zipfs::mkzip", ZipFSMkZipCmd, 0, 0); + Tcl_GlobalEval(interp, findproc); + } + Tcl_CreateObjCommand(interp, "::zipfs::exists", ZipFSExistsObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::info", ZipFSInfoObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::list", ZipFSListObjCmd, 0, 0); + if (!safe) { + Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, + TCL_LINK_INT); + } + return TCL_OK; +#else + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("no zlib available", -1)); + } + return TCL_ERROR; +#endif +} + +int +Zipfs_Init(Tcl_Interp *interp) +{ + return Zipfs_doInit(interp, 0); +} + +int +Zipfs_SafeInit(Tcl_Interp *interp) +{ + return Zipfs_doInit(interp, 1); +} + +#ifndef HAVE_ZLIB + +int +Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, + CONST char *passwd) +{ + return Zipfs_doInit(interp, 1); +} + +int +Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname) +{ + return Zipfs_doInit(interp, 1); +} + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/zipfs.h b/generic/zipfs.h new file mode 100644 index 0000000..587fed8 --- /dev/null +++ b/generic/zipfs.h @@ -0,0 +1,43 @@ +#ifndef _ZIPFS_H +#define _ZIPFS_H + +#ifdef ZIPFS_IN_TK +#include "tkInt.h" +#define Zipfs_Mount Tkzipfs_Mount +#define Zipfs_Unmount Tkzipfs_Unmount +#define Zipfs_Init Tkzipfs_Init +#define Zipfs_SafeInit Tkzipfs_SafeInit +#endif + +#ifdef ZIPFS_IN_TCL +#include "tclPort.h" +#define Zipfs_Mount Tclzipfs_Mount +#define Zipfs_Unmount Tclzipfs_Unmount +#define Zipfs_Init Tclzipfs_Init +#define Zipfs_SafeInit Tclzipfs_SafeInit +#endif + +#ifndef EXTERN +#define EXTERN extern +#endif + +#ifdef BUILD_tcl +#undef EXTERN +#define EXTERN +#endif + +EXTERN int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, + CONST char *mntpt, CONST char *passwd); +EXTERN int Zipfs_Unmount(Tcl_Interp *interp, CONST char *mountname); +EXTERN int Zipfs_Init(Tcl_Interp *interp); +EXTERN int Zipfs_SafeInit(Tcl_Interp *interp); + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/pkgs/Android.mk b/pkgs/Android.mk new file mode 100644 index 0000000..5053e7d --- /dev/null +++ b/pkgs/Android.mk @@ -0,0 +1 @@ +include $(call all-subdir-makefiles) diff --git a/tcl-config.mk b/tcl-config.mk new file mode 100644 index 0000000..ae14b6b --- /dev/null +++ b/tcl-config.mk @@ -0,0 +1,60 @@ +tcl_includes := $(tcl_path)/generic $(tcl_path)/unix + +tcl_cflags := \ + -DHAVE_SYS_SELECT_H=1 \ + -DHAVE_LIMITS_H=1 \ + -DHAVE_UNISTD_H=1 \ + -DHAVE_SYS_PARAM_H=1 \ + -D_LARGEFILE64_SOURCE=1 \ + -DTCL_WIDE_INT_TYPE="long long" \ + -DTCL_SHLIB_EXT="\".so\"" \ + -DHAVE_CAST_TO_UNION=1 \ + -DHAVE_GETCWD=1 \ + -DHAVE_OPENDIR=1 \ + -DHAVE_MKSTEMP=1 \ + -DHAVE_MKSTEMPS=1 \ + -DHAVE_STRSTR=1 \ + -DHAVE_STRTOL=1 \ + -DHAVE_STRTOLL=1 \ + -DHAVE_STRTOULL=1 \ + -DHAVE_TMPNAM=1 \ + -DHAVE_WAITPID=1 \ + -DHAVE_STRUCT_ADDRINFO=1 \ + -DHAVE_STRUCT_IN6_ADDR=1 \ + -DHAVE_STRUCT_SOCKADDR_IN6=1 \ + -DHAVE_STRUCT_SOCKADDR_STORAGE=1 \ + -DUSE_TERMIOS=1 \ + -DHAVE_MKTIME=1 \ + -DUSE_INTERP_ERRORLINE=1 \ + -DHAVE_SYS_TIME_H=1 \ + -DTIME_WITH_SYS_TIME=1 \ + -DHAVE_TM_ZONE=1 \ + -DHAVE_GMTIME_R=1 \ + -DHAVE_LOCALTIME_R=1 \ + -DHAVE_TM_GMTOFF=1 \ + -DHAVE_TIMEZONE_VAR=1 \ + -DHAVE_ST_BLKSIZE=1 \ + -DSTDC_HEADERS=1 \ + -DHAVE_INTPTR_T=1 \ + -DHAVE_UINTPTR_T=1 \ + -DHAVE_SIGNED_CHAR=1 \ + -DHAVE_SYS_IOCTL_H=1 \ + -DHAVE_MEMCPY=1 \ + -DHAVE_MEMMOVE=1 \ + -DVOID=void \ + -DNO_UNION_WAIT=1 \ + -DHAVE_ZLIB=1 \ + -DMP_PREC=4 \ + -DTCL_TOMMATH=1 \ + -D_REENTRANT=1 \ + -D_THREADSAFE=1 \ + -DTCL_THREADS=1 \ + -DTCL_PTHREAD_ATFORK=1 \ + -DUSE_THREAD_ALLOC=1 \ + -DTCL_CFGVAL_ENCODING="\"utf-8\"" \ + -DTCL_UNLOAD_DLLS=1 \ + -DTCL_CFG_OPTIMIZED=1 \ + -DZIPFS_IN_TCL=1 \ + -DTCL_PACKAGE_PATH="\"/assets\"" \ + -DTCL_LIBRARY="\"/assets/tcl8.6\"" + diff --git a/unix/Makefile.in b/unix/Makefile.in index 18c90fa..eb1ba3c 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -308,7 +308,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ - tclTomMathInterface.o + tclTomMathInterface.o zipfs.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o @@ -382,7 +382,8 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ - $(GENERIC_DIR)/tclRegexp.h + $(GENERIC_DIR)/tclRegexp.h \ + $(GENERIC_DIR)/zipfs.h GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ @@ -463,7 +464,8 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclUtil.c \ $(GENERIC_DIR)/tclVar.c \ $(GENERIC_DIR)/tclAssembly.c \ - $(GENERIC_DIR)/tclZlib.c + $(GENERIC_DIR)/tclZlib.c \ + $(GENERIC_DIR)/zipfs.c OO_SRCS = \ $(GENERIC_DIR)/tclOO.c \ @@ -1321,6 +1323,9 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c +zipfs.o: $(GENERIC_DIR)/zipfs.c + $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/zipfs.c + tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index dc711f8..3376d94 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -97,7 +97,11 @@ TclpDlopen( } else { dlopenflags |= RTLD_NOW; } - handle = dlopen(native, dlopenflags); + if (native == NULL) { + handle = NULL; + } else { + handle = dlopen(native, dlopenflags); + } if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever @@ -115,7 +119,41 @@ TclpDlopen( handle = dlopen(native, dlopenflags); Tcl_DStringFree(&ds); } +#ifdef ANDROID + /* + * If not an absolute or relative path, try to load + * from $INTERNAL_STORAGE/../lib (the place where the + * system has installed bundled .so files from the .APK) + */ + if (handle == NULL) { + native = Tcl_GetString(pathPtr); + if ((native != NULL) && (strchr(native, '/') == NULL)) { + char *storage = getenv("INTERNAL_STORAGE"); + Tcl_DString ds2; + if ((storage != NULL) && (storage[0] != '\0')) { + Tcl_DStringInit(&ds2); + Tcl_DStringAppend(&ds2, storage, -1); + Tcl_DStringAppend(&ds2, "/../lib/", -1); + Tcl_DStringAppend(&ds2, native, -1); + handle = dlopen(Tcl_DStringValue(&ds2), RTLD_NOW | RTLD_GLOBAL); + Tcl_DStringFree(&ds2); + } + if (handle == NULL) { + storage = getenv("TK_TCL_WISH_LD_LIBS"); + if ((storage != NULL) && (storage[0] != '\0')) { + Tcl_DStringInit(&ds2); + Tcl_DStringAppend(&ds2, storage, -1); + Tcl_DStringAppend(&ds2, "/", -1); + Tcl_DStringAppend(&ds2, native, -1); + handle = + dlopen(Tcl_DStringValue(&ds2), RTLD_NOW | RTLD_GLOBAL); + Tcl_DStringFree(&ds2); + } + } + } + } + #endif if (handle == NULL) { /* * Write the string to a variable first to work around a compiler bug diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 3b1b6ca..0193dae 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -465,6 +465,9 @@ DoCopyFile( /* Used to determine filetype. */ { Tcl_StatBuf dstStatBuf; +#ifdef ANDROID + int ret; +#endif if (S_ISDIR(statBufPtr->st_mode)) { errno = EISDIR; @@ -520,7 +523,15 @@ DoCopyFile( if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ return TCL_ERROR; } +#ifdef ANDROID + ret = CopyFileAtts(src, dst, statBufPtr); + if (ret != TCL_OK && errno == EPERM) { + ret = TCL_OK; + } + return ret; +#else return CopyFileAtts(src, dst, statBufPtr); +#endif default: return TclUnixCopyFile(src, dst, statBufPtr, 0); } @@ -629,6 +640,11 @@ TclUnixCopyFile( return TCL_ERROR; } if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) { +#ifdef ANDROID + if (errno == EPERM) { + return TCL_OK; + } +#endif /* * The copy succeeded, but setting the permissions failed, so be in a * consistent state, we remove the file that was created by the copy. @@ -1203,6 +1219,11 @@ TraversalCopy( Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { return TCL_OK; } +#ifdef ANDROID + if (errno == EPERM) { + return TCL_OK; + } +#endif break; } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 520c8e5..927b1a6 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -541,6 +541,11 @@ TclpInitLibraryPath( */ str = defaultLibraryDir; +#ifdef ZIPFS_IN_TCL + if (Tclzipfs_Mount(NULL, NULL, NULL, NULL) == TCL_OK) { + str = ""; + } +#endif } if (str[0] != '\0') { objPtr = Tcl_NewStringObj(str, -1); diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 123abec..6558332 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -447,9 +447,11 @@ extern int gettimeofday(struct timeval *tp, *--------------------------------------------------------------------------- */ +#ifndef ANDROID #ifndef L_tmpnam # define L_tmpnam 100 #endif +#endif /* *--------------------------------------------------------------------------- diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 315bcf9..19cafe6 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -529,7 +529,10 @@ static void CleanupMemory( ClientData ignored) { - ckfree(lastTZ); + if (lastTZ != NULL) { + ckfree(lastTZ); + lastTZ = NULL; + } } /* diff --git a/win/Makefile.in b/win/Makefile.in index 168da2e..13a3e0c 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -296,7 +296,8 @@ GENERIC_OBJS = \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ - tclZlib.$(OBJEXT) + tclZlib.$(OBJEXT) \ + zipfs.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -741,7 +742,7 @@ clean: cleanhelp clean-packages distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - tcl.hpj config.status.lineno + tcl.hpj config.status.lineno tclsh.exe.manifest # # Bundled package targets -- cgit v0.12 From d68207f7ca77f987f9c8d2c8400c089b2c976604 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 15 Jul 2015 09:31:11 +0000 Subject: Remove unused local variables. Now unix/tclUnixTime.c is idential in "androwish" compared to "novem". (Yes, those functions are planned to be removed in Tcl 9.0!) --- unix/tclUnixTime.c | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 240bc91..470b122 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -17,25 +17,6 @@ #endif /* - * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread - * safety, this structure must be in thread-specific data. The 'tmKey' - * variable is the key to this buffer. - */ - -static Tcl_ThreadDataKey tmKey; -typedef struct ThreadSpecificData { - struct tm gmtime_buf; - struct tm localtime_buf; -} ThreadSpecificData; - -/* - * If we fall back on the thread-unsafe versions of gmtime and localtime, use - * this mutex to try to protect them. - */ - -TCL_DECLARE_MUTEX(tmMutex) - -/* * Static functions declared in this file. */ -- cgit v0.12 From 6e0d4b67612beec4f87f531f87878314a26db669 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Aug 2015 07:58:42 +0000 Subject: Remove unused internal stub entries as well. --- generic/tclInt.decls | 18 ++-- generic/tclIntPlatDecls.h | 32 +++---- win/tclWinTime.c | 222 ---------------------------------------------- 3 files changed, 23 insertions(+), 249 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 27245f1..9f990f7 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -534,7 +534,7 @@ declare 132 { int TclpHasSockets(Tcl_Interp *interp) } # Removed in androwish -#declare 133 { +# declare 133 { # struct tm *TclpGetDate(const time_t *time, int useGMT) #} # Removed in 8.5 @@ -750,6 +750,8 @@ declare 179 { # const char *file, int line) #} +# TclpGmtime and TclpLocaltime promoted to the generic interface from unix + # Removed in androwish #declare 182 { # struct tm *TclpLocaltime(const time_t *clock) @@ -1218,12 +1220,14 @@ declare 10 unix { } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs -declare 11 unix { - struct tm *TclpLocaltime_unix(const time_t *clock) -} -declare 12 unix { - struct tm *TclpGmtime_unix(const time_t *clock) -} +# Removed in androwish +#declare 11 unix { +# struct tm *TclpLocaltime_unix(const time_t *clock) +#} +# Removed in androwish +#declare 12 unix { +# struct tm *TclpGmtime_unix(const time_t *clock) +#} declare 13 unix { char *TclpInetNtoa(struct in_addr addr) } diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index ac06787..b7a44d8 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -73,10 +73,8 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ /* 13 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ @@ -207,10 +205,8 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ /* 13 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ @@ -270,8 +266,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ 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 */ + void (*reserved11)(void); + void (*reserved12)(void); char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ void (*reserved15)(void); @@ -336,8 +332,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ 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 */ + void (*reserved11)(void); + void (*reserved12)(void); 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 */ @@ -393,10 +389,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ @@ -504,10 +498,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 7045c72..97e1f41 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -113,7 +113,6 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ -static struct tm * ComputeGMT(const time_t *tp); static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -489,227 +488,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGetDate( - const time_t *t, - int useGMT) -{ - struct tm *tmPtr; - time_t time; - - if (!useGMT) { - tzset(); - - /* - * If we are in the valid range, let the C run-time library handle it. - * Otherwise we need to fake it. Note that this algorithm ignores - * daylight savings time before the epoch. - */ - - /* - * Hm, Borland's localtime manages to return NULL under certain - * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, - * since 'localtime' isn't supposed to do this, possibly leading to - * crashes. - * - * Patch: We only call this function if we are at least one day into - * the epoch, else we handle it ourselves (like we do for times < 0). - * H. Giese, June 2003 - */ - -#ifdef __BORLANDC__ -#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY -#else -#define LOCALTIME_VALIDITY_BOUNDARY 0 -#endif - - if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(t); - } - - time = *t - timezone; - - /* - * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust the - * result at the end. - */ - - if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(t); - - tzset(); - - /* - * Add the bias directly to the tm structure to avoid overflow. - * Propagate seconds overflow into minutes, hours and days. - */ - - time = tmPtr->tm_sec - timezone; - tmPtr->tm_sec = (int)(time % 60); - if (tmPtr->tm_sec < 0) { - tmPtr->tm_sec += 60; - time -= 60; - } - - time = tmPtr->tm_min + time/60; - tmPtr->tm_min = (int)(time % 60); - if (tmPtr->tm_min < 0) { - tmPtr->tm_min += 60; - time -= 60; - } - - time = tmPtr->tm_hour + time/60; - tmPtr->tm_hour = (int)(time % 24); - if (tmPtr->tm_hour < 0) { - tmPtr->tm_hour += 24; - time -= 24; - } - - time /= 24; - tmPtr->tm_mday += (int)time; - tmPtr->tm_yday += (int)time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; - } - } else { - tmPtr = ComputeGMT(t); - } - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * - * ComputeGMT -- - * - * This function computes GMT given the number of seconds since the epoch - * (midnight Jan 1 1970). - * - * Results: - * Returns a (per thread) statically allocated struct tm. - * - * Side effects: - * Updates the values of the static struct tm. - * - *---------------------------------------------------------------------- - */ - -static struct tm * -ComputeGMT( - const time_t *tp) -{ - struct tm *tmPtr; - long tmp, rem; - int isLeap; - const int *days; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tmPtr = &tsdPtr->tm; - - /* - * Compute the 4 year span containing the specified time. - */ - - tmp = (long)(*tp / SECSPER4YEAR); - rem = (long)(*tp % SECSPER4YEAR); - - /* - * Correct for weird mod semantics so the remainder is always positive. - */ - - if (rem < 0) { - tmp--; - rem += SECSPER4YEAR; - } - - /* - * Compute the year after 1900 by taking the 4 year span and adjusting for - * the remainder. This works because 2000 is a leap year, and 1900/2100 - * are out of the range. - */ - - tmp = (tmp * 4) + 70; - isLeap = 0; - if (rem >= SECSPERYEAR) { /* 1971, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR) { /* 1972, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ - tmp++; - rem -= SECSPERYEAR + SECSPERDAY; - } else { - isLeap = 1; - } - } - } - tmPtr->tm_year = tmp; - - /* - * Compute the day of year and leave the seconds in the current day in the - * remainder. - */ - - tmPtr->tm_yday = rem / SECSPERDAY; - rem %= SECSPERDAY; - - /* - * Compute the time of day. - */ - - tmPtr->tm_hour = rem / 3600; - rem %= 3600; - tmPtr->tm_min = rem / 60; - tmPtr->tm_sec = rem % 60; - - /* - * Compute the month and day of month. - */ - - days = (isLeap) ? leapDays : normalDays; - for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { - /* empty body */ - } - tmPtr->tm_mon = --tmp; - tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; - - /* - * Compute day of week. Epoch started on a Thursday. - */ - - tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; - if ((*tp % SECSPERDAY) < 0) { - tmPtr->tm_wday--; - } - tmPtr->tm_wday %= 7; - if (tmPtr->tm_wday < 0) { - tmPtr->tm_wday += 7; - } - - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from -- cgit v0.12 From ecc90e3787b23274b9f03670ba869c8f7da8213a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Aug 2015 08:01:23 +0000 Subject: one more.... --- generic/tclStubInit.c | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index edeb42a..8359fa6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -294,10 +294,6 @@ static int formatInt(char *buffer, int n){ #define TclFormatInt (int(*)(char *, long))formatInt #endif - -#else /* UNIX and MAC */ -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime #endif /* @@ -586,8 +582,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ + 0, /* 11 */ + 0, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ 0, /* 15 */ @@ -652,8 +648,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ + 0, /* 11 */ + 0, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ -- cgit v0.12 From dbe627594edb4a5b12aa260f2c02d9c2b2b48c3f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 31 Aug 2015 17:30:01 +0000 Subject: Dependancies from androwish upstream --- Android.mk | 2 ++ tcl-config.mk | 72 +++++++++++++++++++++++++++++---------------------------- win/Makefile.in | 5 ++-- 3 files changed, 42 insertions(+), 37 deletions(-) diff --git a/Android.mk b/Android.mk index 9d8ce27..13e55d9 100644 --- a/Android.mk +++ b/Android.mk @@ -12,6 +12,8 @@ tcl_path := $(LOCAL_PATH) include $(tcl_path)/tcl-config.mk +LOCAL_ADDITIONAL_DEPENDENCIES += $(tcl_path)/tcl-config.mk + LOCAL_MODULE := tcl LOCAL_ARM_MODE := arm diff --git a/tcl-config.mk b/tcl-config.mk index ae14b6b..e072516 100644 --- a/tcl-config.mk +++ b/tcl-config.mk @@ -1,60 +1,62 @@ tcl_includes := $(tcl_path)/generic $(tcl_path)/unix tcl_cflags := \ - -DHAVE_SYS_SELECT_H=1 \ - -DHAVE_LIMITS_H=1 \ - -DHAVE_UNISTD_H=1 \ - -DHAVE_SYS_PARAM_H=1 \ - -D_LARGEFILE64_SOURCE=1 \ - -DTCL_WIDE_INT_TYPE="long long" \ - -DTCL_SHLIB_EXT="\".so\"" \ - -DHAVE_CAST_TO_UNION=1 \ - -DHAVE_GETCWD=1 \ - -DHAVE_OPENDIR=1 \ + -DHAVE_SYS_SELECT_H=1 \ + -DHAVE_LIMITS_H=1 \ + -DHAVE_UNISTD_H=1 \ + -DHAVE_SYS_PARAM_H=1 \ + -D_LARGEFILE64_SOURCE=1 \ + -DTCL_WIDE_INT_TYPE="long long" \ + -DTCL_SHLIB_EXT="\".so\"" \ + -DHAVE_CAST_TO_UNION=1 \ + -DHAVE_GETCWD=1 \ + -DHAVE_OPENDIR=1 \ -DHAVE_MKSTEMP=1 \ -DHAVE_MKSTEMPS=1 \ - -DHAVE_STRSTR=1 \ - -DHAVE_STRTOL=1 \ - -DHAVE_STRTOLL=1 \ - -DHAVE_STRTOULL=1 \ - -DHAVE_TMPNAM=1 \ - -DHAVE_WAITPID=1 \ + -DHAVE_STRSTR=1 \ + -DHAVE_STRTOL=1 \ + -DHAVE_STRTOLL=1 \ + -DHAVE_STRTOULL=1 \ + -DHAVE_TMPNAM=1 \ + -DHAVE_WAITPID=1 \ -DHAVE_STRUCT_ADDRINFO=1 \ -DHAVE_STRUCT_IN6_ADDR=1 \ -DHAVE_STRUCT_SOCKADDR_IN6=1 \ -DHAVE_STRUCT_SOCKADDR_STORAGE=1 \ - -DUSE_TERMIOS=1 \ - -DHAVE_MKTIME=1 \ - -DUSE_INTERP_ERRORLINE=1 \ - -DHAVE_SYS_TIME_H=1 \ - -DTIME_WITH_SYS_TIME=1 \ - -DHAVE_TM_ZONE=1 \ - -DHAVE_GMTIME_R=1 \ - -DHAVE_LOCALTIME_R=1 \ - -DHAVE_TM_GMTOFF=1 \ - -DHAVE_TIMEZONE_VAR=1 \ - -DHAVE_ST_BLKSIZE=1 \ - -DSTDC_HEADERS=1 \ + -DHAVE_GETHOSTBYNAME_R=1 \ + -DUSE_TERMIOS=1 \ + -DHAVE_MKTIME=1 \ + -DUSE_INTERP_ERRORLINE=1 \ + -DHAVE_SYS_TIME_H=1 \ + -DTIME_WITH_SYS_TIME=1 \ + -DHAVE_TM_ZONE=1 \ + -DHAVE_GMTIME_R=1 \ + -DHAVE_LOCALTIME_R=1 \ + -DHAVE_TM_GMTOFF=1 \ + -DHAVE_TIMEZONE_VAR=1 \ + -DHAVE_ST_BLKSIZE=1 \ + -DSTDC_HEADERS=1 \ -DHAVE_INTPTR_T=1 \ -DHAVE_UINTPTR_T=1 \ -DHAVE_SIGNED_CHAR=1 \ - -DHAVE_SYS_IOCTL_H=1 \ - -DHAVE_MEMCPY=1 \ - -DHAVE_MEMMOVE=1 \ - -DVOID=void \ - -DNO_UNION_WAIT=1 \ - -DHAVE_ZLIB=1 \ + -DHAVE_SYS_IOCTL_H=1 \ + -DHAVE_MEMCPY=1 \ + -DHAVE_MEMMOVE=1 \ + -DVOID=void \ + -DNO_UNION_WAIT=1 \ + -DHAVE_ZLIB=1 \ -DMP_PREC=4 \ -DTCL_TOMMATH=1 \ -D_REENTRANT=1 \ -D_THREADSAFE=1 \ + -DTCL_UTF_MAX=6 \ -DTCL_THREADS=1 \ -DTCL_PTHREAD_ATFORK=1 \ -DUSE_THREAD_ALLOC=1 \ -DTCL_CFGVAL_ENCODING="\"utf-8\"" \ -DTCL_UNLOAD_DLLS=1 \ -DTCL_CFG_OPTIMIZED=1 \ - -DZIPFS_IN_TCL=1 \ + -DZIPFS_IN_TCL=1 \ -DTCL_PACKAGE_PATH="\"/assets\"" \ -DTCL_LIBRARY="\"/assets/tcl8.6\"" diff --git a/win/Makefile.in b/win/Makefile.in index b92a062..b8a130c 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -296,7 +296,8 @@ GENERIC_OBJS = \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ - tclZlib.$(OBJEXT) + tclZlib.$(OBJEXT) \ + zipfs.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -741,7 +742,7 @@ clean: cleanhelp clean-packages distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - tcl.hpj config.status.lineno + tcl.hpj config.status.lineno tclsh.exe.manifest # # Bundled package targets -- cgit v0.12 From 842b15b839b378f34b23291dda5ba279cffe1607 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Sep 2015 11:47:04 +0000 Subject: fixed bug in zipfs error handling (backported from androwish) --- generic/zipfs.c | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index ec58d9f..c150da0 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -819,10 +819,13 @@ Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, if (!isNew) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (interp != NULL) { - Tcl_AppendResult(interp, "already mounted at ", zf->mntpt, - (char *) NULL); + Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? + zf->mntpt : "/", "\"", (char *) NULL); } - goto error; + Unlock(); + Tcl_DStringFree(&ds); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; } if (strcmp(mntpt, "/") == 0) { mntpt = ""; @@ -915,6 +918,7 @@ Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, goto nextent; } if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { + /* regular files skipped when mounting on root */ goto nextent; } Tcl_DStringSetLength(&fpBuf, 0); @@ -947,7 +951,7 @@ Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, z->data = NULL; hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); if (!isNew) { - /* skip it */ + /* should not happen but skip it anyway */ Tcl_Free((char *) z); } else { Tcl_SetHashValue(hPtr, (ClientData) z); @@ -988,7 +992,7 @@ Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, zd->data = NULL; hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); if (!isNew) { - /* should never happen but skip it */ + /* should not happen but skip it anyway */ Tcl_Free((char *) zd); } else { Tcl_SetHashValue(hPtr, (ClientData) zd); @@ -1012,13 +1016,6 @@ nextent: Unlock(); Tcl_FSMountsChanged(NULL); return TCL_OK; - -error: - Tcl_DStringFree(&ds); - Unlock(); - ZipFSCloseArchive(interp, zf); - Tcl_Free((char *) zf); - return TCL_ERROR; } int @@ -1039,7 +1036,7 @@ Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname) } hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, realname); if (hPtr == NULL) { - /* does not report error */ + /* don't report error */ goto done; } zf = (ZipFile *) Tcl_GetHashValue(hPtr); @@ -1707,7 +1704,8 @@ ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "unknown option: ", what, (char *) NULL); + Tcl_AppendResult(interp, "unknown option \"", what, + "\"", (char *) NULL); return TCL_ERROR; } } else if (objc == 2) { -- cgit v0.12 From 9dd94f739633837da43ddf3f0af5f99a36c2e803 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 Sep 2015 10:58:30 +0000 Subject: Don't use mutex retry mechanism on Android. (problems ???) --- unix/tclUnixThrd.c | 51 +++++---------------------------------------------- win/tclWinThrd.c | 37 +++++-------------------------------- 2 files changed, 10 insertions(+), 78 deletions(-) diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index ae81c5f..0e8070d 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -22,19 +22,6 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * This is the number of milliseconds to wait between internal retries in - * the Tcl_MutexLock function. This value must be greater than zero and - * should be a suitable value for the given platform. - * - * TODO: This may need to be dynamically determined, based on the relative - * performance of the running process. - */ - -#ifndef TCL_MUTEX_LOCK_SLEEP_TIME -# define TCL_MUTEX_LOCK_SLEEP_TIME (25) -#endif - -/* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. @@ -58,13 +45,6 @@ static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER; static pthread_mutex_t *allocLockPtr = &allocLock; /* - * The mutexLock serializes Tcl_MutexLock. This is necessary to prevent - * races when finalizing a mutex that some other thread may want to lock. - */ - -static pthread_mutex_t mutexLock = PTHREAD_MUTEX_INITIALIZER; - -/* * These are for the critical sections inside this file. */ @@ -380,7 +360,6 @@ TclpMasterUnlock(void) pthread_mutex_unlock(&masterLock); #endif } - /* *---------------------------------------------------------------------- @@ -457,32 +436,12 @@ retry: } MASTER_UNLOCK; } - while (1) { - pthread_mutex_lock(&mutexLock); - pmutexPtr = *((pthread_mutex_t **)mutexPtr); - if (pmutexPtr == NULL) { - pthread_mutex_unlock(&mutexLock); - goto retry; - } - if (pthread_mutex_trylock(pmutexPtr) == 0) { - pthread_mutex_unlock(&mutexLock); - return; - } - pthread_mutex_unlock(&mutexLock); - /* - * BUGBUG: All core and Thread package tests pass when usleep() - * is used; however, the Thread package tests hang at - * various places when Tcl_Sleep() is used, typically - * while running test "thread-17.8", "thread-17.9", or - * "thread-17.11a". Really, what we want here is just - * to yield to other threads for a while. - */ -#ifdef HAVE_USLEEP - usleep(TCL_MUTEX_LOCK_SLEEP_TIME * 1000); -#else - Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME); -#endif + + pmutexPtr = *((pthread_mutex_t **)mutexPtr); + if (pmutexPtr == NULL) { + goto retry; } + pthread_mutex_lock(pmutexPtr); } /* diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index ae7ce80..927e115 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -24,16 +24,6 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask #endif /* - * This is the number of milliseconds to wait between internal retries in - * the Tcl_MutexLock function. This value must be greater than or equal - * to zero and should be a suitable value for the given platform. - */ - -#ifndef TCL_MUTEX_LOCK_SLEEP_TIME -# define TCL_MUTEX_LOCK_SLEEP_TIME (0) -#endif - -/* * This is the master lock used to serialize access to other serialization * data structures. */ @@ -67,13 +57,6 @@ static int allocOnce = 0; #endif /* TCL_THREADS */ /* - * The mutexLock serializes Tcl_MutexLock. This is necessary to prevent - * races when finalizing a mutex that some other thread may want to lock. - */ - -static CRITICAL_SECTION mutexLock; - -/* * The joinLock serializes Create- and ExitThread. This is necessary to * prevent a race where a new joinable thread exits before the creating thread * had the time to create the necessary data structures in the emulation @@ -386,7 +369,6 @@ TclpInitLock(void) */ init = 1; - InitializeCriticalSection(&mutexLock); InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&masterLock); @@ -534,7 +516,6 @@ void TclFinalizeLock(void) { MASTER_LOCK; - DeleteCriticalSection(&mutexLock); DeleteCriticalSection(&joinLock); /* @@ -605,20 +586,12 @@ retry: } MASTER_UNLOCK; } - while (1) { - EnterCriticalSection(&mutexLock); - csPtr = *((CRITICAL_SECTION **)mutexPtr); - if (csPtr == NULL) { - LeaveCriticalSection(&mutexLock); - goto retry; - } - if (TryEnterCriticalSection(csPtr)) { - LeaveCriticalSection(&mutexLock); - return; - } - LeaveCriticalSection(&mutexLock); - Tcl_Sleep(TCL_MUTEX_LOCK_SLEEP_TIME); + + csPtr = *((CRITICAL_SECTION **)mutexPtr); + if (csPtr == NULL) { + goto retry; } + EnterCriticalSection(csPtr); } /* -- cgit v0.12 From 38d734ddcfc00e2885ad397ee93ac12e062be4ef Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 3 Nov 2015 13:13:14 +0000 Subject: better handle out-of-memory conditions in ZIP filesystem hard-wire initial encoding on Android to UTF-8 --- generic/zipfs.c | 74 +++++++++++++++++++++++++++++++++++++++++++++++------- unix/tclUnixInit.c | 4 +++ 2 files changed, 69 insertions(+), 9 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index 1722688..e3bb7db 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -830,7 +830,14 @@ ZipFSOpenArchive(Tcl_Interp *interp, CONST char *zipname, int needZip, goto error; } Tcl_Seek(zf->chan, 0, SEEK_SET); - zf->tofree = zf->data = (unsigned char *) Tcl_Alloc(zf->length); + zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); + if (zf->tofree == NULL) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); if (i != zf->length) { if (interp) { @@ -1092,7 +1099,16 @@ Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, if (strcmp(mntpt, "/") == 0) { mntpt = ""; } - zf = (ZipFile *) Tcl_Alloc(sizeof (*zf) + strlen(mntpt) + 1); + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + Unlock(); + Tcl_DStringFree(&ds); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } *zf = zf0; zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); strcpy(zf->mntpt, mntpt); @@ -2263,8 +2279,8 @@ ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) ZipEntry *z = info->zipentry; unsigned char *newdata; - newdata = - (unsigned char *) Tcl_Realloc((char *) info->ubuf, info->nread); + newdata = (unsigned char *) + Tcl_AttemptRealloc((char *) info->ubuf, info->nread); if (newdata != NULL) { if (z->data != NULL) { Tcl_Free((char *) z->data); @@ -2595,7 +2611,13 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) } else { flags = TCL_WRITABLE; } - info = (ZipChannel *) Tcl_Alloc (sizeof (*info)); + info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info)); + if (info == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } info->zipfile = z->zipfile; info->zipentry = z; info->nread = 0; @@ -2606,7 +2628,19 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) info->nmax = ZipFS.wrmax; info->iscompr = 0; info->isenc = 0; - info->ubuf = (unsigned char *) Tcl_Alloc(info->nmax); + info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax); + if (info->ubuf == NULL) { +merror0: + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } memset(info->ubuf, 0, info->nmax); if (trunc) { info->nbyte = 0; @@ -2650,7 +2684,11 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) stream.avail_in = z->nbytecompr; if (z->isenc) { stream.avail_in -= 12; - cbuf = (unsigned char *) Tcl_Alloc(stream.avail_in); + cbuf = (unsigned char *) + Tcl_AttemptAlloc(stream.avail_in); + if (cbuf == NULL) { + goto merror0; + } for (i = 0; i < stream.avail_in; i++) { ch = info->ubuf[i]; cbuf[i] = zdecode(info->keys, crc32tab, ch); @@ -2747,7 +2785,11 @@ cerror0: stream.avail_in = z->nbytecompr; if (info->isenc) { stream.avail_in -= 12; - ubuf = (unsigned char *) Tcl_Alloc(stream.avail_in); + ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); + if (ubuf == NULL) { + info->ubuf = NULL; + goto merror; + } for (i = 0; i < stream.avail_in; i++) { ch = info->ubuf[i]; ubuf[i] = zdecode(info->keys, crc32tab, ch); @@ -2757,7 +2799,21 @@ cerror0: stream.next_in = info->ubuf; } stream.next_out = info->ubuf = - (unsigned char *) Tcl_Alloc(info->nbyte); + (unsigned char *) Tcl_AttemptAlloc(info->nbyte); + if (info->ubuf == NULL) { +merror: + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } stream.avail_out = info->nbyte; if (inflateInit2(&stream, -15) != Z_OK) { goto cerror; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index c0fa94d..cb1f70e 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -588,10 +588,14 @@ TclpInitLibraryPath( void TclpSetInitialEncodings(void) { +#ifdef ANDROID + Tcl_SetSystemEncoding(NULL, "utf-8"); +#else Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); +#endif } void -- cgit v0.12 From 19627fed479882d04fb4d3e738e4f959ff60b34d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 16 Dec 2015 13:26:54 +0000 Subject: Remove zipfs symbols from stub table. Those symbols should be exported as-is, without using the stub mechanism. --- generic/tclInt.decls | 12 ------------ generic/tclIntDecls.h | 18 ------------------ generic/tclStubInit.c | 3 --- generic/zipfs.h | 19 +++++-------------- 4 files changed, 5 insertions(+), 47 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 5aadbf2..53d5ad0 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1014,18 +1014,6 @@ declare 251 { int TclRegisterLiteral(void *envPtr, char *bytes, int length, int flags) } - -declare 252 { - int Tclzipfs_Init(Tcl_Interp *interp) -} -declare 253 { - int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, - const char *mntpt, const char *passwd) -} -declare 254 { - int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) -} - ############################################################################## diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5962b60..bbd1aae 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -614,15 +614,6 @@ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, /* 251 */ EXTERN int TclRegisterLiteral(void *envPtr, char *bytes, int length, int flags); -/* 252 */ -EXTERN int Tclzipfs_Init(Tcl_Interp *interp); -/* 253 */ -EXTERN int Tclzipfs_Mount(Tcl_Interp *interp, - const char *zipname, const char *mntpt, - const char *passwd); -/* 254 */ -EXTERN int Tclzipfs_Unmount(Tcl_Interp *interp, - const char *zipname); typedef struct TclIntStubs { int magic; @@ -880,9 +871,6 @@ typedef struct TclIntStubs { char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */ - int (*tclzipfs_Init) (Tcl_Interp *interp); /* 252 */ - int (*tclzipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 253 */ - int (*tclzipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 254 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; @@ -1311,12 +1299,6 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */ #define TclRegisterLiteral \ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ -#define Tclzipfs_Init \ - (tclIntStubsPtr->tclzipfs_Init) /* 252 */ -#define Tclzipfs_Mount \ - (tclIntStubsPtr->tclzipfs_Mount) /* 253 */ -#define Tclzipfs_Unmount \ - (tclIntStubsPtr->tclzipfs_Unmount) /* 254 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 214b0c4..95e46ca 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -562,9 +562,6 @@ static const TclIntStubs tclIntStubs = { TclDoubleDigits, /* 249 */ TclSetSlaveCancelFlags, /* 250 */ TclRegisterLiteral, /* 251 */ - Tclzipfs_Init, /* 252 */ - Tclzipfs_Mount, /* 253 */ - Tclzipfs_Unmount, /* 254 */ }; static const TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/zipfs.h b/generic/zipfs.h index a6bd45c..acc709b 100644 --- a/generic/zipfs.h +++ b/generic/zipfs.h @@ -33,20 +33,11 @@ extern "C" { #define Zipfs_SafeInit Tclzipfs_SafeInit #endif -#ifndef EXTERN -#define EXTERN extern -#endif - -#ifdef BUILD_tcl -#undef EXTERN -#define EXTERN -#endif - -EXTERN int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, - CONST char *mntpt, CONST char *passwd); -EXTERN int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); -EXTERN int Zipfs_Init(Tcl_Interp *interp); -EXTERN int Zipfs_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Zipfs_Mount(Tcl_Interp *interp, const char *zipname, + const char *mntpt, const char *passwd); +DLLEXPORT int Zipfs_Unmount(Tcl_Interp *interp, const char *zipname); +DLLEXPORT int Zipfs_Init(Tcl_Interp *interp); +DLLEXPORT int Zipfs_SafeInit(Tcl_Interp *interp); #ifdef __cplusplus } -- cgit v0.12 From 8f6089f225a01b69fadeb69105db95887d3ba9a5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 16 Dec 2015 13:37:20 +0000 Subject: No need for more than tcl.h in zipfs.h --- generic/zipfs.h | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/zipfs.h b/generic/zipfs.h index acc709b..a19e214 100644 --- a/generic/zipfs.h +++ b/generic/zipfs.h @@ -13,12 +13,13 @@ #ifndef _ZIPFS_H #define _ZIPFS_H +#include "tcl.h" + #ifdef __cplusplus extern "C" { #endif #ifdef ZIPFS_IN_TK -#include "tkInt.h" #define Zipfs_Mount Tkzipfs_Mount #define Zipfs_Unmount Tkzipfs_Unmount #define Zipfs_Init Tkzipfs_Init @@ -26,16 +27,15 @@ extern "C" { #endif #ifdef ZIPFS_IN_TCL -#include "tclPort.h" #define Zipfs_Mount Tclzipfs_Mount #define Zipfs_Unmount Tclzipfs_Unmount #define Zipfs_Init Tclzipfs_Init #define Zipfs_SafeInit Tclzipfs_SafeInit #endif -DLLEXPORT int Zipfs_Mount(Tcl_Interp *interp, const char *zipname, - const char *mntpt, const char *passwd); -DLLEXPORT int Zipfs_Unmount(Tcl_Interp *interp, const char *zipname); +DLLEXPORT int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, + CONST char *mntpt, CONST char *passwd); +DLLEXPORT int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); DLLEXPORT int Zipfs_Init(Tcl_Interp *interp); DLLEXPORT int Zipfs_SafeInit(Tcl_Interp *interp); -- cgit v0.12 From 58ace2b1dc62afca0a94b701a8c7857f2b620313 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 16 Dec 2015 15:18:59 +0000 Subject: remove unnecessary Tclzipfs defines in tclStubInit.c --- generic/tclStubInit.c | 6 ------ 1 file changed, 6 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 95e46ca..9131c45 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -48,12 +48,6 @@ #undef TclWinGetSockOpt #undef TclWinSetSockOpt -#ifndef ZIPFS_IN_TCL -# define Tclzipfs_Init 0 -# define Tclzipfs_Mount 0 -# define Tclzipfs_Unmount 0 -#endif - /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #ifdef _WIN64 # define TclSockMinimumBuffersOld 0 -- cgit v0.12 From 3826a4d32ebb4074fb96b278f3a477e7e0d3f262 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 16 Dec 2015 16:25:07 +0000 Subject: Clean-up: Remove Tcl_FindHashEntry/Tcl_CreateHashEntry symbols/stub entries, as those two functions are actually defined as macros. The function alternatives were only kept for legacy, but are no longer necessary. --- generic/tcl.decls | 14 +++++++------- generic/tclDecls.h | 18 ++++++------------ generic/tclHash.c | 43 ------------------------------------------- generic/tclStubInit.c | 6 ++---- 4 files changed, 15 insertions(+), 66 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index f2f8190..1d05a91 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1522,13 +1522,13 @@ declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase) } -declare 421 { - Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) -} -declare 422 { - Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr) -} +#declare 421 { +# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) +#} +#declare 422 { +# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +# const void *key, int *newPtr) +#} declare 423 { void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index fc4b441..080d044 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1136,12 +1136,8 @@ TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, /* 420 */ TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); -/* 421 */ -TCLAPI Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, - const void *key); -/* 422 */ -TCLAPI Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr); +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ /* 423 */ TCLAPI void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); @@ -2188,8 +2184,8 @@ typedef struct TclStubs { int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ - Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ + void (*reserved421)(void); + void (*reserved422)(void); void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ @@ -3240,10 +3236,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ -#define Tcl_FindHashEntry \ - (tclStubsPtr->tcl_FindHashEntry) /* 421 */ -#define Tcl_CreateHashEntry \ - (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ diff --git a/generic/tclHash.c b/generic/tclHash.c index 3ea9dd9..27919c5 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -14,13 +14,6 @@ #include "tclInt.h" /* - * Prevent macros from clashing with function definitions. - */ - -#undef Tcl_FindHashEntry -#undef Tcl_CreateHashEntry - -/* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ @@ -210,31 +203,6 @@ Tcl_InitCustomHashTable( } } -/* - *---------------------------------------------------------------------- - * - * Tcl_FindHashEntry -- - * - * Given a hash table find the entry with a matching key. - * - * Results: - * The return value is a token for the matching entry in the hash table, - * or NULL if there was no matching entry. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_HashEntry * -Tcl_FindHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key) /* Key to use to find matching entry. */ -{ - return (*((tablePtr)->findProc))(tablePtr, key); -} - static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ @@ -265,17 +233,6 @@ FindHashEntry( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_CreateHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key, /* Key to use to find or create matching - * entry. */ - int *newPtr) /* Store info here telling whether a new entry - * was created. */ -{ - return (*((tablePtr)->createProc))(tablePtr, key, newPtr); -} - static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index cd24485..cb15269 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -41,8 +41,6 @@ MODULE_SCOPE const TclOOIntStubs tclOOIntStubs; #undef Tcl_NewStringObj #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory -#undef Tcl_FindHashEntry -#undef Tcl_CreateHashEntry #undef TclpGetPid #undef TclPkgProvide #undef Tcl_SetIntObj @@ -1141,8 +1139,8 @@ const TclStubs tclStubs = { Tcl_IsChannelExisting, /* 418 */ Tcl_UniCharNcasecmp, /* 419 */ Tcl_UniCharCaseMatch, /* 420 */ - Tcl_FindHashEntry, /* 421 */ - Tcl_CreateHashEntry, /* 422 */ + 0, /* 421 */ + 0, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ -- cgit v0.12 From d6fdfa46244d1d14d8c2dce5378e3a23ab51aac2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Dec 2015 12:04:22 +0000 Subject: minor tweaks for MSVC --- generic/zipfs.h | 20 ++++++++++++++++---- unix/tclUnixInit.c | 3 +++ 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/generic/zipfs.h b/generic/zipfs.h index a19e214..15ca37c 100644 --- a/generic/zipfs.h +++ b/generic/zipfs.h @@ -19,11 +19,19 @@ extern "C" { #endif +#ifndef ZIPFSAPI +# define ZIPFSAPI extern +#endif + #ifdef ZIPFS_IN_TK #define Zipfs_Mount Tkzipfs_Mount #define Zipfs_Unmount Tkzipfs_Unmount #define Zipfs_Init Tkzipfs_Init #define Zipfs_SafeInit Tkzipfs_SafeInit +#ifdef BUILD_tk +# undef ZIPFSAPI +# define ZIPFSAPI DLLEXPORT +#endif #endif #ifdef ZIPFS_IN_TCL @@ -31,13 +39,17 @@ extern "C" { #define Zipfs_Unmount Tclzipfs_Unmount #define Zipfs_Init Tclzipfs_Init #define Zipfs_SafeInit Tclzipfs_SafeInit +#ifdef BUILD_tcl +# undef ZIPFSAPI +# define ZIPFSAPI DLLEXPORT +#endif #endif -DLLEXPORT int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, +ZIPFSAPI int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, CONST char *passwd); -DLLEXPORT int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); -DLLEXPORT int Zipfs_Init(Tcl_Interp *interp); -DLLEXPORT int Zipfs_SafeInit(Tcl_Interp *interp); +ZIPFSAPI int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); +ZIPFSAPI int Zipfs_Init(Tcl_Interp *interp); +ZIPFSAPI int Zipfs_SafeInit(Tcl_Interp *interp); #ifdef __cplusplus } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index cb1f70e..e8ccc76 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -9,6 +9,9 @@ */ #include "tclInt.h" +#ifdef ZIPFS_IN_TCL +#include "zipfs.h" +#endif #include #include #ifdef HAVE_LANGINFO -- cgit v0.12 From ecd9567624afb68333af5c0439bf195145312858 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Dec 2015 15:23:27 +0000 Subject: Minor tweaks on ZIPFS_IN_TCL --- generic/tclMain.c | 12 +++++++----- unix/configure | 18 ++++++++++++++++++ unix/configure.in | 8 ++++++++ 3 files changed, 33 insertions(+), 5 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index a52d62d..6acd15d 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -321,14 +321,14 @@ Tcl_MainEx( { Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; - int code, length, exitCode = 0; + int code, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; Tcl_Channel chan; InteractiveState is; +#ifdef ZIPFS_IN_TCL const char *zipFile = NULL; Tcl_Obj *zipval = NULL; int autoRun = 1; -#ifdef ZIPFS_IN_TCL int zipOk = TCL_ERROR; #ifndef ANDROID const char *exeName; @@ -337,7 +337,7 @@ Tcl_MainEx( TclpSetInitialEncodings(); TclpFindExecutable((const char *)argv[0]); -#ifndef ANDROID +#if defined(ZIPFS_IN_TCL) && !defined(ANDROID) exeName = Tcl_GetNameOfExecutable(); #endif @@ -369,8 +369,9 @@ Tcl_MainEx( Tcl_DecrRefCount(value); argc -= 3; argv += 3; +#ifdef ZIPFS_IN_TCL } else if (argc > 2) { - length = strlen((char *) argv[1]); + int length = strlen((char *) argv[1]); if ((length >= 2) && (0 == _tcsncmp(TEXT("-zip"), argv[1], length))) { argc--; @@ -387,6 +388,7 @@ Tcl_MainEx( argc--; argv++; } +#endif } else if ((argc > 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; @@ -475,11 +477,11 @@ Tcl_MainEx( Tcl_DStringFree(&dsLib); #endif } -#endif if (zipval != NULL) { Tcl_DecrRefCount(zipval); zipval = NULL; } +#endif /* * Invoke application-specific initialization. diff --git a/unix/configure b/unix/configure index c19a77a..3e72a0d 100755 --- a/unix/configure +++ b/unix/configure @@ -869,6 +869,7 @@ Optional Packages: --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values (default: iso8859-1) + --with-zipfs include ZIP filesystem --with-tzdata install timezone data (default: autodetect) Some influential environment variables: @@ -6211,6 +6212,23 @@ cat >>confdefs.h <<\_ACEOF _ACEOF +# Check whether --with-zipfs or --without-zipfs was given. +if test "${with_zipfs+set}" = set; then + withval="$with_zipfs" + tcl_ok=$withval +else + tcl_ok=no +fi; +echo "$as_me:$LINENO: result: $tcl_ok" >&5 +echo "${ECHO_T}$tcl_ok" >&6 +if test $tcl_ok = yes; then + +cat >>confdefs.h <<\_ACEOF +#define ZIPFS_IN_TCL 1 +_ACEOF + +fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called diff --git a/unix/configure.in b/unix/configure.in index c7b0edc..7eeff3b 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -171,6 +171,14 @@ AS_IF([test $zlib_ok = no], [ AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) +AC_ARG_WITH(zipfs, + AC_HELP_STRING([--with-zipfs], + [include ZIP filesystem]), + [tcl_ok=$withval], [tcl_ok=no]) +AC_MSG_RESULT([$tcl_ok]) +if test $tcl_ok = yes; then + AC_DEFINE(ZIPFS_IN_TCL, 1, [Include ZIP filesystem?]) +fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This -- cgit v0.12 From c795f44ea527a23d9d9cba2f4c811053ac7af6ff Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 18 Dec 2015 12:39:24 +0000 Subject: upstream androwish change --- debian/rules | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/debian/rules b/debian/rules index 7a0214c..a4b3bd4 100755 --- a/debian/rules +++ b/debian/rules @@ -18,8 +18,6 @@ else CFLAGS=-g -O2 -fno-unit-at-a-time endif -CFLAGS+=-DZIPFS_IN_TCL=1 - unpatch: dh_testdir quilt pop -a || test $$? = 2 @@ -49,7 +47,8 @@ build-stamp: patch-stamp --enable-man-symlinks \ --enable-man-compression=gzip \ --enable-threads \ - --without-tzdata && \ + --without-tzdata \ + --with-zipfs && \ touch ../generic/tclStubInit.c && \ $(MAKE) # Build the static library. -- cgit v0.12 From 4d946107e7d14769b306d8bf05ff4f661b7883ff Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 09:16:38 +0000 Subject: Put back the stub entries for TclpGetDate/TclpLocaltime/TclpGmtime. Although those functions are dead (they will be removed in Tcl 9, already done in the "novem" branch), removing those functions is a good idea, this cannot be done in any 8.x release. It hinders the acceptance of a "zipfs" TIP, therefore this change should not be part of the "androwish" change-set. --- generic/tclInt.decls | 35 +++--- generic/tclIntDecls.h | 24 ++-- generic/tclIntPlatDecls.h | 32 +++-- generic/tclStubInit.c | 18 +-- unix/tclUnixTime.c | 197 +++++++++++++++++++++++++++++ win/tclWinTime.c | 308 +++++++++++++++++++++++++++++++++++++++++++++- 6 files changed, 565 insertions(+), 49 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 53d5ad0..4e7e422 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -532,10 +532,9 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -# Removed in androwish -# declare 133 { -# struct tm *TclpGetDate(const time_t *time, int useGMT) -#} +declare 133 { + struct tm *TclpGetDate(const time_t *time, int useGMT) +} # Removed in 8.5 #declare 134 { # size_t TclpStrftime(char *s, size_t maxsize, const char *format, @@ -751,14 +750,12 @@ declare 179 { # TclpGmtime and TclpLocaltime promoted to the generic interface from unix -# Removed in androwish -#declare 182 { -# struct tm *TclpLocaltime(const time_t *clock) -#} -# Removed in androwish -#declare 183 { -# struct tm *TclpGmtime(const time_t *clock) -#} +declare 182 { + struct tm *TclpLocaltime(const time_t *clock) +} +declare 183 { + struct tm *TclpGmtime(const time_t *clock) +} # For the new "Thread Storage" subsystem. @@ -1207,14 +1204,12 @@ declare 10 unix { } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs -# Removed in androwish -#declare 11 unix { -# struct tm *TclpLocaltime_unix(const time_t *clock) -#} -# Removed in androwish -#declare 12 unix { -# struct tm *TclpGmtime_unix(const time_t *clock) -#} +declare 11 unix { + struct tm *TclpLocaltime_unix(const time_t *clock) +} +declare 12 unix { + struct tm *TclpGmtime_unix(const time_t *clock) +} declare 13 unix { char *TclpInetNtoa(struct in_addr addr) } diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index bbd1aae..f95f999 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -349,7 +349,8 @@ EXTERN void Tcl_SetNamespaceResolvers( Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* Slot 133 is reserved */ +/* 133 */ +EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT); /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -462,8 +463,10 @@ EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr, EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* Slot 182 is reserved */ -/* Slot 183 is reserved */ +/* 182 */ +EXTERN struct tm * TclpLocaltime(const time_t *clock); +/* 183 */ +EXTERN struct tm * TclpGmtime(const time_t *clock); /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -752,7 +755,7 @@ typedef struct TclIntStubs { int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - void (*reserved133)(void); + struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); @@ -801,8 +804,8 @@ typedef struct TclIntStubs { Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ void (*reserved180)(void); void (*reserved181)(void); - void (*reserved182)(void); - void (*reserved183)(void); + struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ + struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); @@ -1100,7 +1103,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -/* Slot 133 is reserved */ +#define TclpGetDate \ + (tclIntStubsPtr->tclpGetDate) /* 133 */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1185,8 +1189,10 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* Slot 182 is reserved */ -/* Slot 183 is reserved */ +#define TclpLocaltime \ + (tclIntStubsPtr->tclpLocaltime) /* 182 */ +#define TclpGmtime \ + (tclIntStubsPtr->tclpGmtime) /* 183 */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index b7a44d8..ac06787 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -73,8 +73,10 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ +/* 11 */ +EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); +/* 12 */ +EXTERN struct tm * TclpGmtime_unix(const time_t *clock); /* 13 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ @@ -205,8 +207,10 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ +/* 11 */ +EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); +/* 12 */ +EXTERN struct tm * TclpGmtime_unix(const time_t *clock); /* 13 */ EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ @@ -266,8 +270,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ - void (*reserved11)(void); - void (*reserved12)(void); + 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 */ void (*reserved15)(void); @@ -332,8 +336,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ - void (*reserved11)(void); - void (*reserved12)(void); + 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 */ @@ -389,8 +393,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ +#define TclpLocaltime_unix \ + (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ +#define TclpGmtime_unix \ + (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ @@ -498,8 +504,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ +#define TclpLocaltime_unix \ + (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ +#define TclpGmtime_unix \ + (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 9131c45..5b7a1cd 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -288,6 +288,10 @@ static int formatInt(char *buffer, int n){ #define TclFormatInt (int(*)(char *, long))formatInt #endif + +#else /* UNIX and MAC */ +# define TclpLocaltime_unix TclpLocaltime +# define TclpGmtime_unix TclpGmtime #endif /* @@ -437,7 +441,7 @@ static const TclIntStubs tclIntStubs = { Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - 0, /* 133 */ + TclpGetDate, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -486,8 +490,8 @@ static const TclIntStubs tclIntStubs = { Tcl_GetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ - 0, /* 182 */ - 0, /* 183 */ + TclpLocaltime, /* 182 */ + TclpGmtime, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -573,8 +577,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - 0, /* 11 */ - 0, /* 12 */ + TclpLocaltime_unix, /* 11 */ + TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ 0, /* 15 */ @@ -639,8 +643,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - 0, /* 11 */ - 0, /* 12 */ + TclpLocaltime_unix, /* 11 */ + TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 470b122..315bcf9 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -17,9 +17,34 @@ #endif /* + * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread + * safety, this structure must be in thread-specific data. The 'tmKey' + * variable is the key to this buffer. + */ + +static Tcl_ThreadDataKey tmKey; +typedef struct ThreadSpecificData { + struct tm gmtime_buf; + struct tm localtime_buf; +} ThreadSpecificData; + +/* + * If we fall back on the thread-unsafe versions of gmtime and localtime, use + * this mutex to try to protect them. + */ + +TCL_DECLARE_MUTEX(tmMutex) + +static char *lastTZ = NULL; /* Holds the last setting of the TZ + * environment variable, or an empty string if + * the variable was not set. */ + +/* * Static functions declared in this file. */ +static void SetTZIfNecessary(void); +static void CleanupMemory(ClientData clientData); static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, @@ -223,6 +248,114 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * + * TclpGetDate -- + * + * This function converts between seconds and struct tm. If useGMT is + * true, then the returned date will be in Greenwich Mean Time (GMT). + * Otherwise, it will be in the local time zone. + * + * Results: + * Returns a static tm structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGetDate( + const time_t *time, + int useGMT) +{ + if (useGMT) { + return TclpGmtime(time); + } else { + return TclpLocaltime(time); + } +} + +/* + *---------------------------------------------------------------------- + * + * TclpGmtime -- + * + * Wrapper around the 'gmtime' library function to make it thread safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes gmtime or gmtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGmtime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * Get a thread-local buffer to hold the returned time. + */ + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); + +#ifdef HAVE_GMTIME_R + gmtime_r(timePtr, &tsdPtr->gmtime_buf); +#else + Tcl_MutexLock(&tmMutex); + memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); + Tcl_MutexUnlock(&tmMutex); +#endif + + return &tsdPtr->gmtime_buf; +} + +/* + *---------------------------------------------------------------------- + * + * TclpLocaltime -- + * + * Wrapper around the 'localtime' library function to make it thread + * safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes localtime or localtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpLocaltime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * Get a thread-local buffer to hold the returned time. + */ + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); + + SetTZIfNecessary(); +#ifdef HAVE_LOCALTIME_R + localtime_r(timePtr, &tsdPtr->localtime_buf); +#else + Tcl_MutexLock(&tmMutex); + memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); + Tcl_MutexUnlock(&tmMutex); +#endif + + return &tsdPtr->localtime_buf; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -334,6 +467,70 @@ NativeGetTime( timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } +/* + *---------------------------------------------------------------------- + * + * SetTZIfNecessary -- + * + * Determines whether a call to 'tzset' is needed prior to the next call + * to 'localtime' or examination of the 'timezone' variable. + * + * Results: + * None. + * + * Side effects: + * If 'tzset' has never been called in the current process, or if the + * value of the environment variable TZ has changed since the last call + * to 'tzset', then 'tzset' is called again. + * + *---------------------------------------------------------------------- + */ + +static void +SetTZIfNecessary(void) +{ + const char *newTZ = getenv("TZ"); + + Tcl_MutexLock(&tmMutex); + if (newTZ == NULL) { + newTZ = ""; + } + if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { + tzset(); + if (lastTZ == NULL) { + Tcl_CreateExitHandler(CleanupMemory, NULL); + } else { + ckfree(lastTZ); + } + lastTZ = ckalloc(strlen(newTZ) + 1); + strcpy(lastTZ, newTZ); + } + Tcl_MutexUnlock(&tmMutex); +} + +/* + *---------------------------------------------------------------------- + * + * CleanupMemory -- + * + * Releases the private copy of the TZ environment variable upon exit + * from Tcl. + * + * Results: + * None. + * + * Side effects: + * Frees allocated memory. + * + *---------------------------------------------------------------------- + */ + +static void +CleanupMemory( + ClientData ignored) +{ + ckfree(lastTZ); +} /* * Local Variables: diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 0762362..7045c72 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,6 +12,10 @@ #include "tclInt.h" +#define SECSPERDAY (60L * 60L * 24L) +#define SECSPERYEAR (SECSPERDAY * 365L) +#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) + /* * Number of samples over which to estimate the performance counter. */ @@ -19,10 +23,29 @@ #define SAMPLES 64 /* + * The following arrays contain the day of year for the last day of each + * month, where index 1 is January. + */ + +static const int normalDays[] = { + -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 +}; + +static const int leapDays[] = { + -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 +}; + +typedef struct ThreadSpecificData { + char tzName[64]; /* Time zone name */ + struct tm tm; /* time information */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* * Data for managing high-resolution timers. */ -typedef struct { +typedef struct TimeInfo { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ @@ -90,6 +113,7 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ +static struct tm * ComputeGMT(const time_t *tp); static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -465,6 +489,227 @@ StopCalibration( /* *---------------------------------------------------------------------- * + * TclpGetDate -- + * + * This function converts between seconds and struct tm. If useGMT is + * true, then the returned date will be in Greenwich Mean Time (GMT). + * Otherwise, it will be in the local time zone. + * + * Results: + * Returns a static tm structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGetDate( + const time_t *t, + int useGMT) +{ + struct tm *tmPtr; + time_t time; + + if (!useGMT) { + tzset(); + + /* + * If we are in the valid range, let the C run-time library handle it. + * Otherwise we need to fake it. Note that this algorithm ignores + * daylight savings time before the epoch. + */ + + /* + * Hm, Borland's localtime manages to return NULL under certain + * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, + * since 'localtime' isn't supposed to do this, possibly leading to + * crashes. + * + * Patch: We only call this function if we are at least one day into + * the epoch, else we handle it ourselves (like we do for times < 0). + * H. Giese, June 2003 + */ + +#ifdef __BORLANDC__ +#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY +#else +#define LOCALTIME_VALIDITY_BOUNDARY 0 +#endif + + if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { + return TclpLocaltime(t); + } + + time = *t - timezone; + + /* + * If we aren't near to overflowing the long, just add the bias and + * use the normal calculation. Otherwise we will need to adjust the + * result at the end. + */ + + if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { + tmPtr = ComputeGMT(&time); + } else { + tmPtr = ComputeGMT(t); + + tzset(); + + /* + * Add the bias directly to the tm structure to avoid overflow. + * Propagate seconds overflow into minutes, hours and days. + */ + + time = tmPtr->tm_sec - timezone; + tmPtr->tm_sec = (int)(time % 60); + if (tmPtr->tm_sec < 0) { + tmPtr->tm_sec += 60; + time -= 60; + } + + time = tmPtr->tm_min + time/60; + tmPtr->tm_min = (int)(time % 60); + if (tmPtr->tm_min < 0) { + tmPtr->tm_min += 60; + time -= 60; + } + + time = tmPtr->tm_hour + time/60; + tmPtr->tm_hour = (int)(time % 24); + if (tmPtr->tm_hour < 0) { + tmPtr->tm_hour += 24; + time -= 24; + } + + time /= 24; + tmPtr->tm_mday += (int)time; + tmPtr->tm_yday += (int)time; + tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; + } + } else { + tmPtr = ComputeGMT(t); + } + return tmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ComputeGMT -- + * + * This function computes GMT given the number of seconds since the epoch + * (midnight Jan 1 1970). + * + * Results: + * Returns a (per thread) statically allocated struct tm. + * + * Side effects: + * Updates the values of the static struct tm. + * + *---------------------------------------------------------------------- + */ + +static struct tm * +ComputeGMT( + const time_t *tp) +{ + struct tm *tmPtr; + long tmp, rem; + int isLeap; + const int *days; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tmPtr = &tsdPtr->tm; + + /* + * Compute the 4 year span containing the specified time. + */ + + tmp = (long)(*tp / SECSPER4YEAR); + rem = (long)(*tp % SECSPER4YEAR); + + /* + * Correct for weird mod semantics so the remainder is always positive. + */ + + if (rem < 0) { + tmp--; + rem += SECSPER4YEAR; + } + + /* + * Compute the year after 1900 by taking the 4 year span and adjusting for + * the remainder. This works because 2000 is a leap year, and 1900/2100 + * are out of the range. + */ + + tmp = (tmp * 4) + 70; + isLeap = 0; + if (rem >= SECSPERYEAR) { /* 1971, etc. */ + tmp++; + rem -= SECSPERYEAR; + if (rem >= SECSPERYEAR) { /* 1972, etc. */ + tmp++; + rem -= SECSPERYEAR; + if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ + tmp++; + rem -= SECSPERYEAR + SECSPERDAY; + } else { + isLeap = 1; + } + } + } + tmPtr->tm_year = tmp; + + /* + * Compute the day of year and leave the seconds in the current day in the + * remainder. + */ + + tmPtr->tm_yday = rem / SECSPERDAY; + rem %= SECSPERDAY; + + /* + * Compute the time of day. + */ + + tmPtr->tm_hour = rem / 3600; + rem %= 3600; + tmPtr->tm_min = rem / 60; + tmPtr->tm_sec = rem % 60; + + /* + * Compute the month and day of month. + */ + + days = (isLeap) ? leapDays : normalDays; + for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { + /* empty body */ + } + tmPtr->tm_mon = --tmp; + tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; + + /* + * Compute day of week. Epoch started on a Thursday. + */ + + tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; + if ((*tp % SECSPERDAY) < 0) { + tmPtr->tm_wday--; + } + tmPtr->tm_wday %= 7; + if (tmPtr->tm_wday < 0) { + tmPtr->tm_wday += 7; + } + + return tmPtr; +} + +/* + *---------------------------------------------------------------------- + * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -792,6 +1037,67 @@ AccumulateSample( /* *---------------------------------------------------------------------- * + * TclpGmtime -- + * + * Wrapper around the 'gmtime' library function to make it thread safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes gmtime or gmtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGmtime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * The MS implementation of gmtime is thread safe because it returns the + * time in a block of thread-local storage, and Windows does not provide a + * Posix gmtime_r function. + */ + + return gmtime(timePtr); +} + +/* + *---------------------------------------------------------------------- + * + * TclpLocaltime -- + * + * Wrapper around the 'localtime' library function to make it thread + * safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes localtime or localtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpLocaltime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * The MS implementation of localtime is thread safe because it returns + * the time in a block of thread-local storage, and Windows does not + * provide a Posix localtime_r function. + */ + + return localtime(timePtr); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the -- cgit v0.12 From cb73551e8dda297b93eecea5b526196ef7589c86 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 09:31:36 +0000 Subject: Start of "zipfs" branch, meant for keeping track of the proposed changes for a new TIP. Remove some android-specific build/configure files. --- Android.mk | 204 --------------------------------------------- debian/changelog | 23 ----- debian/compat | 1 - debian/control | 37 -------- debian/copyright | 141 ------------------------------- debian/rules | 130 ----------------------------- debian/sdltcl8.6-dev.dirs | 2 - debian/sdltcl8.6-dev.files | 2 - debian/sdltcl8.6-doc.files | 2 - debian/sdltcl8.6.files | 18 ---- debian/shlibs.local | 1 - pkgs/Android.mk | 1 - tcl-config.mk | 62 -------------- 13 files changed, 624 deletions(-) delete mode 100644 Android.mk delete mode 100644 debian/changelog delete mode 100644 debian/compat delete mode 100644 debian/control delete mode 100644 debian/copyright delete mode 100755 debian/rules delete mode 100644 debian/sdltcl8.6-dev.dirs delete mode 100644 debian/sdltcl8.6-dev.files delete mode 100644 debian/sdltcl8.6-doc.files delete mode 100644 debian/sdltcl8.6.files delete mode 100644 debian/shlibs.local delete mode 100644 pkgs/Android.mk delete mode 100644 tcl-config.mk diff --git a/Android.mk b/Android.mk deleted file mode 100644 index 13e55d9..0000000 --- a/Android.mk +++ /dev/null @@ -1,204 +0,0 @@ -LOCAL_PATH := $(call my-dir) - -########################### -# -# Tcl shared library -# -########################### - -include $(CLEAR_VARS) - -tcl_path := $(LOCAL_PATH) - -include $(tcl_path)/tcl-config.mk - -LOCAL_ADDITIONAL_DEPENDENCIES += $(tcl_path)/tcl-config.mk - -LOCAL_MODULE := tcl - -LOCAL_ARM_MODE := arm - -LOCAL_C_INCLUDES := $(tcl_includes) $(LOCAL_PATH)/libtommath - -LOCAL_EXPORT_C_INCLUDES := $(LOCAL_C_INCLUDES) - -LOCAL_SRC_FILES := \ - libtommath/bncore.c \ - libtommath/bn_reverse.c \ - libtommath/bn_fast_s_mp_mul_digs.c \ - libtommath/bn_fast_s_mp_sqr.c \ - libtommath/bn_mp_add.c \ - libtommath/bn_mp_add_d.c \ - libtommath/bn_mp_and.c \ - libtommath/bn_mp_clamp.c \ - libtommath/bn_mp_clear.c \ - libtommath/bn_mp_clear_multi.c \ - libtommath/bn_mp_cmp.c \ - libtommath/bn_mp_cmp_d.c \ - libtommath/bn_mp_cmp_mag.c \ - libtommath/bn_mp_copy.c \ - libtommath/bn_mp_cnt_lsb.c \ - libtommath/bn_mp_count_bits.c \ - libtommath/bn_mp_div.c \ - libtommath/bn_mp_div_d.c \ - libtommath/bn_mp_div_2.c \ - libtommath/bn_mp_div_2d.c \ - libtommath/bn_mp_div_3.c \ - libtommath/bn_mp_exch.c \ - libtommath/bn_mp_expt_d.c \ - libtommath/bn_mp_grow.c \ - libtommath/bn_mp_init.c \ - libtommath/bn_mp_init_copy.c \ - libtommath/bn_mp_init_multi.c \ - libtommath/bn_mp_init_set.c \ - libtommath/bn_mp_init_set_int.c \ - libtommath/bn_mp_init_size.c \ - libtommath/bn_mp_karatsuba_mul.c \ - libtommath/bn_mp_karatsuba_sqr.c \ - libtommath/bn_mp_lshd.c \ - libtommath/bn_mp_mod.c \ - libtommath/bn_mp_mod_2d.c \ - libtommath/bn_mp_mul.c \ - libtommath/bn_mp_mul_2.c \ - libtommath/bn_mp_mul_2d.c \ - libtommath/bn_mp_mul_d.c \ - libtommath/bn_mp_neg.c \ - libtommath/bn_mp_or.c \ - libtommath/bn_mp_radix_size.c \ - libtommath/bn_mp_radix_smap.c \ - libtommath/bn_mp_read_radix.c \ - libtommath/bn_mp_rshd.c \ - libtommath/bn_mp_set.c \ - libtommath/bn_mp_set_int.c \ - libtommath/bn_mp_shrink.c \ - libtommath/bn_mp_sqr.c \ - libtommath/bn_mp_sqrt.c \ - libtommath/bn_mp_sub.c \ - libtommath/bn_mp_sub_d.c \ - libtommath/bn_mp_to_unsigned_bin.c \ - libtommath/bn_mp_to_unsigned_bin_n.c \ - libtommath/bn_mp_toom_mul.c \ - libtommath/bn_mp_toom_sqr.c \ - libtommath/bn_mp_toradix_n.c \ - libtommath/bn_mp_unsigned_bin_size.c \ - libtommath/bn_mp_xor.c \ - libtommath/bn_mp_zero.c \ - libtommath/bn_s_mp_add.c \ - libtommath/bn_s_mp_mul_digs.c \ - libtommath/bn_s_mp_sqr.c \ - libtommath/bn_s_mp_sub.c \ - generic/regcomp.c \ - generic/regexec.c \ - generic/regfree.c \ - generic/regerror.c \ - generic/tclAlloc.c \ - generic/tclAssembly.c \ - generic/tclAsync.c \ - generic/tclBasic.c \ - generic/tclBinary.c \ - generic/tclCkalloc.c \ - generic/tclClock.c \ - generic/tclCmdAH.c \ - generic/tclCmdIL.c \ - generic/tclCmdMZ.c \ - generic/tclCompCmds.c \ - generic/tclCompCmdsGR.c \ - generic/tclCompCmdsSZ.c \ - generic/tclCompExpr.c \ - generic/tclCompile.c \ - generic/tclConfig.c \ - generic/tclDate.c \ - generic/tclDictObj.c \ - generic/tclDisassemble.c \ - generic/tclEncoding.c \ - generic/tclEnsemble.c \ - generic/tclEnv.c \ - generic/tclEvent.c \ - generic/tclExecute.c \ - generic/tclFCmd.c \ - generic/tclFileName.c \ - generic/tclGet.c \ - generic/tclHash.c \ - generic/tclHistory.c \ - generic/tclIndexObj.c \ - generic/tclInterp.c \ - generic/tclIO.c \ - generic/tclIOCmd.c \ - generic/tclIOGT.c \ - generic/tclIOSock.c \ - generic/tclIOUtil.c \ - generic/tclIORChan.c \ - generic/tclIORTrans.c \ - generic/tclLink.c \ - generic/tclListObj.c \ - generic/tclLiteral.c \ - generic/tclLoad.c \ - generic/tclMain.c \ - generic/tclNamesp.c \ - generic/tclNotify.c \ - generic/tclObj.c \ - generic/tclOptimize.c \ - generic/tclPanic.c \ - generic/tclParse.c \ - generic/tclPathObj.c \ - generic/tclPipe.c \ - generic/tclPkg.c \ - generic/tclPkgConfig.c \ - generic/tclPosixStr.c \ - generic/tclPreserve.c \ - generic/tclProc.c \ - generic/tclRegexp.c \ - generic/tclResolve.c \ - generic/tclResult.c \ - generic/tclScan.c \ - generic/tclStubInit.c \ - generic/tclStringObj.c \ - generic/tclStrToD.c \ - generic/tclThread.c \ - generic/tclThreadAlloc.c \ - generic/tclThreadJoin.c \ - generic/tclThreadStorage.c \ - generic/tclTimer.c \ - generic/tclTomMathInterface.c \ - generic/tclTrace.c \ - generic/tclUtil.c \ - generic/tclUtf.c \ - generic/tclVar.c \ - generic/tclZlib.c \ - generic/tclOO.c \ - generic/tclOOBasic.c \ - generic/tclOOCall.c \ - generic/tclOODefineCmds.c \ - generic/tclOOInfo.c \ - generic/tclOOMethod.c \ - generic/tclOOStubInit.c \ - generic/tclStubLib.c \ - generic/tclTomMathStubLib.c \ - generic/tclOOStubLib.c \ - generic/zipfs.c \ - unix/tclAppInit.c \ - unix/tclLoadDl.c \ - unix/tclUnixChan.c \ - unix/tclUnixCompat.c \ - unix/tclUnixEvent.c \ - unix/tclUnixFCmd.c \ - unix/tclUnixFile.c \ - unix/tclUnixInit.c \ - unix/tclUnixNotfy.c \ - unix/tclUnixPipe.c \ - unix/tclUnixSock.c \ - unix/tclUnixTest.c \ - unix/tclUnixThrd.c \ - unix/tclUnixTime.c - -LOCAL_CFLAGS := $(tcl_cflags) \ - -DPACKAGE_NAME="\"tcl\"" \ - -DPACKAGE_VERSION="\"8.6\"" \ - -DBUILD_tcl=1 \ - -Dmain=tclsh \ - -O2 - -LOCAL_LDLIBS := -ldl -lz -llog - -include $(BUILD_SHARED_LIBRARY) - diff --git a/debian/changelog b/debian/changelog deleted file mode 100644 index caad3ba..0000000 --- a/debian/changelog +++ /dev/null @@ -1,23 +0,0 @@ -sdltcl8.6 (8.6.4-1) unstable; urgency=low - - * Update to 8.6.4 - - -- Christian Werner Thu, 12 Mar 2015 22:00:00 +0100 - -sdltcl8.6 (8.6.3-1) unstable; urgency=low - - * Update to 8.6.3 - - -- Christian Werner Wed, 12 Nov 2014 20:00:00 +0100 - -sdltcl8.6 (8.6.2-1) unstable; urgency=low - - * Update to 8.6.2 - - -- Christian Werner Thu, 28 Aug 2014 07:10:10 +0200 - -sdltcl8.6 (8.6.1-1) unstable; urgency=low - - * Initial packaging - - -- Christian Werner Sat, 05 Apr 2014 14:44:48 +0200 diff --git a/debian/compat b/debian/compat deleted file mode 100644 index 7ed6ff8..0000000 --- a/debian/compat +++ /dev/null @@ -1 +0,0 @@ -5 diff --git a/debian/control b/debian/control deleted file mode 100644 index 3434297..0000000 --- a/debian/control +++ /dev/null @@ -1,37 +0,0 @@ -Source: sdltcl8.6 -Section: libs -Priority: optional -Maintainer: -Build-Depends: debhelper (>= 5.0.0), quilt -Standards-Version: 3.8.3 -Homepage: http://www.tcl.tk/ - -Package: sdltcl8.6 -Section: interpreters -Priority: optional -Architecture: any -Depends: ${shlibs:Depends} -Description: Tcl (the Tool Command Language) v8.6 - run-time files - Tcl is a powerful, easy to use, embeddable, cross-platform interpreted - scripting language. This package contains everything you need to run - Tcl scripts and Tcl-enabled apps. This version includes thread support. - -Package: sdltcl8.6-doc -Section: doc -Priority: optional -Architecture: all -Suggests: sdltcl8.6 -Description: Tcl (the Tool Command Language) v8.6 - manual pages - Tcl is a powerful, easy-to-use, embeddable, cross-platform interpreted - scripting language. This package contains the man pages for Tcl commands. - -Package: sdltcl8.6-dev -Section: devel -Priority: optional -Architecture: any -Depends: sdltcl8.6 (= ${binary:Version}) -Suggests: sdltcl8.6-doc -Description: Tcl (the Tool Command Language) v8.6 - development files - Tcl is a powerful, easy-to-use, embeddable, cross-platform interpreted - scripting language. This package contains the headers and libraries - needed to embed or extend Tcl. diff --git a/debian/copyright b/debian/copyright deleted file mode 100644 index 075c312..0000000 --- a/debian/copyright +++ /dev/null @@ -1,141 +0,0 @@ -This package was originally debianized by David Engel -from sources obtained at http://prdownloads.sourceforge.net/tcl - -List of copyright holders mentioned in individual files: - -Copyright 1983, 1988-1994 The Regents of the University of California -Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans -Copyright 1992-1996 Free Software Foundation, Inc. -Copyright 1993-1994 Lockheed Missle & Space Company, AI Center -Copyright 1993-1997 Bell Labs Innovations for Lucent Technologies -Copyright 1993-1997 Lucent Technologies -Copyright 1994-1998 Sun Microsystems, Inc. -Copyright 1995 General Electric Company -Copyright 1995 Dave Nebinger -Copyright 1995-1997 Roger E. Critchlow Jr -Copyright 1996 Lucent Technologies and Jim Ingham -Copyright 1997-2000 Ajuba Solutions -Copyright 1998-2000 Scriptics Corporation -Copyright 1998-1999 Henry Spencer -Copyright 1998 Paul Duffin -Copyright 1998 Mark Harrison -Copyright 1999 America Online, Inc. -Copyright 1999-2000 Andreas Kupries -Copyright 2000-2001 ActiveState Corporation, et al -Copyright 2001 ActiveState Tool Corp. -Copyright 2001-2002 Apple Computer, Inc. -Copyright 2001-2002 ActiveState Corporation -Copyright 2001-2002 Vincent Darley -Copyright 2001-2002 Donal K. Fellows -Copyright 2001-2003 Kevin B. Kenny -Copyright 2001-2002 David Gravereaux -Contributions from Don Porter, NIST, 2002-2003. (not subject to US copyright) -Copyright 2005 Tcl Core Team -Copyright 2005 Daniel A. Steffen - -Copyright: - -This software is copyrighted by the Regents of the University of -California, Sun Microsystems, Inc., Scriptics Corporation, -and other parties. The following terms apply to all files associated -with the software unless explicitly disclaimed in individual files. - -The authors hereby grant permission to use, copy, modify, distribute, -and license this software and its documentation for any purpose, provided -that existing copyright notices are retained in all copies and that this -notice is included verbatim in any distributions. No written agreement, -license, or royalty fee is required for any of the authorized uses. -Modifications to this software may be copyrighted by their authors -and need not follow the licensing terms described here, provided that -the new terms are clearly indicated on the first page of each file where -they apply. - -IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY -FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY -DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. - -THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE -IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE -NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR -MODIFICATIONS. - -GOVERNMENT USE: If you are acquiring this software on behalf of the -U.S. government, the Government shall have only "Restricted Rights" -in the software and related documentation as defined in the Federal -Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you -are acquiring the software on behalf of the Department of Defense, the -software shall be classified as "Commercial Computer Software" and the -Government shall have only "Restricted Rights" as defined in Clause -252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the -authors grant the U.S. Government and others acting in its behalf -permission to use and distribute the software in accordance with the -terms specified in this license. - -Several files are distributed under other conditions: - -compat/strftime.c: -/* - * strftime.c -- - * - * This file contains a modified version of the BSD 4.4 strftime - * function. - * - * This file is a modified version of the strftime.c file from the BSD 4.4 - * source. See the copyright notice below for details on redistribution - * restrictions. The "license.terms" file does not apply to this file. - * - * Changes 2002 Copyright (c) 2002 ActiveState Corporation. - * - * RCS: @(#) $Id: strftime.c,v 1.10.2.3 2005/11/04 18:18:04 kennykb Exp $ - */ - -/* - * Copyright (c) 1989 The Regents of the University of California. - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. All advertising materials mentioning features or use of this software - * must display the following acknowledgement: - * This product includes software developed by the University of - * California, Berkeley and its contributors. - * 4. Neither the name of the University nor the names of its contributors - * may be used to endorse or promote products derived from this software - * without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND - * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE - * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS - * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) - * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY - * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF - * SUCH DAMAGE. - */ - -compat/dlfcn.h and unix/tclLoadAix.c: - * This file is subject to the following copyright notice, which is - * different from the notice used elsewhere in Tcl but rougly - * equivalent in meaning. - * - * Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH - * Not derived from licensed software. - * - * Permission is granted to freely use, copy, modify, and redistribute - * this software, provided that the author is not construed to be liable - * for any results of using the software, alterations are clearly marked - * as such, and this notice is not modified. - diff --git a/debian/rules b/debian/rules deleted file mode 100755 index a4b3bd4..0000000 --- a/debian/rules +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/make -f -# debian/rules that uses debhelper. - -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 - -DEB_HOST_GNU_TYPE := $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE) -DEB_BUILD_GNU_TYPE := $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) - -export QUILT_PATCHES := debian/patches - -v = 8.6 - -ifneq (,$(findstring debug,$(DEB_BUILD_OPTIONS))) -CFLAGS=-g -O0 -else -# See bug #446335 -CFLAGS=-g -O2 -fno-unit-at-a-time -endif - -unpatch: - dh_testdir - quilt pop -a || test $$? = 2 - rm -rf patch-stamp .pc - -patch: patch-stamp -patch-stamp: - dh_testdir - quilt push -a || test $$? = 2 - touch patch-stamp - -build: build-stamp -build-stamp: patch-stamp - dh_testdir -# So so ugly but it works... - touch generic/tclStubInit.c - cd unix && \ - CFLAGS="$(CFLAGS)" \ - ac_cv_func_strtod=yes \ - tcl_cv_strtod_buggy=1 \ - ./configure --host=$(DEB_HOST_GNU_TYPE) \ - --build=$(DEB_BUILD_GNU_TYPE) \ - --prefix=/opt/sdltk86 \ - --includedir=/opt/sdltk86/include \ - --enable-shared \ - --mandir=/opt/sdltk86/man \ - --enable-man-symlinks \ - --enable-man-compression=gzip \ - --enable-threads \ - --without-tzdata \ - --with-zipfs && \ - touch ../generic/tclStubInit.c && \ - $(MAKE) -# Build the static library. - cd unix && \ - ar cr libtcl$(v).a *.o && \ - ar d libtcl$(v).a tclAppInit.o && \ - ranlib libtcl$(v).a - touch build-stamp - -clean: clean-patched unpatch - dh_testdir - dh_testroot - dh_clean - -clean-patched: - dh_testdir - dh_testroot - rm -f build-stamp install-stamp - cd unix && [ ! -f Makefile ] || $(MAKE) distclean -# Remove forgotten files - rm -f tests/pkg/pkga.so unix/config.log unix/Tcltest.so - -install: install-stamp -install-stamp: build-stamp - dh_testdir - dh_testroot - dh_clean -k - dh_installdirs - cd unix && \ - GZIP=-9 \ - $(MAKE) INSTALL_ROOT=`pwd`/../debian/tmp \ - MAN_INSTALL_DIR=`pwd`/../debian/tmp/opt/sdltk86/man \ - install install-private-headers install-packages -# Fix up the libraries. - cp unix/libtcl$(v).a debian/tmp/opt/sdltk86/lib - touch install-stamp - -# Build architecture-independent files here. -binary-indep: build install - dh_testdir -i - dh_testroot -i - dh_movefiles -i - dh_installdocs -i - dh_installchangelogs -i ChangeLog - dh_compress -i - dh_fixperms -i - dh_installdeb -i - dh_gencontrol -i - dh_md5sums -i - dh_builddeb -i - -# Build architecture-dependent files here. -binary-arch: build install - dh_testdir -a - dh_testroot -a - dh_movefiles -a -# now, fix up file locations for .sh - mv debian/sdltcl$(v)/opt/sdltk86/lib/tclConfig.sh \ - debian/sdltcl$(v)-dev/opt/sdltk86/lib - dh_installdocs -a - dh_installmenu -a - dh_installchangelogs -a ChangeLog - dh_fixperms -a - dh_strip -a - dh_compress -a - dh_makeshlibs -a -V 'sdltcl$(v) (>= 8.6.2)' -XTcltest - dh_installdeb -a - dh_shlibdeps -a -ldebian/sdltcl$(v)/opt/sdltk86/lib - dh_gencontrol -a - dh_md5sums -a - dh_builddeb -a - -source diff: - @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false - -binary: binary-indep binary-arch - -.PHONY: patch unpatch clean-patched build clean binary-indep binary-arch binary install - diff --git a/debian/sdltcl8.6-dev.dirs b/debian/sdltcl8.6-dev.dirs deleted file mode 100644 index 4de4819..0000000 --- a/debian/sdltcl8.6-dev.dirs +++ /dev/null @@ -1,2 +0,0 @@ -opt/sdltk86/lib -opt/sdltk86/include diff --git a/debian/sdltcl8.6-dev.files b/debian/sdltcl8.6-dev.files deleted file mode 100644 index 5cd0878..0000000 --- a/debian/sdltcl8.6-dev.files +++ /dev/null @@ -1,2 +0,0 @@ -opt/sdltk86/include -opt/sdltk86/lib/*.a diff --git a/debian/sdltcl8.6-doc.files b/debian/sdltcl8.6-doc.files deleted file mode 100644 index 56ca7e7..0000000 --- a/debian/sdltcl8.6-doc.files +++ /dev/null @@ -1,2 +0,0 @@ -opt/sdltk86/man/man3 -opt/sdltk86/man/mann diff --git a/debian/sdltcl8.6.files b/debian/sdltcl8.6.files deleted file mode 100644 index 501d10a..0000000 --- a/debian/sdltcl8.6.files +++ /dev/null @@ -1,18 +0,0 @@ -opt/sdltk86/bin -opt/sdltk86/lib/tcl8 -opt/sdltk86/lib/tcl8/* -opt/sdltk86/lib/tcl8.6 -opt/sdltk86/lib/tcl8.6/* -opt/sdltk86/lib/*.so -opt/sdltk86/lib/*.sh -opt/sdltk86/lib/itcl* -opt/sdltk86/lib/itcl*/* -opt/sdltk86/lib/pkgconfig -opt/sdltk86/lib/pkgconfig/* -opt/sdltk86/lib/sqlite* -opt/sdltk86/lib/sqlite*/* -opt/sdltk86/lib/tdbc* -opt/sdltk86/lib/tdbc*/* -opt/sdltk86/lib/thread* -opt/sdltk86/lib/thread*/* -opt/sdltk86/man/man1 diff --git a/debian/shlibs.local b/debian/shlibs.local deleted file mode 100644 index 7da5dd4..0000000 --- a/debian/shlibs.local +++ /dev/null @@ -1 +0,0 @@ -libtcl8.6 1 diff --git a/pkgs/Android.mk b/pkgs/Android.mk deleted file mode 100644 index 5053e7d..0000000 --- a/pkgs/Android.mk +++ /dev/null @@ -1 +0,0 @@ -include $(call all-subdir-makefiles) diff --git a/tcl-config.mk b/tcl-config.mk deleted file mode 100644 index e072516..0000000 --- a/tcl-config.mk +++ /dev/null @@ -1,62 +0,0 @@ -tcl_includes := $(tcl_path)/generic $(tcl_path)/unix - -tcl_cflags := \ - -DHAVE_SYS_SELECT_H=1 \ - -DHAVE_LIMITS_H=1 \ - -DHAVE_UNISTD_H=1 \ - -DHAVE_SYS_PARAM_H=1 \ - -D_LARGEFILE64_SOURCE=1 \ - -DTCL_WIDE_INT_TYPE="long long" \ - -DTCL_SHLIB_EXT="\".so\"" \ - -DHAVE_CAST_TO_UNION=1 \ - -DHAVE_GETCWD=1 \ - -DHAVE_OPENDIR=1 \ - -DHAVE_MKSTEMP=1 \ - -DHAVE_MKSTEMPS=1 \ - -DHAVE_STRSTR=1 \ - -DHAVE_STRTOL=1 \ - -DHAVE_STRTOLL=1 \ - -DHAVE_STRTOULL=1 \ - -DHAVE_TMPNAM=1 \ - -DHAVE_WAITPID=1 \ - -DHAVE_STRUCT_ADDRINFO=1 \ - -DHAVE_STRUCT_IN6_ADDR=1 \ - -DHAVE_STRUCT_SOCKADDR_IN6=1 \ - -DHAVE_STRUCT_SOCKADDR_STORAGE=1 \ - -DHAVE_GETHOSTBYNAME_R=1 \ - -DUSE_TERMIOS=1 \ - -DHAVE_MKTIME=1 \ - -DUSE_INTERP_ERRORLINE=1 \ - -DHAVE_SYS_TIME_H=1 \ - -DTIME_WITH_SYS_TIME=1 \ - -DHAVE_TM_ZONE=1 \ - -DHAVE_GMTIME_R=1 \ - -DHAVE_LOCALTIME_R=1 \ - -DHAVE_TM_GMTOFF=1 \ - -DHAVE_TIMEZONE_VAR=1 \ - -DHAVE_ST_BLKSIZE=1 \ - -DSTDC_HEADERS=1 \ - -DHAVE_INTPTR_T=1 \ - -DHAVE_UINTPTR_T=1 \ - -DHAVE_SIGNED_CHAR=1 \ - -DHAVE_SYS_IOCTL_H=1 \ - -DHAVE_MEMCPY=1 \ - -DHAVE_MEMMOVE=1 \ - -DVOID=void \ - -DNO_UNION_WAIT=1 \ - -DHAVE_ZLIB=1 \ - -DMP_PREC=4 \ - -DTCL_TOMMATH=1 \ - -D_REENTRANT=1 \ - -D_THREADSAFE=1 \ - -DTCL_UTF_MAX=6 \ - -DTCL_THREADS=1 \ - -DTCL_PTHREAD_ATFORK=1 \ - -DUSE_THREAD_ALLOC=1 \ - -DTCL_CFGVAL_ENCODING="\"utf-8\"" \ - -DTCL_UNLOAD_DLLS=1 \ - -DTCL_CFG_OPTIMIZED=1 \ - -DZIPFS_IN_TCL=1 \ - -DTCL_PACKAGE_PATH="\"/assets\"" \ - -DTCL_LIBRARY="\"/assets/tcl8.6\"" - -- cgit v0.12 From b0a98f480d3a16432d023ddb8cb4ba8e22edd973 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 10:03:06 +0000 Subject: Undo more Android-specific changes, which don't form part of Zipfs, as further preparation for Zipfs TIP. Rename zipfs.h to tclZipfs.h, so it can be installed together with tcl.h --- generic/tclIOUtil.c | 2 +- generic/tclMain.c | 197 ---------------------------------------------------- generic/tclZipfs.h | 65 +++++++++++++++++ generic/zipfs.c | 6 +- generic/zipfs.h | 66 ------------------ unix/Makefile.in | 4 +- unix/configure | 18 ----- unix/configure.in | 8 --- unix/tclUnixInit.c | 8 --- win/Makefile.in | 1 + win/configure | 19 ----- win/configure.in | 8 --- win/makefile.vc | 1 + 13 files changed, 75 insertions(+), 328 deletions(-) create mode 100644 generic/tclZipfs.h delete mode 100644 generic/zipfs.h diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 9bc868b..0ef6d3b 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -192,7 +192,7 @@ const Tcl_Filesystem tclNativeFilesystem = { }; #ifdef ZIPFS_IN_TCL -extern Tcl_Filesystem zipfsFilesystem; +MODULE_SCOPE Tcl_Filesystem zipfsFilesystem; #endif /* diff --git a/generic/tclMain.c b/generic/tclMain.c index 6acd15d..927de7e 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -34,15 +34,6 @@ #include "tclInt.h" -#ifdef ZIPFS_IN_TCL -#include "zipfs.h" -#endif - -#ifdef ANDROID -#undef ZIPFS_BOOTDIR -#define ZIPFS_BOOTDIR "/assets" -#endif - /* * The default prompt used when the user has not overridden it. */ @@ -60,7 +51,6 @@ # define TCHAR char # define TEXT(arg) arg # define _tcscmp strcmp -# define _tcsncmp strncmp #endif /* @@ -325,21 +315,9 @@ Tcl_MainEx( Tcl_MainLoopProc *mainLoopProc; Tcl_Channel chan; InteractiveState is; -#ifdef ZIPFS_IN_TCL - const char *zipFile = NULL; - Tcl_Obj *zipval = NULL; - int autoRun = 1; - int zipOk = TCL_ERROR; -#ifndef ANDROID - const char *exeName; -#endif -#endif TclpSetInitialEncodings(); TclpFindExecutable((const char *)argv[0]); -#if defined(ZIPFS_IN_TCL) && !defined(ANDROID) - exeName = Tcl_GetNameOfExecutable(); -#endif Tcl_InitMemory(interp); @@ -369,26 +347,6 @@ Tcl_MainEx( Tcl_DecrRefCount(value); argc -= 3; argv += 3; -#ifdef ZIPFS_IN_TCL - } else if (argc > 2) { - int length = strlen((char *) argv[1]); - if ((length >= 2) && - (0 == _tcsncmp(TEXT("-zip"), argv[1], length))) { - argc--; - argv++; - if ((argc > 1) && (argv[1][0] != (TCHAR) '-')) { - zipval = NewNativeObj(argv[1], -1); - zipFile = Tcl_GetString(zipval); - autoRun = 0; - argc--; - argv++; - } - } else if ('-' != argv[1][0]) { - Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); - argc--; - argv++; - } -#endif } else if ((argc > 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; @@ -422,67 +380,6 @@ Tcl_MainEx( Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); -#ifdef ZIPFS_IN_TCL - zipOk = Tclzipfs_Init(interp); - if (zipOk == TCL_OK) { - int relax = 0; - - if (zipFile == NULL) { - relax = 1; -#ifdef ANDROID - zipFile = getenv("PACKAGE_CODE_PATH"); - if (zipFile == NULL) { - zipFile = Tcl_GetNameOfExecutable(); - } -#else - zipFile = exeName; -#endif - } - if (zipFile != NULL) { -#ifdef ANDROID - zipOk = Tclzipfs_Mount(interp, zipFile, "", NULL); -#else - zipOk = Tclzipfs_Mount(interp, zipFile, exeName, NULL); -#endif - if (!relax && (zipOk != TCL_OK)) { - exitCode = 1; - goto done; - } - } else { - zipOk = TCL_ERROR; - } - Tcl_ResetResult(interp); - } - if (zipOk == TCL_OK) { -#ifdef ZIPFS_BOOTDIR - char *tcl_lib = ZIPFS_BOOTDIR "/tcl" TCL_VERSION; - char *tcl_pkg = ZIPFS_BOOTDIR; -#else - char *tcl_lib; - char *tcl_pkg = (char *) exeName; - Tcl_DString dsLib; - - Tcl_DStringInit(&dsLib); - Tcl_DStringAppend(&dsLib, exeName, -1); - Tcl_DStringAppend(&dsLib, "/tcl" TCL_VERSION, -1); - tcl_lib = Tcl_DStringValue(&dsLib); -#endif - Tcl_SetVar2(interp, "env", "TCL_LIBRARY", tcl_lib, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_libPath", tcl_lib, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_library", tcl_lib, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_pkgPath", tcl_pkg, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "auto_path", tcl_lib, - TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT); -#ifndef ZIPFS_BOOTDIR - Tcl_DStringFree(&dsLib); -#endif - } - if (zipval != NULL) { - Tcl_DecrRefCount(zipval); - zipval = NULL; - } -#endif - /* * Invoke application-specific initialization. */ @@ -512,100 +409,6 @@ Tcl_MainEx( Tcl_CreateExitHandler(FreeMainInterp, interp); } -#ifdef ZIPFS_IN_TCL - /* - * Setup auto loading info to point to mounted ZIP file. - */ - - if (zipOk == TCL_OK) { -#ifdef ZIPFS_BOOTDIR - char *tcl_lib = ZIPFS_BOOTDIR "/tcl" TCL_VERSION; - char *tcl_pkg = ZIPFS_BOOTDIR; -#else - char *tcl_lib; - char *tcl_pkg = (char *) exeName; - Tcl_DString dsLib; - - Tcl_DStringInit(&dsLib); - Tcl_DStringAppend(&dsLib, exeName, -1); - Tcl_DStringAppend(&dsLib, "/tcl" TCL_VERSION, -1); - tcl_lib = Tcl_DStringValue(&dsLib); -#endif - Tcl_SetVar(interp, "tcl_libPath", tcl_lib, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_library", tcl_lib, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_pkgPath", tcl_pkg, TCL_GLOBAL_ONLY); -#ifndef ZIPFS_BOOTDIR - Tcl_DStringFree(&dsLib); -#endif - - /* - * We need to re-init encoding (after initializing Tcl), - * otherwise "encoding system" will return "identity" - */ - - TclpSetInitialEncodings(); - } - - /* - * Set embedded application startup file, if any. - */ - - if ((zipOk == TCL_OK) && autoRun) { - char *filename; - Tcl_Channel chan; -#ifdef ZIPFS_BOOTDIR - filename = ZIPFS_BOOTDIR "/app/main.tcl"; -#else - Tcl_DString dsFile; - - Tcl_DStringInit(&dsFile); - Tcl_DStringAppend(&dsFile, exeName, -1); - Tcl_DStringAppend(&dsFile, "/app/main.tcl", -1); - filename = Tcl_DStringValue(&dsFile); -#endif - chan = Tcl_OpenFileChannel(NULL, filename, "r", 0); - if (chan != (Tcl_Channel) NULL) { - Tcl_Obj *arg; - - Tcl_Close(NULL, chan); - - /* - * Push back script file to argv, if any. - */ - if ((arg = Tcl_GetStartupScript(NULL)) != NULL) { - Tcl_Obj *v, *no; - - no = Tcl_NewStringObj("argv", 4); - v = Tcl_ObjGetVar2(interp, no, NULL, TCL_GLOBAL_ONLY); - if (v != NULL) { - Tcl_Obj **objv, *nv; - int objc, i; - - objc = 0; - Tcl_ListObjGetElements(NULL, v, &objc, &objv); - nv = Tcl_NewListObj(1, &arg); - for (i = 0; i < objc; i++) { - Tcl_ListObjAppendElement(NULL, nv, objv[i]); - } - Tcl_IncrRefCount(nv); - if (Tcl_ObjSetVar2(interp, no, NULL, nv, TCL_GLOBAL_ONLY) - != NULL) { - Tcl_GlobalEval(interp, "incr argc"); - } - Tcl_DecrRefCount(nv); - } - Tcl_DecrRefCount(no); - } - Tcl_SetStartupScript(Tcl_NewStringObj(filename, -1), NULL); - Tcl_SetVar(interp, "argv0", filename, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); - } -#ifndef ANDROID - Tcl_DStringFree(&dsFile); -#endif - } -#endif - /* * Invoke the script specified on the command line, if any. Must fetch it * again, as the appInitProc might have reset it. diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h new file mode 100644 index 0000000..bf3a3cb --- /dev/null +++ b/generic/tclZipfs.h @@ -0,0 +1,65 @@ +/* + * tclZipfs.h -- + * + * This header file describes the interface of the ZIPFS filesystem + * + * Copyright (c) 2013-2015 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _ZIPFS_H +#define _ZIPFS_H + +#include "tcl.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef ZIPFSAPI +# define ZIPFSAPI extern +#endif + +#ifdef ZIPFS_IN_TK +#define Zipfs_Mount Tkzipfs_Mount +#define Zipfs_Unmount Tkzipfs_Unmount +#define Zipfs_Init Tkzipfs_Init +#define Zipfs_SafeInit Tkzipfs_SafeInit +#ifdef BUILD_tk +# undef ZIPFSAPI +# define ZIPFSAPI DLLEXPORT +#endif +#endif + +#ifdef ZIPFS_IN_TCL +#define Zipfs_Mount Tclzipfs_Mount +#define Zipfs_Unmount Tclzipfs_Unmount +#define Zipfs_Init Tclzipfs_Init +#define Zipfs_SafeInit Tclzipfs_SafeInit +#ifdef BUILD_tcl +# undef ZIPFSAPI +# define ZIPFSAPI DLLEXPORT +#endif +#endif + +ZIPFSAPI int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, + CONST char *mntpt, CONST char *passwd); +ZIPFSAPI int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); +ZIPFSAPI int Zipfs_Init(Tcl_Interp *interp); +ZIPFSAPI int Zipfs_SafeInit(Tcl_Interp *interp); + +#ifdef __cplusplus +} +#endif + +#endif /* _ZIPFS_H */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/zipfs.c b/generic/zipfs.c index 0683c32..6d49f4f 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -24,7 +24,7 @@ #endif #include "tclInt.h" #include "tclFileSystem.h" -#include "zipfs.h" +#include "tclZipfs.h" #ifdef HAVE_ZLIB @@ -3821,7 +3821,9 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, * Define the ZIP filesystem dispatch table. */ -Tcl_Filesystem zipfsFilesystem = { +MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; + +const Tcl_Filesystem zipfsFilesystem = { "zipfs", sizeof (Tcl_Filesystem), TCL_FILESYSTEM_VERSION_2, diff --git a/generic/zipfs.h b/generic/zipfs.h deleted file mode 100644 index 15ca37c..0000000 --- a/generic/zipfs.h +++ /dev/null @@ -1,66 +0,0 @@ -/* - * zipfs.h -- - * - * This header file describes the interface of the ZIPFS filesystem - * used in AndroWish. - * - * Copyright (c) 2013-2015 Christian Werner - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#ifndef _ZIPFS_H -#define _ZIPFS_H - -#include "tcl.h" - -#ifdef __cplusplus -extern "C" { -#endif - -#ifndef ZIPFSAPI -# define ZIPFSAPI extern -#endif - -#ifdef ZIPFS_IN_TK -#define Zipfs_Mount Tkzipfs_Mount -#define Zipfs_Unmount Tkzipfs_Unmount -#define Zipfs_Init Tkzipfs_Init -#define Zipfs_SafeInit Tkzipfs_SafeInit -#ifdef BUILD_tk -# undef ZIPFSAPI -# define ZIPFSAPI DLLEXPORT -#endif -#endif - -#ifdef ZIPFS_IN_TCL -#define Zipfs_Mount Tclzipfs_Mount -#define Zipfs_Unmount Tclzipfs_Unmount -#define Zipfs_Init Tclzipfs_Init -#define Zipfs_SafeInit Tclzipfs_SafeInit -#ifdef BUILD_tcl -# undef ZIPFSAPI -# define ZIPFSAPI DLLEXPORT -#endif -#endif - -ZIPFSAPI int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, - CONST char *mntpt, CONST char *passwd); -ZIPFSAPI int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); -ZIPFSAPI int Zipfs_Init(Tcl_Interp *interp); -ZIPFSAPI int Zipfs_SafeInit(Tcl_Interp *interp); - -#ifdef __cplusplus -} -#endif - -#endif /* _ZIPFS_H */ - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/unix/Makefile.in b/unix/Makefile.in index ebbd61c..c09fb35 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -373,6 +373,7 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclInt.h \ $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ + $(GENERIC_DIR)/tclZipfs.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h \ $(GENERIC_DIR)/tclOO.h \ @@ -383,7 +384,7 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ $(GENERIC_DIR)/tclRegexp.h \ - $(GENERIC_DIR)/zipfs.h + $(GENERIC_DIR)/tclZipfs.h GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ @@ -954,6 +955,7 @@ install-headers: @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclPlatDecls.h \ + $(GENERIC_DIR)/tclZipfs.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h ; \ do \ diff --git a/unix/configure b/unix/configure index 3e72a0d..c19a77a 100755 --- a/unix/configure +++ b/unix/configure @@ -869,7 +869,6 @@ Optional Packages: --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values (default: iso8859-1) - --with-zipfs include ZIP filesystem --with-tzdata install timezone data (default: autodetect) Some influential environment variables: @@ -6212,23 +6211,6 @@ cat >>confdefs.h <<\_ACEOF _ACEOF -# Check whether --with-zipfs or --without-zipfs was given. -if test "${with_zipfs+set}" = set; then - withval="$with_zipfs" - tcl_ok=$withval -else - tcl_ok=no -fi; -echo "$as_me:$LINENO: result: $tcl_ok" >&5 -echo "${ECHO_T}$tcl_ok" >&6 -if test $tcl_ok = yes; then - -cat >>confdefs.h <<\_ACEOF -#define ZIPFS_IN_TCL 1 -_ACEOF - -fi - #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called diff --git a/unix/configure.in b/unix/configure.in index 7eeff3b..c7b0edc 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -171,14 +171,6 @@ AS_IF([test $zlib_ok = no], [ AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) -AC_ARG_WITH(zipfs, - AC_HELP_STRING([--with-zipfs], - [include ZIP filesystem]), - [tcl_ok=$withval], [tcl_ok=no]) -AC_MSG_RESULT([$tcl_ok]) -if test $tcl_ok = yes; then - AC_DEFINE(ZIPFS_IN_TCL, 1, [Include ZIP filesystem?]) -fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index e8ccc76..5e4ef0a 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -9,9 +9,6 @@ */ #include "tclInt.h" -#ifdef ZIPFS_IN_TCL -#include "zipfs.h" -#endif #include #include #ifdef HAVE_LANGINFO @@ -544,11 +541,6 @@ TclpInitLibraryPath( */ str = defaultLibraryDir; -#ifdef ZIPFS_IN_TCL - if (Tclzipfs_Mount(NULL, NULL, NULL, NULL) == TCL_OK) { - str = ""; - } -#endif } if (str[0] != '\0') { objPtr = Tcl_NewStringObj(str, -1); diff --git a/win/Makefile.in b/win/Makefile.in index 00f5c99..f6d006b 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -636,6 +636,7 @@ install-libraries: libraries install-tzdata install-msgs @echo "Installing header files"; @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ + "$(GENERIC_DIR)/tclZipfs.h" \ "$(GENERIC_DIR)/tclPlatDecls.h" \ "$(GENERIC_DIR)/tclTomMath.h" \ "$(GENERIC_DIR)/tclTomMathDecls.h"; \ diff --git a/win/configure b/win/configure index 27f2c10..3ebc697 100755 --- a/win/configure +++ b/win/configure @@ -853,7 +853,6 @@ Optional Packages: --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values --with-celib=DIR use Windows/CE support library from DIR - --with-zipfs include ZIP filesystem Some influential environment variables: CC C compiler command @@ -4409,24 +4408,6 @@ cat >>confdefs.h <<\_ACEOF _ACEOF -# Check whether --with-zipfs or --without-zipfs was given. -if test "${with_zipfs+set}" = set; then - withval="$with_zipfs" - tcl_ok=$withval -else - tcl_ok=no -fi; -echo "$as_me:$LINENO: result: $tcl_ok" >&5 -echo "${ECHO_T}$tcl_ok" >&6 -if test $tcl_ok = yes; then - -cat >>confdefs.h <<\_ACEOF -#define ZIPFS_IN_TCL 1 -_ACEOF - -fi - - echo "$as_me:$LINENO: checking for intptr_t" >&5 echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 if test "${ac_cv_type_intptr_t+set}" = set; then diff --git a/win/configure.in b/win/configure.in index c8ab2e3..9e9df90 100644 --- a/win/configure.in +++ b/win/configure.in @@ -141,14 +141,6 @@ AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) -AC_ARG_WITH(zipfs, - AC_HELP_STRING([--with-zipfs], - [include ZIP filesystem]), - [tcl_ok=$withval], [tcl_ok=no]) -AC_MSG_RESULT([$tcl_ok]) -if test $tcl_ok = yes; then - AC_DEFINE(ZIPFS_IN_TCL, 1, [Include ZIP filesystem?]) -fi AC_CHECK_TYPE([intptr_t], [ AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ diff --git a/win/makefile.vc b/win/makefile.vc index ecfcecf..82dd655 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1115,6 +1115,7 @@ install-libraries: tclConfig install-msgs install-tzdata @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclZipfs.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" -- cgit v0.12 From 4d007159025e0fc8ea75aae346bc7e6588e391c2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 10:49:36 +0000 Subject: CONST -> const --- generic/tclZipfs.h | 6 ++--- generic/zipfs.c | 68 +++++++++++++++++++++++++++--------------------------- 2 files changed, 37 insertions(+), 37 deletions(-) diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h index bf3a3cb..75dcb13 100644 --- a/generic/tclZipfs.h +++ b/generic/tclZipfs.h @@ -44,9 +44,9 @@ extern "C" { #endif #endif -ZIPFSAPI int Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, - CONST char *mntpt, CONST char *passwd); -ZIPFSAPI int Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname); +ZIPFSAPI int Zipfs_Mount(Tcl_Interp *interp, const char *zipname, + const char *mntpt, const char *passwd); +ZIPFSAPI int Zipfs_Unmount(Tcl_Interp *interp, const char *zipname); ZIPFSAPI int Zipfs_Init(Tcl_Interp *interp); ZIPFSAPI int Zipfs_SafeInit(Tcl_Interp *interp); diff --git a/generic/zipfs.c b/generic/zipfs.c index 6d49f4f..a9f0a39 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -109,7 +109,7 @@ #if defined(_WIN32) || defined(_WIN64) #define HAS_DRIVES 1 -static CONST char drvletters[] = +static const char drvletters[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; #else #define HAS_DRIVES 0 @@ -223,7 +223,7 @@ static struct { * For password rotation. */ -static CONST char pwrot[16] = { +static const char pwrot[16] = { 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 }; @@ -232,7 +232,7 @@ static CONST char pwrot[16] = { * Table to compute CRC32. */ -static CONST unsigned int crc32tab[256] = { +static const unsigned int crc32tab[256] = { 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, @@ -458,10 +458,10 @@ ToDosDate(time_t when) */ static int -CountSlashes(CONST char *string) +CountSlashes(const char *string) { int count = 0; - CONST char *p = string; + const char *p = string; while (*p != '\0') { if (*p == '/') { @@ -491,7 +491,7 @@ CountSlashes(CONST char *string) */ static char * -CanonicalPath(CONST char *root, CONST char *tail, Tcl_DString *dsPtr) +CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr) { char *path; int i, j, c, isunc = 0; @@ -598,7 +598,7 @@ CanonicalPath(CONST char *root, CONST char *tail, Tcl_DString *dsPtr) */ static char * -AbsolutePath(CONST char *path, +AbsolutePath(const char *path, #if HAS_DRIVES int *drvPtr, #endif @@ -832,7 +832,7 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) */ static int -ZipFSOpenArchive(Tcl_Interp *interp, CONST char *zipname, int needZip, +ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile *zf) { int i; @@ -1049,8 +1049,8 @@ error: */ int -Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, - CONST char *passwd) +Zipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, + const char *passwd) { char *realname, *p; int i, pwlen, isNew; @@ -1420,7 +1420,7 @@ nextent: */ int -Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname) +Zipfs_Unmount(Tcl_Interp *interp, const char *zipname) { char *realname; ZipFile *zf; @@ -1504,7 +1504,7 @@ done: static int ZipFSMountCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv) + int argc, const char **argv) { if (argc > 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -1534,7 +1534,7 @@ ZipFSMountCmd(ClientData clientData, Tcl_Interp *interp, static int ZipFSUnmountCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv) + int argc, const char **argv) { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -1563,7 +1563,7 @@ ZipFSUnmountCmd(ClientData clientData, Tcl_Interp *interp, static int ZipFSMkKeyCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv) + int argc, const char **argv) { int len, i = 0; char pwbuf[264]; @@ -1621,15 +1621,15 @@ ZipFSMkKeyCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipAddFile(Tcl_Interp *interp, CONST char *path, CONST char *name, - Tcl_Channel out, CONST char *passwd, +ZipAddFile(Tcl_Interp *interp, const char *path, const char *name, + Tcl_Channel out, const char *passwd, char *buf, int bufsize, Tcl_HashTable *fileHash) { Tcl_Channel in; Tcl_HashEntry *hPtr; ZipEntry *z; z_stream stream; - CONST char *zpath; + const char *zpath; int nbyte, nbytecompr, len, crc, flush, pos[3], zpathlen, olen; int mtime = 0, isNew, align = 0, cmeth; unsigned long keys[3], keys0[3]; @@ -1947,11 +1947,11 @@ seekErr: static int ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, - int isImg, int argc, CONST char **argv) + int isImg, int argc, const char **argv) { Tcl_Channel out; int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, largc, pos[3]; - CONST char **largv; + const char **largv; Tcl_DString ds; ZipEntry *z; Tcl_HashEntry *hPtr; @@ -2056,7 +2056,7 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, slen = strlen(argv[3]); } for (i = 0; i < largc; i++) { - CONST char *name = largv[i]; + const char *name = largv[i]; if (slen > 0) { len = strlen(name); @@ -2080,7 +2080,7 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, pos[1] = Tcl_Tell(out); count = 0; for (i = 0; i < largc; i++) { - CONST char *name = largv[i]; + const char *name = largv[i]; if (slen > 0) { len = strlen(name); @@ -2175,7 +2175,7 @@ done: static int ZipFSMkZipCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv) + int argc, const char **argv) { return ZipFSMkZipOrImgCmd(clientData, interp, 0, argc, argv); } @@ -2199,7 +2199,7 @@ ZipFSMkZipCmd(ClientData clientData, Tcl_Interp *interp, static int ZipFSMkImgCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv) + int argc, const char **argv) { return ZipFSMkZipOrImgCmd(clientData, interp, 1, argc, argv); } @@ -2224,7 +2224,7 @@ ZipFSMkImgCmd(ClientData clientData, Tcl_Interp *interp, static int ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]) + int objc, Tcl_Obj *const objv[]) { char *filename; int exists; @@ -2262,7 +2262,7 @@ ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, static int ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]) + int objc, Tcl_Obj *const objv[]) { char *filename; ZipEntry *z; @@ -2307,7 +2307,7 @@ ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, static int ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]) + int objc, Tcl_Obj *const objv[]) { char *pattern = NULL; Tcl_RegExp regexp = NULL; @@ -2496,7 +2496,7 @@ ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) */ static int -ZipChannelWrite(ClientData instanceData, CONST char *buf, +ZipChannelWrite(ClientData instanceData, const char *buf, int toWrite, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; @@ -3176,7 +3176,7 @@ Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) static int Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, - Tcl_Obj *pathPtr, CONST char *pattern, + Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types) { Tcl_HashEntry *hPtr; @@ -3606,10 +3606,10 @@ Zip_FSChdirProc(Tcl_Obj *pathPtr) *------------------------------------------------------------------------- */ -static CONST char *CONST86 * +static const char *const * Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) { - static CONST char *attrs[] = { + static const char *const attrs[] = { "-uncompsize", "-compsize", "-offset", @@ -3885,7 +3885,7 @@ static int Zipfs_doInit(Tcl_Interp *interp, int safe) { #ifdef HAVE_ZLIB - static CONST char findproc[] = + static const char findproc[] = "proc ::zipfs::find dir {\n" " set result {}\n" " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n" @@ -4009,14 +4009,14 @@ Zipfs_SafeInit(Tcl_Interp *interp) */ int -Zipfs_Mount(Tcl_Interp *interp, CONST char *zipname, CONST char *mntpt, - CONST char *passwd) +Zipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, + const char *passwd) { return Zipfs_doInit(interp, 1); } int -Zipfs_Unmount(Tcl_Interp *interp, CONST char *zipname) +Zipfs_Unmount(Tcl_Interp *interp, const char *zipname) { return Zipfs_doInit(interp, 1); } -- cgit v0.12 From 8ecd6aeb5b622ad2cc8c4690880e066c60abec54 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 11:29:38 +0000 Subject: Make it compile warning-free with MSVC compiler (VS2013, at least). Other tweaks. --- generic/tclPkgConfig.c | 20 -------------------- generic/zipfs.c | 31 ++++++++++++++++--------------- unix/Makefile.in | 3 +-- unix/tclLoadDl.c | 40 +--------------------------------------- unix/tclUnixFCmd.c | 21 --------------------- unix/tclUnixInit.c | 4 ---- win/makefile.vc | 6 +++++- 7 files changed, 23 insertions(+), 102 deletions(-) diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c index 3f8178e..466d535 100644 --- a/generic/tclPkgConfig.c +++ b/generic/tclPkgConfig.c @@ -100,35 +100,19 @@ static Tcl_Config const cfg[] = { /* Runtime paths to various stuff */ -#ifdef ANDROID - {"libdir,runtime", ""}, - {"bindir,runtime", ""}, - {"scriptdir,runtime", ""}, - {"includedir,runtime", ""}, - {"docdir,runtime", ""}, -#else {"libdir,runtime", CFG_RUNTIME_LIBDIR}, {"bindir,runtime", CFG_RUNTIME_BINDIR}, {"scriptdir,runtime", CFG_RUNTIME_SCRDIR}, {"includedir,runtime", CFG_RUNTIME_INCDIR}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, -#endif /* Installation paths to various stuff */ -#ifdef ANDROID - {"libdir,install", ""}, - {"bindir,install", ""}, - {"scriptdir,install", ""}, - {"includedir,install", ""}, - {"docdir,install", ""}, -#else {"libdir,install", CFG_INSTALL_LIBDIR}, {"bindir,install", CFG_INSTALL_BINDIR}, {"scriptdir,install", CFG_INSTALL_SCRDIR}, {"includedir,install", CFG_INSTALL_INCDIR}, {"docdir,install", CFG_INSTALL_DOCDIR}, -#endif /* Last entry, closes the array */ {NULL, NULL} @@ -139,10 +123,6 @@ TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp) /* Interpreter the configuration command is * registered in. */ { -#if defined(ANDROID) && !defined(TCL_CFGVAL_ENCODING) -#define TCL_CFGVAL_ENCODING "utf-8" -#endif - Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING); } diff --git a/generic/zipfs.c b/generic/zipfs.c index a9f0a39..67390a6 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -2561,19 +2561,19 @@ ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) *errloc = EINVAL; return -1; } + if (offset < 0) { + *errloc = EINVAL; + return -1; + } if (info->iswr) { - if (offset > info->nmax) { + if ((unsigned long) offset > info->nmax) { *errloc = EINVAL; return -1; } - if (offset > info->nbyte) { + if ((unsigned long) offset > info->nbyte) { info->nbyte = offset; } - } else if (offset > info->nbyte) { - *errloc = EINVAL; - return -1; - } - if (offset < 0) { + } else if ((unsigned long) offset > info->nbyte) { *errloc = EINVAL; return -1; } @@ -2772,12 +2772,12 @@ merror0: info->nbyte = 0; } else { if (z->data != NULL) { - i = z->nbyte; - if (i > info->nmax) { - i = info->nmax; + unsigned int j = z->nbyte; + if (j > info->nmax) { + j = info->nmax; } - memcpy(info->ubuf, z->data, i); - info->nbyte = i; + memcpy(info->ubuf, z->data, j); + info->nbyte = j; } else { unsigned char *zbuf = z->zipfile->data + z->offset; @@ -2809,15 +2809,16 @@ merror0: stream.opaque = Z_NULL; stream.avail_in = z->nbytecompr; if (z->isenc) { + unsigned int j; stream.avail_in -= 12; cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); if (cbuf == NULL) { goto merror0; } - for (i = 0; i < stream.avail_in; i++) { - ch = info->ubuf[i]; - cbuf[i] = zdecode(info->keys, crc32tab, ch); + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + cbuf[j] = zdecode(info->keys, crc32tab, ch); } stream.next_in = cbuf; } else { diff --git a/unix/Makefile.in b/unix/Makefile.in index 3e4cfc7..d65dceb 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -383,8 +383,7 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ - $(GENERIC_DIR)/tclRegexp.h \ - $(GENERIC_DIR)/tclZipfs.h + $(GENERIC_DIR)/tclRegexp.h GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index bb2361c..aec071c 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -97,11 +97,7 @@ TclpDlopen( } else { dlopenflags |= RTLD_NOW; } - if (native == NULL) { - handle = NULL; - } else { - handle = dlopen(native, dlopenflags); - } + handle = dlopen(native, dlopenflags); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever @@ -119,41 +115,7 @@ TclpDlopen( handle = dlopen(native, dlopenflags); Tcl_DStringFree(&ds); } -#ifdef ANDROID - /* - * If not an absolute or relative path, try to load - * from $INTERNAL_STORAGE/../lib (the place where the - * system has installed bundled .so files from the .APK) - */ - if (handle == NULL) { - native = Tcl_GetString(pathPtr); - if ((native != NULL) && (strchr(native, '/') == NULL)) { - char *storage = getenv("INTERNAL_STORAGE"); - Tcl_DString ds2; - if ((storage != NULL) && (storage[0] != '\0')) { - Tcl_DStringInit(&ds2); - Tcl_DStringAppend(&ds2, storage, -1); - Tcl_DStringAppend(&ds2, "/../lib/", -1); - Tcl_DStringAppend(&ds2, native, -1); - handle = dlopen(Tcl_DStringValue(&ds2), RTLD_NOW | RTLD_GLOBAL); - Tcl_DStringFree(&ds2); - } - if (handle == NULL) { - storage = getenv("TK_TCL_WISH_LD_LIBS"); - if ((storage != NULL) && (storage[0] != '\0')) { - Tcl_DStringInit(&ds2); - Tcl_DStringAppend(&ds2, storage, -1); - Tcl_DStringAppend(&ds2, "/", -1); - Tcl_DStringAppend(&ds2, native, -1); - handle = - dlopen(Tcl_DStringValue(&ds2), RTLD_NOW | RTLD_GLOBAL); - Tcl_DStringFree(&ds2); - } - } - } - } - #endif if (handle == NULL) { /* * Write the string to a variable first to work around a compiler bug diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 0193dae..3b1b6ca 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -465,9 +465,6 @@ DoCopyFile( /* Used to determine filetype. */ { Tcl_StatBuf dstStatBuf; -#ifdef ANDROID - int ret; -#endif if (S_ISDIR(statBufPtr->st_mode)) { errno = EISDIR; @@ -523,15 +520,7 @@ DoCopyFile( if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ return TCL_ERROR; } -#ifdef ANDROID - ret = CopyFileAtts(src, dst, statBufPtr); - if (ret != TCL_OK && errno == EPERM) { - ret = TCL_OK; - } - return ret; -#else return CopyFileAtts(src, dst, statBufPtr); -#endif default: return TclUnixCopyFile(src, dst, statBufPtr, 0); } @@ -640,11 +629,6 @@ TclUnixCopyFile( return TCL_ERROR; } if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) { -#ifdef ANDROID - if (errno == EPERM) { - return TCL_OK; - } -#endif /* * The copy succeeded, but setting the permissions failed, so be in a * consistent state, we remove the file that was created by the copy. @@ -1219,11 +1203,6 @@ TraversalCopy( Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { return TCL_OK; } -#ifdef ANDROID - if (errno == EPERM) { - return TCL_OK; - } -#endif break; } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 5e4ef0a..5fc0035 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -583,14 +583,10 @@ TclpInitLibraryPath( void TclpSetInitialEncodings(void) { -#ifdef ANDROID - Tcl_SetSystemEncoding(NULL, "utf-8"); -#else Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); -#endif } void diff --git a/win/makefile.vc b/win/makefile.vc index 82dd655..2e04f15 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -344,7 +344,8 @@ COREOBJS = \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ - $(TMP_DIR)\tclZlib.obj + $(TMP_DIR)\tclZlib.obj \ + $(TMP_DIR)\zipfs.obj ZLIBOBJS = \ $(TMP_DIR)\adler32.obj \ @@ -942,6 +943,9 @@ $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? +$(TMP_DIR)\zipfs.obj: $(GENERICDIR)\zipfs.c + $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? + $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ -- cgit v0.12 From 1c3288f038d8b2f9883e3b9f63f37f42e6811969 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 11:59:08 +0000 Subject: Finally, make it compile warning-free using Visual Studio, if ZIPFS_IN_TCL is defined --- generic/zipfs.c | 17 ++++++++--------- win/makefile.vc | 2 +- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index 67390a6..6179542 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -9,6 +9,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include "tclInt.h" +#include "tclFileSystem.h" +#include "tclZipfs.h" #if !defined(_WIN32) && !defined(_WIN64) #include #endif @@ -18,15 +21,10 @@ #include #include #include + #ifdef HAVE_ZLIB #include "zlib.h" #include "zcrypt.h" -#endif -#include "tclInt.h" -#include "tclFileSystem.h" -#include "tclZipfs.h" - -#ifdef HAVE_ZLIB /* * Various constants and offsets found in ZIP archive files. @@ -2904,6 +2902,7 @@ cerror0: z_stream stream; int err; unsigned char *ubuf = NULL; + unsigned int j; memset(&stream, 0, sizeof (stream)); stream.zalloc = Z_NULL; @@ -2917,9 +2916,9 @@ cerror0: info->ubuf = NULL; goto merror; } - for (i = 0; i < stream.avail_in; i++) { - ch = info->ubuf[i]; - ubuf[i] = zdecode(info->keys, crc32tab, ch); + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + ubuf[j] = zdecode(info->keys, crc32tab, ch); } stream.next_in = ubuf; } else { diff --git a/win/makefile.vc b/win/makefile.vc index 2e04f15..80682b9 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -504,7 +504,7 @@ crt = -MT !endif TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" -TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 +TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 -DZIPFS_IN_TCL BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) -- cgit v0.12 From 63b07461da87c89858482b065e62b2d31d765c40 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 12:43:54 +0000 Subject: Fix android compilation (zipfsFilesystem.loadFileProc is a constant, so it cannot be written) --- generic/zipfs.c | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index 6179542..b54d5a2 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -2807,7 +2807,7 @@ merror0: stream.opaque = Z_NULL; stream.avail_in = z->nbytecompr; if (z->isenc) { - unsigned int j; + unsigned int j; stream.avail_in -= 12; cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); @@ -3734,7 +3734,6 @@ Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) return Tcl_NewStringObj("zip", -1); } -#ifndef ANDROID /* *------------------------------------------------------------------------- @@ -3762,6 +3761,14 @@ static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags) { +#ifdef ANDROID + /* + * Force loadFileProc to native implementation since the + * package manger already extracted the shared libraries + * from the APK at install time. + */ + return tclNativeFilesystem.loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); +#else Tcl_FSLoadFileProc2 *loadFileProc; Tcl_Obj *altPath = NULL; int ret = -1; @@ -3813,8 +3820,8 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_DecrRefCount(altPath); } return ret; -} #endif +} /* @@ -3852,11 +3859,7 @@ const Tcl_Filesystem zipfsFilesystem = { NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ -#ifdef ANDROID - NULL, /* loadFileProc */ -#else (Tcl_FSLoadFileProc *) Zip_FSLoadFile, -#endif NULL, /* getCwdProc */ Zip_FSChdirProc, }; @@ -3922,14 +3925,6 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); Tcl_MutexUnlock(&ZipFSMutex); #endif -#ifdef ANDROID - /* - * Force loadFileProc to native implementation since the - * package manger already extracted the shared libraries - * from the APK at install time. - */ - zipfsFilesystem.loadFileProc = tclNativeFilesystem.loadFileProc; -#endif Tcl_FSRegister(NULL, &zipfsFilesystem); Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); -- cgit v0.12 From 56c5833c4ab4b228c29eb2ade13ba727e1e45da5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 14:01:57 +0000 Subject: Eliminate all use of ZIPFS_IN_TCL --- generic/tclIOUtil.c | 6 ------ generic/tclZipfs.h | 25 ++++--------------------- generic/zipfs.c | 42 +++++++++++++++++++----------------------- win/makefile.vc | 2 +- 4 files changed, 24 insertions(+), 51 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 0ef6d3b..79ec894 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -191,9 +191,7 @@ const Tcl_Filesystem tclNativeFilesystem = { TclpObjChdir }; -#ifdef ZIPFS_IN_TCL MODULE_SCOPE Tcl_Filesystem zipfsFilesystem; -#endif /* * Define the tail of the linked list. Note that for unconventional uses of @@ -1415,7 +1413,6 @@ TclFSNormalizeToUniquePath( Claim(); for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { -#ifdef ZIPFS_IN_TCL if (fsRecPtr->fsPtr == &zipfsFilesystem) { ClientData clientData = NULL; /* @@ -1432,7 +1429,6 @@ TclFSNormalizeToUniquePath( } continue; } -#endif if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; } @@ -1457,11 +1453,9 @@ TclFSNormalizeToUniquePath( if (fsRecPtr->fsPtr == &tclNativeFilesystem) { continue; } -#ifdef ZIPFS_IN_TCL if (fsRecPtr->fsPtr == &zipfsFilesystem) { continue; } -#endif if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h index 75dcb13..bcf6cef 100644 --- a/generic/tclZipfs.h +++ b/generic/tclZipfs.h @@ -22,33 +22,16 @@ extern "C" { # define ZIPFSAPI extern #endif -#ifdef ZIPFS_IN_TK -#define Zipfs_Mount Tkzipfs_Mount -#define Zipfs_Unmount Tkzipfs_Unmount -#define Zipfs_Init Tkzipfs_Init -#define Zipfs_SafeInit Tkzipfs_SafeInit -#ifdef BUILD_tk -# undef ZIPFSAPI -# define ZIPFSAPI DLLEXPORT -#endif -#endif - -#ifdef ZIPFS_IN_TCL -#define Zipfs_Mount Tclzipfs_Mount -#define Zipfs_Unmount Tclzipfs_Unmount -#define Zipfs_Init Tclzipfs_Init -#define Zipfs_SafeInit Tclzipfs_SafeInit #ifdef BUILD_tcl # undef ZIPFSAPI # define ZIPFSAPI DLLEXPORT #endif -#endif -ZIPFSAPI int Zipfs_Mount(Tcl_Interp *interp, const char *zipname, +ZIPFSAPI int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); -ZIPFSAPI int Zipfs_Unmount(Tcl_Interp *interp, const char *zipname); -ZIPFSAPI int Zipfs_Init(Tcl_Interp *interp); -ZIPFSAPI int Zipfs_SafeInit(Tcl_Interp *interp); +ZIPFSAPI int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname); +ZIPFSAPI int Tclzipfs_Init(Tcl_Interp *interp); +ZIPFSAPI int Tclzipfs_SafeInit(Tcl_Interp *interp); #ifdef __cplusplus } diff --git a/generic/zipfs.c b/generic/zipfs.c index b54d5a2..144be30 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -1031,7 +1031,7 @@ error: /* *------------------------------------------------------------------------- * - * Zipfs_Mount -- + * Tclzipfs_Mount -- * * This procedure is invoked to mount a given ZIP archive file on * a given mountpoint with optional ZIP password. @@ -1047,7 +1047,7 @@ error: */ int -Zipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, +Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { char *realname, *p; @@ -1404,7 +1404,7 @@ nextent: /* *------------------------------------------------------------------------- * - * Zipfs_Unmount -- + * Tclzipfs_Unmount -- * * This procedure is invoked to unmount a given ZIP archive. * @@ -1418,7 +1418,7 @@ nextent: */ int -Zipfs_Unmount(Tcl_Interp *interp, const char *zipname) +Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) { char *realname; ZipFile *zf; @@ -1509,7 +1509,7 @@ ZipFSMountCmd(ClientData clientData, Tcl_Interp *interp, " ?zipfile ?mountpoint? ?password???\"", 0); return TCL_ERROR; } - return Zipfs_Mount(interp, (argc > 1) ? argv[1] : NULL, + return Tclzipfs_Mount(interp, (argc > 1) ? argv[1] : NULL, (argc > 2) ? argv[2] : NULL, (argc > 3) ? argv[3] : NULL); } @@ -1539,7 +1539,7 @@ ZipFSUnmountCmd(ClientData clientData, Tcl_Interp *interp, " zipfile\"", (char *) NULL); return TCL_ERROR; } - return Zipfs_Unmount(interp, argv[1]); + return Tclzipfs_Unmount(interp, argv[1]); } /* @@ -3870,7 +3870,7 @@ const Tcl_Filesystem zipfsFilesystem = { /* *------------------------------------------------------------------------- * - * Zipfs_doInit -- + * doInit -- * * Perform per interpreter initialization of this module. * @@ -3885,7 +3885,7 @@ const Tcl_Filesystem zipfsFilesystem = { */ static int -Zipfs_doInit(Tcl_Interp *interp, int safe) +doInit(Tcl_Interp *interp, int safe) { #ifdef HAVE_ZLIB static const char findproc[] = @@ -3929,14 +3929,10 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); ZipFS.initialized = ZipFS.idCount = 1; -#if defined(ZIPFS_IN_TCL) || defined(ZIPFS_IN_TK) - Tcl_StaticPackage(interp, "zipfs", Zipfs_Init, Zipfs_SafeInit); -#endif + Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); } Unlock(); -#if !defined(ZIPFS_IN_TCL) && !defined(ZIPFS_IN_TK) Tcl_PkgProvide(interp, "zipfs", "1.0"); -#endif if (!safe) { Tcl_CreateCommand(interp, "::zipfs::mount", ZipFSMountCmd, 0, 0); Tcl_CreateCommand(interp, "::zipfs::unmount", ZipFSUnmountCmd, 0, 0); @@ -3964,7 +3960,7 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) /* *------------------------------------------------------------------------- * - * Zipfs_Init, Zipfs_SafeInit -- + * Tclzipfs_Init, Tclzipfs_SafeInit -- * * These functions are invoked to perform per interpreter initialization * of this module. @@ -3980,15 +3976,15 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) */ int -Zipfs_Init(Tcl_Interp *interp) +Tclzipfs_Init(Tcl_Interp *interp) { - return Zipfs_doInit(interp, 0); + return doInit(interp, 0); } int -Zipfs_SafeInit(Tcl_Interp *interp) +Tclzipfs_SafeInit(Tcl_Interp *interp) { - return Zipfs_doInit(interp, 1); + return doInit(interp, 1); } #ifndef HAVE_ZLIB @@ -3996,7 +3992,7 @@ Zipfs_SafeInit(Tcl_Interp *interp) /* *------------------------------------------------------------------------- * - * Zipfs_Mount, Zipfs_Unmount -- + * Tclzipfs_Mount, Tclzipfs_Unmount -- * * Dummy version when no ZLIB support available. * @@ -4004,16 +4000,16 @@ Zipfs_SafeInit(Tcl_Interp *interp) */ int -Zipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, +Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { - return Zipfs_doInit(interp, 1); + return doInit(interp, 1); } int -Zipfs_Unmount(Tcl_Interp *interp, const char *zipname) +Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) { - return Zipfs_doInit(interp, 1); + return doInit(interp, 1); } #endif diff --git a/win/makefile.vc b/win/makefile.vc index 80682b9..2e04f15 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -504,7 +504,7 @@ crt = -MT !endif TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" -TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 -DZIPFS_IN_TCL +TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) -- cgit v0.12 From 3c03a492f903c82b544cd54fb5b8f2e2e374a150 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 15:21:21 +0000 Subject: Start with a few simple basic test-cases --- generic/zipfs.c | 13 +++-------- tests/zipfs.test | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ unix/tclAppInit.c | 5 +++++ win/tclAppInit.c | 5 +++++ 4 files changed, 80 insertions(+), 10 deletions(-) create mode 100644 tests/zipfs.test diff --git a/generic/zipfs.c b/generic/zipfs.c index 144be30..3c330b2 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -3761,15 +3761,15 @@ static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags) { + Tcl_FSLoadFileProc2 *loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; #ifdef ANDROID /* * Force loadFileProc to native implementation since the * package manger already extracted the shared libraries * from the APK at install time. */ - return tclNativeFilesystem.loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); #else - Tcl_FSLoadFileProc2 *loadFileProc; Tcl_Obj *altPath = NULL; int ret = -1; @@ -3810,7 +3810,6 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_DecrRefCount(objs[1]); } } - loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; if (loadFileProc != NULL) { ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { @@ -3885,8 +3884,7 @@ const Tcl_Filesystem zipfsFilesystem = { */ static int -doInit(Tcl_Interp *interp, int safe) -{ +doInit(Tcl_Interp *interp, int safe) { #ifdef HAVE_ZLIB static const char findproc[] = "proc ::zipfs::find dir {\n" @@ -3907,11 +3905,6 @@ doInit(Tcl_Interp *interp, int safe) " return [lsort $result]\n" "}\n"; -#ifdef USE_TCL_STUBS - if (Tcl_InitStubs(interp, "8.0", 0) == NULL) { - return TCL_ERROR; - } -#endif /* one-time initialization */ WriteLock(); if (!ZipFS.initialized) { diff --git a/tests/zipfs.test b/tests/zipfs.test new file mode 100644 index 0000000..e8112f5 --- /dev/null +++ b/tests/zipfs.test @@ -0,0 +1,67 @@ +# The file tests the tclZlib.c file. +# +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. +# +# Copyright (c) 1996-1998 by Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.1 + namespace import -force ::tcltest::* +} + +testConstraint zlib [llength [info commands zlib]] + +test zipfs-1.1 {zipfs basics} -constraints zlib -body { + load {} zipfs + package require zipfs +} -result {1.0} + +test zipfs-1.2 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::mount a b c d e f +} -result {wrong # args: should be "::zipfs::mount ?zipfile ?mountpoint? ?password???"} + +test zipfs-1.3 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::unmount a b c d e f +} -result {wrong # args: should be "::zipfs::unmount zipfile"} + +test zipfs-1.4 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::mkkey a b c d e f +} -result {wrong # args: should be "::zipfs::mkkey password"} + +test zipfs-1.5 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::mkimg a b c d e f +} -result {wrong # args: should be "::zipfs::mkimg outfile indir ?strip? ?password? ?infile?"} + +test zipfs-1.6 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::mkzip a b c d e f +} -result {wrong # args: should be "::zipfs::mkzip outfile indir ?strip? ?password?"} + +test zipfs-1.7 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::exists a b c d e f +} -result {wrong # args: should be "::zipfs::exists filename"} + +test zipfs-1.8 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::info a b c d e f +} -result {wrong # args: should be "::zipfs::info filename"} + +test zipfs-1.9 {zipfs basics} -constraints zlib -returnCodes error -body { + ::zipfs::list a b c d e f +} -result {wrong # args: should be "::zipfs::list ?(-glob|-regexp)? ?pattern?"} + + + + + + +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 9bbc88b..40b10f3 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -17,6 +17,7 @@ #include "tcl.h" #ifdef TCL_TEST +#include "tclZipfs.h" extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ @@ -123,6 +124,10 @@ Tcl_AppInit( return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + if (Tclzipfs_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); #endif /* TCL_TEST */ /* diff --git a/win/tclAppInit.c b/win/tclAppInit.c index e06eaf5..b821ca7 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -25,6 +25,7 @@ #include #ifdef TCL_TEST +#include "tclZipfs.h" extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ @@ -174,6 +175,10 @@ Tcl_AppInit( return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + if (Tclzipfs_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); #endif /* TCL_TEST */ /* -- cgit v0.12 From a03e74efc1bbec20a5c2488448a8de28d9fb28fb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Dec 2015 21:25:40 +0000 Subject: USE_TCL_STUBS is not defined anyway --- generic/zipfs.c | 37 ++++++++++++++++++++++++------------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index 3c330b2..1f126ce 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -12,6 +12,7 @@ #include "tclInt.h" #include "tclFileSystem.h" #include "tclZipfs.h" + #if !defined(_WIN32) && !defined(_WIN64) #include #endif @@ -2771,6 +2772,7 @@ merror0: } else { if (z->data != NULL) { unsigned int j = z->nbyte; + if (j > info->nmax) { j = info->nmax; } @@ -2808,6 +2810,7 @@ merror0: stream.avail_in = z->nbytecompr; if (z->isenc) { unsigned int j; + stream.avail_in -= 12; cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); @@ -3761,14 +3764,20 @@ static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags) { - Tcl_FSLoadFileProc2 *loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + Tcl_FSLoadFileProc2 *loadFileProc; #ifdef ANDROID - /* - * Force loadFileProc to native implementation since the - * package manger already extracted the shared libraries - * from the APK at install time. - */ - return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + /* + * Force loadFileProc to native implementation since the + * package manger already extracted the shared libraries + * from the APK at install time. + */ + + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + if (loadFileProc != NULL) { + return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + } + Tcl_SetErrno(ENOENT); + return -1; #else Tcl_Obj *altPath = NULL; int ret = -1; @@ -3810,6 +3819,7 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_DecrRefCount(objs[1]); } } + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; if (loadFileProc != NULL) { ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { @@ -3869,7 +3879,7 @@ const Tcl_Filesystem zipfsFilesystem = { /* *------------------------------------------------------------------------- * - * doInit -- + * Zipfs_doInit -- * * Perform per interpreter initialization of this module. * @@ -3884,7 +3894,8 @@ const Tcl_Filesystem zipfsFilesystem = { */ static int -doInit(Tcl_Interp *interp, int safe) { +Zipfs_doInit(Tcl_Interp *interp, int safe) +{ #ifdef HAVE_ZLIB static const char findproc[] = "proc ::zipfs::find dir {\n" @@ -3971,13 +3982,13 @@ doInit(Tcl_Interp *interp, int safe) { int Tclzipfs_Init(Tcl_Interp *interp) { - return doInit(interp, 0); + return Zipfs_doInit(interp, 0); } int Tclzipfs_SafeInit(Tcl_Interp *interp) { - return doInit(interp, 1); + return Zipfs_doInit(interp, 1); } #ifndef HAVE_ZLIB @@ -3996,13 +4007,13 @@ int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { - return doInit(interp, 1); + return Zipfs_doInit(interp, 1); } int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) { - return doInit(interp, 1); + return Zipfs_doInit(interp, 1); } #endif -- cgit v0.12 From 299924e512e6809f22f5fa3e4410fcc706ceec82 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Dec 2015 09:11:57 +0000 Subject: Remove TIP #414 fragment, not strictly needed for the zipfs TIP. Add more zipfs test-cases --- generic/tcl.h | 7 ----- generic/tclEncoding.c | 23 +++------------- tests/zipfs.test | 73 ++++++++++++++++++++++++++++++++++++++++++--------- 3 files changed, 64 insertions(+), 39 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index fed6b78..a08edde 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2424,13 +2424,6 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, * TODO - tommath stubs export goes here! */ -/* Tcl_InitSubsystems, see TIP #414 */ - -#ifndef USE_TCL_STUBS -EXTERN const char * Tcl_InitSubsystems(TCL_NORETURN1 - Tcl_PanicProc *panicProc); -#endif - /* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 4020445..4edebcf 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1440,10 +1440,10 @@ Tcl_UtfToExternal( /* *--------------------------------------------------------------------------- * - * Tcl_InitSubsystems/Tcl_FindExecutable -- + * Tcl_FindExecutable -- * - * This function initializes everything needed for the Tcl library - * to be able to operate. + * This function computes the absolute path name of the current + * application, given its argv[0] value. * * Results: * None. @@ -1454,23 +1454,6 @@ Tcl_UtfToExternal( * *--------------------------------------------------------------------------- */ -MODULE_SCOPE const TclStubs tclStubs; - -static const struct { - const TclStubs *stubs; - const char version[16]; -} stubInfo = { - &tclStubs, TCL_PATCH_LEVEL -}; - -const char * -Tcl_InitSubsystems(TCL_NORETURN1 Tcl_PanicProc *panicProc) -{ - Tcl_SetPanicProc(panicProc); - TclInitSubsystems(); - return stubInfo.version; -} - #undef Tcl_FindExecutable void Tcl_FindExecutable( diff --git a/tests/zipfs.test b/tests/zipfs.test index e8112f5..3f53cf8 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -15,49 +15,98 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -testConstraint zlib [llength [info commands zlib]] +testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}] -test zipfs-1.1 {zipfs basics} -constraints zlib -body { +test zipfs-1.1 {zipfs basics} -constraints zipfs -body { load {} zipfs +} -result {} + +test zipfs-1.2 {zipfs basics} -constraints zipfs -body { package require zipfs } -result {1.0} -test zipfs-1.2 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.3 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::mount a b c d e f } -result {wrong # args: should be "::zipfs::mount ?zipfile ?mountpoint? ?password???"} -test zipfs-1.3 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.4 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::unmount a b c d e f } -result {wrong # args: should be "::zipfs::unmount zipfile"} -test zipfs-1.4 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.5 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::mkkey a b c d e f } -result {wrong # args: should be "::zipfs::mkkey password"} -test zipfs-1.5 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.6 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::mkimg a b c d e f } -result {wrong # args: should be "::zipfs::mkimg outfile indir ?strip? ?password? ?infile?"} -test zipfs-1.6 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.7 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::mkzip a b c d e f } -result {wrong # args: should be "::zipfs::mkzip outfile indir ?strip? ?password?"} -test zipfs-1.7 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.8 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::exists a b c d e f } -result {wrong # args: should be "::zipfs::exists filename"} -test zipfs-1.8 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.9 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::info a b c d e f } -result {wrong # args: should be "::zipfs::info filename"} -test zipfs-1.9 {zipfs basics} -constraints zlib -returnCodes error -body { +test zipfs-1.10 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::list a b c d e f } -result {wrong # args: should be "::zipfs::list ?(-glob|-regexp)? ?pattern?"} +test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body { + ::zipfs::mkzip abc.zip $tcl_library/xxxx +} -result {empty archive} + +test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { + set pwd [pwd] + cd $tcl_library/encoding + ::zipfs::mkzip abc.zip . + ::zipfs::mount abc.zip /abc + ::zipfs::list -glob /abc/cp850.* +} -cleanup { + cd $pwd +} -result {/abc/cp850.enc} + +test zipfs-2.3 {zipfs unmount} -constraints zipfs -body { + ::zipfs::info /abc/cp850.enc +} -result [list $tcl_library/encoding/abc.zip 1090 527 39434] + +test zipfs-2.4 {zipfs unmount} -constraints zipfs -body { + set f [open /abc/cp850.enc] + read $f +} -result {# Encoding file: cp850, single-byte +S +003F 0 1 +00 +0000000100020003000400050006000700080009000A000B000C000D000E000F +0010001100120013001400150016001700180019001A001B001C001D001E001F +0020002100220023002400250026002700280029002A002B002C002D002E002F +0030003100320033003400350036003700380039003A003B003C003D003E003F +0040004100420043004400450046004700480049004A004B004C004D004E004F +0050005100520053005400550056005700580059005A005B005C005D005E005F +0060006100620063006400650066006700680069006A006B006C006D006E006F +0070007100720073007400750076007700780079007A007B007C007D007E007F +00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5 +00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192 +00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB +2591259225932502252400C100C200C000A9256325512557255D00A200A52510 +25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4 +00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 +00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 +00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 +} - - +test zipfs-2.5 {zipfs exists} -constraints zipfs -body { + ::zipfs::unmount abc.zip + ::zipfs::exists /abc/cp850.enc +} -cleanup { + file delete abc.zip +} -result 1 ::tcltest::cleanupTests return -- cgit v0.12 From e9795fb40711ccc9e08e1a60232a31797bf8356a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Dec 2015 11:39:28 +0000 Subject: first shot at documentation --- doc/zipfs.3 | 45 +++++++++++++++++++++++++++++++ doc/zipfs.n | 88 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 133 insertions(+) create mode 100644 doc/zipfs.3 create mode 100644 doc/zipfs.n diff --git a/doc/zipfs.3 b/doc/zipfs.3 new file mode 100644 index 0000000..9e031bc --- /dev/null +++ b/doc/zipfs.3 @@ -0,0 +1,45 @@ +'\" +'\" Copyright (c) 2015 Jan Nijtmans +'\" Copyright (c) 2015 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures" +.so man.macros +.BS +.SH NAME +Tclzipfs_Init, Tclzipfs_SafeInit, Tclzipfs_Mount, Tclzipfs_Unmount \- handle ZIP files as VFS +.SH SYNOPSIS +.nf +\fB#include \fR +.sp +int +\fBTclzipfs_Init\fR(\fIinterp\fR) +.sp +int +\fBTclzipfs_SafeInit\fR(\fIinterp\fR) +.sp +int +\fBTclzipfs_Mount\fR(\fIinterp, zipname, mntpt, passwd\fR) +.sp +int +\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR) +.SH ARGUMENTS +.AS Tcl_Interp **termPtr +.AP Tcl_Interp *interp in +Interpreter in which the zip file system is mounted. The interpreter's result is +modified to hold the result or error message from the script. +.AP "const char" *zipname in +Name of a zipfile. +.AP "const char" *mntpt in +Name of a mount point. +.AP "const char" *passwd in +An (optional) password. +.BE +.SH DESCRIPTION +.PP +TODO +.PP +.SH KEYWORDS +compress, filesystem, zip diff --git a/doc/zipfs.n b/doc/zipfs.n new file mode 100644 index 0000000..16b25e5 --- /dev/null +++ b/doc/zipfs.n @@ -0,0 +1,88 @@ +'\" +'\" Copyright (c) 2015 Jan Nijtmans +'\" Copyright (c) 2015 Christian Werner +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH zipfs n 1.0 Zipfs "zipfs Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +zipfs \- Mount and work with ZIP files within Tcl +.SH SYNOPSIS +.nf +\fBpackage require zipfs \fR?\fB1.0\fR? +.sp +\fB::zipfs::exists\fR \fIfilename\fR +\fB::zipfs::find\fR \fIdir\fR +\fB::zipfs::info\fR \fIfilename\fR +\fB::zipfs::list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR +\fB::zipfs::mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR +\fB::zipfs::mkkey\fR \fIpassword\fR +\fB::zipfs::mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR +\fB::zipfs::mount\fR \fI?zipfile\fR \fI?mountpoint?\fR \fI?password?\fR +\fB::zipfs::unmount\fR \fIzipfile\fR +.fi +.BE +.SH DESCRIPTION +.PP +The \fBzipfs\fR package provides tcl with the ability to mount +the contents of a zip file as a virtual file system. +.TP +\fB::zipfs::mount ?\fIzipfile\fR? ?\fImountpoint\fR? +. +The \fB::zipfs::mount\fR procedure mounts a zipfile as a VFS. +After this command executes, files contained in \fIzipfile\fR +will appear to Tcl to be regular files at the mount point. +.RS +.PP +With no \fImountpoint\fR, returns the mount point for \fIzipfile\fR. With no \fIzipfile\fR, +return all zipfile/mount pairs. If \fImountpoint\fR is specified as an empty +string, mount on file path. +.RE +.TP +\fB::zipfs::unmount \fIzipfile\fR +. +Unmounts a previously mounted zip, \fIzipfile\fR. +.TP +\fB::zipfs::exists\fR \fIfilename\fR +. +Return 1 if the given filename exists in the mounted zipfs and 0 if it does not. +.TP +\fB::zipfs::info\fR \fIfile\fR +. +Return information about the given file in the mounted zipfs. The information +consists of (1) the name of the ZIP zipfile that contains the file, (2) the +size of the file after decompressions, (3) the compressed size of the file, +and (4) the offset of the compressed data in the zipfile. +.RS +.PP +Note: querying the mount point gives the start of zip data offset in (4), +which can be used to truncate the zip info off an executable. +.RE +.TP +\fB::zipfs::list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR +. +Return a list of all files in the mounted zipfs. The order of the names +in the list is arbitrary. +.TP +\fB::zipfs::mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR +. +TODO +.TP +\fB::zipfs::mkkey\fR \fIpassword\fR +. +TODO +.TP +\fB::zipfs::mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR +. +TODO +.SH "SEE ALSO" +tclsh(1), file(n), zlib(n) +.SH "KEYWORDS" +compress, filesystem, zip +'\" Local Variables: +'\" mode: nroff +'\" End: -- cgit v0.12 From a1740d976679e2a4928898a1eddd1dad22f4fd16 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Jan 2016 16:50:52 +0000 Subject: Make al zipfs command Tcl_Obj-based --- generic/tclZipfs.h | 2 +- generic/zipfs.c | 284 +++++++++++++++++++++++++++++++++-------------------- 2 files changed, 176 insertions(+), 110 deletions(-) diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h index bcf6cef..01c9e96 100644 --- a/generic/tclZipfs.h +++ b/generic/tclZipfs.h @@ -28,7 +28,7 @@ extern "C" { #endif ZIPFSAPI int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, - const char *mntpt, const char *passwd); + const char *mntpt, const char *passwd); ZIPFSAPI int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname); ZIPFSAPI int Tclzipfs_Init(Tcl_Interp *interp); ZIPFSAPI int Tclzipfs_SafeInit(Tcl_Interp *interp); diff --git a/generic/zipfs.c b/generic/zipfs.c index 1f126ce..55c6d2c 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -91,15 +91,15 @@ * Macros to read and write 16 and 32 bit integers from/to ZIP archives. */ -#define zip_read_int(p) \ +#define zip_read_int(p) \ ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24)) -#define zip_read_short(p) \ +#define zip_read_short(p) \ ((p)[0] | ((p)[1] << 8)) -#define zip_write_int(p, v) \ - (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ +#define zip_write_int(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff; -#define zip_write_short(p, v) \ +#define zip_write_short(p, v) \ (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; /* @@ -1488,7 +1488,7 @@ done: /* *------------------------------------------------------------------------- * - * ZipFSMountCmd -- + * ZipFSMountObjCmd -- * * This procedure is invoked to process the "zipfs::mount" command. * @@ -1502,23 +1502,23 @@ done: */ static int -ZipFSMountCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv) +ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) { - if (argc > 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?zipfile ?mountpoint? ?password???\"", 0); + if (objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "?zipfile mountpoint password?"); return TCL_ERROR; } - return Tclzipfs_Mount(interp, (argc > 1) ? argv[1] : NULL, - (argc > 2) ? argv[2] : NULL, - (argc > 3) ? argv[3] : NULL); + return Tclzipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, + (objc > 2) ? Tcl_GetString(objv[2]) : NULL, + (objc > 3) ? Tcl_GetString(objv[3]) : NULL); } /* *------------------------------------------------------------------------- * - * ZipFSUnmountCmd -- + * ZipFSUnmountObjCmd -- * * This procedure is invoked to process the "zipfs::unmount" command. * @@ -1532,21 +1532,20 @@ ZipFSMountCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSUnmountCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv) +ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " zipfile\"", (char *) NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); return TCL_ERROR; } - return Tclzipfs_Unmount(interp, argv[1]); + return Tclzipfs_Unmount(interp, Tcl_GetString(objv[1])); } /* *------------------------------------------------------------------------- * - * ZipFSMountCmd -- + * ZipFSMkKeyObjCmd -- * * This procedure is invoked to process the "zipfs::mkkey" command. * It produces a rotated password to be embedded into an image file. @@ -1561,28 +1560,28 @@ ZipFSUnmountCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSMkKeyCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv) +ZipFSMkKeyObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) { int len, i = 0; - char pwbuf[264]; + char *pw, pwbuf[264]; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " password\"", (char *) NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "password"); return TCL_ERROR; } - len = strlen(argv[1]); + pw = Tcl_GetString(objv[1]); + len = strlen(pw); if (len == 0) { return TCL_OK; } - if ((len > 255) || (strchr(argv[1], 0xff) != NULL)) { + if ((len > 255) || (strchr(pw, 0xff) != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1)); return TCL_ERROR; } while (len > 0) { - int ch = argv[1][len - 1]; + int ch = pw[len - 1]; pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; i++; @@ -1928,7 +1927,7 @@ seekErr: /* *------------------------------------------------------------------------- * - * ZipFSMkZipOrImgCmd -- + * ZipFSMkZipOrImgObjCmd -- * * This procedure is creates a new ZIP archive file or image file * given output filename, input directory of files to be archived, @@ -1945,75 +1944,107 @@ seekErr: */ static int -ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, - int isImg, int argc, const char **argv) +ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int isImg, int isList, int objc, Tcl_Obj *const objv[]) { Tcl_Channel out; - int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, largc, pos[3]; - const char **largv; - Tcl_DString ds; + int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3]; + Tcl_Obj **lobjv, *list = NULL; ZipEntry *z; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable fileHash; - char pwbuf[264], buf[4096]; + char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096]; - if ((argc < 3) || (argc > (isImg ? 6 : 5))) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " outfile indir ?strip? ?password?", - isImg ? " ?infile?\"" : "\"", (char *) NULL); - return TCL_ERROR; + if (isList) { + if ((objc < 3) || (objc > (isImg ? 5 : 4))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile inlist ?password infile?" : + "outfile inlist ?password?"); + return TCL_ERROR; + } + } else { + if ((objc < 3) || (objc > (isImg ? 6 : 5))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile indir ?strip password infile?" : + "outfile indir ?strip password?"); + return TCL_ERROR; + } } pwbuf[0] = 0; - if (argc > 4) { - pwlen = strlen(argv[4]); - if ((pwlen > 255) || (strchr(argv[4], 0xff) != NULL)) { - Tcl_AppendResult(interp, "illegal password", (char *) NULL); + if (objc > (isList ? 3 : 4)) { + pw = Tcl_GetString(objv[isList ? 3 : 4]); + pwlen = strlen(pw); + if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); return TCL_ERROR; } } - Tcl_DStringInit(&ds); - Tcl_DStringAppendElement(&ds, "::zipfs::find"); - Tcl_DStringAppendElement(&ds, argv[2]); - if (Tcl_Eval(interp, Tcl_DStringValue(&ds)) != TCL_OK) { - Tcl_DStringFree(&ds); + if (isList) { + list = objv[2]; + Tcl_IncrRefCount(list); + } else { + Tcl_Obj *cmd[3]; + + cmd[1] = Tcl_NewStringObj("::zipfs::find", -1); + cmd[2] = objv[2]; + cmd[0] = Tcl_NewListObj(2, cmd + 1); + Tcl_IncrRefCount(cmd[0]); + if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { + Tcl_DecrRefCount(cmd[0]); + return TCL_ERROR; + } + Tcl_DecrRefCount(cmd[0]); + list = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(list); + } + if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { + Tcl_DecrRefCount(list); return TCL_ERROR; } - Tcl_DStringFree(&ds); - if (Tcl_SplitList(interp, Tcl_GetStringResult(interp), &largc, &largv) - != TCL_OK) { + if (isList && (lobjc % 2)) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("need even number of elements", -1)); return TCL_ERROR; } - Tcl_ResetResult(interp); - if (largc == 0) { - Tcl_Free((char *) largv); - Tcl_AppendResult(interp, "empty archive", (char *) NULL); + if (lobjc == 0) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); return TCL_ERROR; } - out = Tcl_OpenFileChannel(interp, argv[1], "w", 0755); + out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755); if ((out == NULL) || (Tcl_SetChannelOption(interp, out, "-translation", "binary") != TCL_OK) || (Tcl_SetChannelOption(interp, out, "-encoding", "binary") != TCL_OK)) { + Tcl_DecrRefCount(list); Tcl_Close(interp, out); - Tcl_Free((char *) largv); return TCL_ERROR; } if (isImg) { ZipFile zf0; + const char *imgName; - if (ZipFSOpenArchive(interp, (argc > 5) ? argv[5] : - Tcl_GetNameOfExecutable(), 0, &zf0) != TCL_OK) { + if (isList) { + imgName = (objc > 4) ? Tcl_GetString(objv[4]) : + Tcl_GetNameOfExecutable(); + } else { + imgName = (objc > 5) ? Tcl_GetString(objv[5]) : + Tcl_GetNameOfExecutable(); + } + if (ZipFSOpenArchive(interp, imgName, 0, &zf0) != TCL_OK) { + Tcl_DecrRefCount(list); Tcl_Close(interp, out); - Tcl_Free((char *) largv); return TCL_ERROR; } - if (pwlen && (argc > 4)) { + if ((pw != NULL) && pwlen) { i = 0; len = pwlen; while (len > 0) { - int ch = argv[4][len - 1]; + int ch = pw[len - 1]; pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; i++; @@ -2029,9 +2060,9 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, } i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); if (i != zf0.baseoffsp) { - Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); Tcl_Close(interp, out); - Tcl_Free((char *) largv); ZipFSCloseArchive(interp, &zf0); return TCL_ERROR; } @@ -2040,9 +2071,9 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, if (len > 0) { i = Tcl_Write(out, pwbuf, len); if (i != len) { - Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); Tcl_Close(interp, out); - Tcl_Free((char *) largv); return TCL_ERROR; } } @@ -2051,18 +2082,25 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, } Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); pos[0] = Tcl_Tell(out); - if (argc > 3) { - slen = strlen(argv[3]); + if (!isList && (objc > 3)) { + strip = Tcl_GetString(objv[3]); + slen = strlen(strip); } - for (i = 0; i < largc; i++) { - const char *name = largv[i]; + for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { + const char *path, *name; - if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(argv[3], name, slen) != 0)) { - continue; + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; } - name += slen; } while (name[0] == '/') { ++name; @@ -2070,23 +2108,28 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, if (name[0] == '\0') { continue; } - if (ZipAddFile(interp, largv[i], name, out, - (pwlen > 0) ? argv[4] : NULL, buf, sizeof (buf), &fileHash) - != TCL_OK) { + if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), + &fileHash) != TCL_OK) { goto done; } } pos[1] = Tcl_Tell(out); count = 0; - for (i = 0; i < largc; i++) { - const char *name = largv[i]; + for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { + const char *path, *name; - if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(argv[3], name, slen) != 0)) { - continue; + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; } - name += slen; } while (name[0] == '/') { ++name; @@ -2117,10 +2160,10 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); - memcpy(buf + ZIP_CENTRAL_HEADER_LEN, z->name, len); - len += ZIP_CENTRAL_HEADER_LEN; - if (Tcl_Write(out, buf, len) != len) { - Tcl_AppendResult(interp, "write error", (char *) NULL); + if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != + ZIP_CENTRAL_HEADER_LEN) || + (Tcl_Write(out, z->name, len) != len)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); goto done; } count++; @@ -2136,14 +2179,18 @@ ZipFSMkZipOrImgCmd(ClientData clientData, Tcl_Interp *interp, zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]); zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { - Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); goto done; } Tcl_Flush(out); ret = TCL_OK; done: - Tcl_Free((char *) largv); - Tcl_Close(interp, out); + if (ret == TCL_OK) { + ret = Tcl_Close(interp, out); + } else { + Tcl_Close(interp, out); + } + Tcl_DecrRefCount(list); hPtr = Tcl_FirstHashEntry(&fileHash, &search); while (hPtr != NULL) { z = (ZipEntry *) Tcl_GetHashValue(hPtr); @@ -2158,7 +2205,7 @@ done: /* *------------------------------------------------------------------------- * - * ZipFSMkZipCmd -- + * ZipFSMkZipObjCmd -- * * This procedure is invoked to process the "zipfs::mkzip" command. * See description of ZipFSMkZipOrImgCmd(). @@ -2173,16 +2220,23 @@ done: */ static int -ZipFSMkZipCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv) +ZipFSMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv); +} + +static int +ZipFSLMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) { - return ZipFSMkZipOrImgCmd(clientData, interp, 0, argc, argv); + return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv); } /* *------------------------------------------------------------------------- * - * ZipFSMkImgCmd -- + * ZipFSMkImgObjCmd -- * * This procedure is invoked to process the "zipfs::mkimg" command. * See description of ZipFSMkZipOrImgCmd(). @@ -2197,10 +2251,17 @@ ZipFSMkZipCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSMkImgCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char **argv) +ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv); +} + +static int +ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) { - return ZipFSMkZipOrImgCmd(clientData, interp, 1, argc, argv); + return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv); } /* @@ -3938,11 +3999,16 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) Unlock(); Tcl_PkgProvide(interp, "zipfs", "1.0"); if (!safe) { - Tcl_CreateCommand(interp, "::zipfs::mount", ZipFSMountCmd, 0, 0); - Tcl_CreateCommand(interp, "::zipfs::unmount", ZipFSUnmountCmd, 0, 0); - Tcl_CreateCommand(interp, "::zipfs::mkkey", ZipFSMkKeyCmd, 0, 0); - Tcl_CreateCommand(interp, "::zipfs::mkimg", ZipFSMkImgCmd, 0, 0); - Tcl_CreateCommand(interp, "::zipfs::mkzip", ZipFSMkZipCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::mount", ZipFSMountObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::unmount", + ZipFSUnmountObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::mkkey", ZipFSMkKeyObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::mkimg", ZipFSMkImgObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::mkzip", ZipFSMkZipObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::lmkimg", + ZipFSLMkImgObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::zipfs::lmkzip", + ZipFSLMkZipObjCmd, 0, 0); Tcl_GlobalEval(interp, findproc); } Tcl_CreateObjCommand(interp, "::zipfs::exists", ZipFSExistsObjCmd, 0, 0); -- cgit v0.12 From f6bb864fc7610c6c893acee7b4a7604a287e6018 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Jan 2016 09:28:55 +0000 Subject: Minor tweaks in documentation/testcases. Don't use deprecated Tcl methods any more --- doc/zipfs.n | 4 ++-- generic/zipfs.c | 10 +++++----- tests/zipfs.test | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/zipfs.n b/doc/zipfs.n index b21ad57..d16c047 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -22,7 +22,7 @@ zipfs \- Mount and work with ZIP files within Tcl \fB::zipfs::mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR \fB::zipfs::mkkey\fR \fIpassword\fR \fB::zipfs::mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR -\fB::zipfs::mount\fR \fI?zipfile\fR \fI?mountpoint?\fR \fI?password?\fR +\fB::zipfs::mount\fR \fI?zipfile?\fR \fI?mountpoint?\fR \fI?password?\fR \fB::zipfs::unmount\fR \fIzipfile\fR .fi .BE @@ -94,7 +94,7 @@ Caution: the choice of the \fIindir\fR parameter archive's content. .RE .TP -\fB::zipfs::mount ?\fIzipfile\fR? ?\fImountpoint\fR? +\fB::zipfs::mount ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR? . The \fB::zipfs::mount\fR command mounts a ZIP archive file as a VFS. After this command executes, files contained in \fIzipfile\fR diff --git a/generic/zipfs.c b/generic/zipfs.c index 55c6d2c..e789e14 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -1507,7 +1507,7 @@ ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, { if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, - "?zipfile mountpoint password?"); + "?zipfile? ?mountpoint? ?password?"); return TCL_ERROR; } return Tclzipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, @@ -1729,7 +1729,7 @@ wrerr: init_keys(passwd, keys, crc32tab); for (i = 0; i < 12 - 2; i++) { - if (Tcl_Eval(interp, "expr int(rand() * 256) % 256") != TCL_OK) { + if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) { Tcl_AppendResult(interp, "PRNG error", (char *) NULL); Tcl_Close(interp, in); return TCL_ERROR; @@ -1966,8 +1966,8 @@ ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, } else { if ((objc < 3) || (objc > (isImg ? 6 : 5))) { Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile indir ?strip password infile?" : - "outfile indir ?strip password?"); + "outfile indir ?strip? ?password? ?infile?" : + "outfile indir ?strip? ?password?"); return TCL_ERROR; } } @@ -4009,7 +4009,7 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) ZipFSLMkImgObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "::zipfs::lmkzip", ZipFSLMkZipObjCmd, 0, 0); - Tcl_GlobalEval(interp, findproc); + Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); } Tcl_CreateObjCommand(interp, "::zipfs::exists", ZipFSExistsObjCmd, 0, 0); Tcl_CreateObjCommand(interp, "::zipfs::info", ZipFSInfoObjCmd, 0, 0); diff --git a/tests/zipfs.test b/tests/zipfs.test index 3f53cf8..189461a 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -27,7 +27,7 @@ test zipfs-1.2 {zipfs basics} -constraints zipfs -body { test zipfs-1.3 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::mount a b c d e f -} -result {wrong # args: should be "::zipfs::mount ?zipfile ?mountpoint? ?password???"} +} -result {wrong # args: should be "::zipfs::mount ?zipfile? ?mountpoint? ?password?"} test zipfs-1.4 {zipfs basics} -constraints zipfs -returnCodes error -body { ::zipfs::unmount a b c d e f -- cgit v0.12 From 22f5c55560bbc2db11df037944b62c294e250928 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Jan 2016 09:17:55 +0000 Subject: Upstream zipfs change and unbreak zipfs test-case --- generic/zipfs.c | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index c5cb65b..1c96f7b 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -3854,6 +3854,8 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { + const char *execName = Tcl_GetNameOfExecutable(); + /* * Shared object is not in ZIP but its path prefix is, * thus try to load from directory where the executable @@ -3861,8 +3863,23 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, */ TclDecrRefCount(objs[1]); objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); - objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), - TCL_PATH_DIRNAME); + /* + * Get directory name of executable manually to deal + * with cases where [file dirname [info nameofexecutable]] + * is equal to [info nameofexecutable] due to VFS effects. + */ + if (execName != NULL) { + const char *p = strrchr(execName, '/'); + + if (p > execName + 1) { + --p; + objs[0] = Tcl_NewStringObj(execName, p - execName); + } + } + if (objs[0] == NULL) { + objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), + TCL_PATH_DIRNAME); + } if (objs[0] != NULL) { altPath = TclJoinPath(2, objs); if (altPath != NULL) { @@ -3980,6 +3997,7 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) }; static const char findproc[] = + "namespace eval zipfs {}\n" "proc ::zipfs::find dir {\n" " set result {}\n" " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n" @@ -4018,13 +4036,15 @@ Zipfs_doInit(Tcl_Interp *interp, int safe) Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); } Unlock(); - Tcl_PkgProvide(interp, "zipfs", "1.0"); if (!safe) { Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, TCL_LINK_INT); } TclMakeEnsemble(interp, "zipfs", safe ? initSafeMap : initMap); + + Tcl_PkgProvide(interp, "zipfs", "1.0"); + return TCL_OK; #else if (interp != NULL) { -- cgit v0.12 From 763f9dff55f828aff79b6899498782220d0678bf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 2 Mar 2016 15:39:32 +0000 Subject: minor upstream changes --- generic/zipfs.c | 56 +++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 19 deletions(-) diff --git a/generic/zipfs.c b/generic/zipfs.c index 1c96f7b..c2effac 100644 --- a/generic/zipfs.c +++ b/generic/zipfs.c @@ -294,6 +294,10 @@ static const unsigned int crc32tab[256] = { * POSIX like rwlock functions to support multiple readers * and single writer on internal structs. * + * Limitations: + * - a read lock cannot be promoted to a write lock + * - a write lock may not be nested + * *------------------------------------------------------------------------- */ @@ -1056,7 +1060,7 @@ Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, ZipFile *zf, zf0; ZipEntry *z; Tcl_HashEntry *hPtr; - Tcl_DString ds, fpBuf; + Tcl_DString ds, dsm, fpBuf; unsigned char *q; #if HAS_DRIVES int drive = 0; @@ -1108,11 +1112,21 @@ Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, if (hPtr != NULL) { if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { #if HAS_DRIVES - if (drive == zf->mntdrv) -#endif - { - Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->mntpt, -1)); + if (drive == zf->mntdrv) { + Tcl_Obj *string; + char drvbuf[3]; + + drvbuf[0] = zf->mntdrv; + drvbuf[1] = ':'; + drvbuf[2] = '\0'; + string = Tcl_NewStringObj(drvbuf, 2); + Tcl_AppendToObj(string, zf->mntpt, zf->mntptlen); + Tcl_SetObjResult(interp, string); } +#else + Tcl_SetObjResult(interp, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); +#endif } } Unlock(); @@ -1140,6 +1154,17 @@ Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, #else realname = AbsolutePath(zipname, &ds); #endif + /* + * Mount point can come from Tcl_GetNameOfExecutable() + * which sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ + Tcl_DStringInit(&dsm); +#if HAS_DRIVES + mntpt = AbsolutePath(mntpt, &drive, &dsm); +#else + mntpt = AbsolutePath(mntpt, &dsm); +#endif WriteLock(); hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, realname, &isNew); Tcl_DStringSetLength(&ds, 0); @@ -1151,19 +1176,10 @@ Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, } Unlock(); Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsm); ZipFSCloseArchive(interp, &zf0); return TCL_ERROR; } -#if HAS_DRIVES - if ((mntpt[0] != '\0') && (mntpt[1] == ':') && - (strchr(drvletters, mntpt[0]) != NULL)) { - drive = mntpt[0]; - if ((drive >= 'a') && (drive <= 'z')) { - drive -= 'a' - 'A'; - } - mntpt += 2; - } -#endif if (strcmp(mntpt, "/") == 0) { mntpt = ""; } @@ -1174,6 +1190,7 @@ Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, } Unlock(); Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsm); ZipFSCloseArchive(interp, &zf0); return TCL_ERROR; } @@ -1395,9 +1412,10 @@ Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, nextent: q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; } + Unlock(); Tcl_DStringFree(&fpBuf); Tcl_DStringFree(&ds); - Unlock(); + Tcl_DStringFree(&dsm); Tcl_FSMountsChanged(NULL); return TCL_OK; } @@ -1818,9 +1836,9 @@ wrerr: pos[1] = Tcl_Tell(out); if (nbyte - nbytecompr <= 0) { /* - * Compressed file larger than input, - * write it again uncompressed. - */ + * Compressed file larger than input, + * write it again uncompressed. + */ if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { goto seekErr; } -- cgit v0.12 From de712c24fb56e83b27e2b1e513d145ce8008fc6e Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 22 Mar 2016 23:45:12 +0000 Subject: First simple step implementing TIP 445. --- generic/tcl.decls | 8 ++++++++ generic/tclDecls.h | 5 +++++ generic/tclObj.c | 24 ++++++++++++++++++++++++ generic/tclStubInit.c | 1 + 4 files changed, 38 insertions(+) diff --git a/generic/tcl.decls b/generic/tcl.decls index 574b49b..707420d 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2326,6 +2326,14 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # +# TIP #445 + +declare 631 { + void Tcl_FreeIntRep(Tcl_Obj *objPtr) +} + +# ----- BASELINE -- FOR -- 8.7.0 ----- # + ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b022d3c..4275b91 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1816,6 +1816,8 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); +/* 631 */ +EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2482,6 +2484,7 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ + void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 631 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3774,6 +3777,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FSUnloadFile) /* 629 */ #define Tcl_ZlibStreamSetCompressionDictionary \ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ +#define Tcl_FreeIntRep \ + (tclStubsPtr->tcl_FreeIntRep) /* 631 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclObj.c b/generic/tclObj.c index c641152..b2b962c 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1726,6 +1726,30 @@ Tcl_InvalidateStringRep( /* *---------------------------------------------------------------------- * + * Tcl_FreeIntRep -- + * + * This function is called to free an object's internal representation. + * + * Results: + * None. + * + * Side effects: + * Calls the freeIntRepProc of the current Tcl_ObjType, if any. + * Sets typePtr field to NULL. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_FreeIntRep( + Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ +{ + TclFreeIntRep(objPtr); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_NewBooleanObj -- * * This function is normally called when not debugging: i.e., when diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 5b7a1cd..83dd9d6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1415,6 +1415,7 @@ const TclStubs tclStubs = { Tcl_FindSymbol, /* 628 */ Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ + Tcl_FreeIntRep, /* 631 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12 From 95de12dbb42d94ed5f716d91bb4500ba5ae08616 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 04:31:24 +0000 Subject: Next step: new routine Tcl_InitStringRep() --- generic/tcl.decls | 4 ++- generic/tclDecls.h | 6 ++++ generic/tclObj.c | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStubInit.c | 1 + 4 files changed, 90 insertions(+), 1 deletion(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 707420d..24484a5 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2327,10 +2327,12 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # # TIP #445 - declare 631 { void Tcl_FreeIntRep(Tcl_Obj *objPtr) } +declare 632 { + char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, int numBytes) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 4275b91..3e2ac18 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1818,6 +1818,9 @@ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( Tcl_Obj *compressionDictionaryObj); /* 631 */ EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); +/* 632 */ +EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, + int numBytes); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2485,6 +2488,7 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 631 */ + char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, int numBytes); /* 632 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3779,6 +3783,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ #define Tcl_FreeIntRep \ (tclStubsPtr->tcl_FreeIntRep) /* 631 */ +#define Tcl_InitStringRep \ + (tclStubsPtr->tcl_InitStringRep) /* 632 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclObj.c b/generic/tclObj.c index b2b962c..7fe0293 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -17,6 +17,7 @@ #include "tclInt.h" #include "tommath.h" #include +#include /* * Table of all object types. @@ -1700,6 +1701,85 @@ Tcl_GetStringFromObj( /* *---------------------------------------------------------------------- * + * Tcl_InitStringRep -- + * + * This function is called in several configurations to provide all + * the tools needed to set an object's string representation. The + * function is determined by the arguments. + * + * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0) + * Invalid call -- panic! + * + * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0 + * Allocation only - allocate space for (numBytes+1) chars. + * store in objPtr->bytes and return. Also sets + * objPtr->length to 0 and objPtr->bytes[0] to NUL. + * + * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0 + * Allocate and copy. bytes is assumed to point to chars to + * copy into the string rep. objPtr->length = numBytes. Allocate + * array of (numBytes + 1) chars. store in objPtr->bytes. Copy + * numBytes chars from bytes to objPtr->bytes; Set + * objPtr->bytes[numBytes] to NUL and return objPtr->bytes. + * Caller must guarantee there are numBytes chars at bytes to + * be copied. + * + * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0 + * Truncate. Set objPtr->length to numBytes and + * objPr->bytes[numBytes] to NUL. Caller has to guarantee + * that a prior allocating call allocated enough bytes for + * this to be valid. Return objPtr->bytes. + * + * Caller is expected to ascertain that the bytes copied into + * the string rep make up complete valid UTF-8 characters. + * + * Results: + * A pointer to the string rep of objPtr. + * + * Side effects: + * As described above. + * + *---------------------------------------------------------------------- + */ + +char * +Tcl_InitStringRep( + Tcl_Obj *objPtr, /* Object whose string rep is to be set */ + const char *bytes, + int numBytes) +{ + assert(numBytes >= 0); + + assert(objPtr->bytes == NULL || bytes == NULL); + + /* Allocate */ + if (objPtr->bytes == NULL) { + /* Allocate only as empty - extend later if bytes copied */ + objPtr->length = 0; + if (numBytes) { + objPtr->bytes = (char *)ckalloc((unsigned)(numBytes+1)); + if (bytes) { + /* Copy */ + memcpy(objPtr->bytes, bytes, (unsigned) numBytes); + objPtr->length = numBytes; + } + } else { + objPtr->bytes = tclEmptyStringRep; + } + } else { + /* objPtr->bytes != NULL bytes == NULL - Truncate */ + objPtr->length = numBytes; + } + + /* Terminate */ + objPtr->bytes[objPtr->length] = '\0'; + + return objPtr->bytes; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_InvalidateStringRep -- * * This function is called to invalidate an object's string diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 83dd9d6..775d4ac 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1416,6 +1416,7 @@ const TclStubs tclStubs = { Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ Tcl_FreeIntRep, /* 631 */ + Tcl_InitStringRep, /* 632 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12 From 37f5c2af038e71d1c88fe0fcb9d061b6c620dec0 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 04:50:21 +0000 Subject: Make sure no path emerges to write on tclEmptyStringRep. --- generic/tclObj.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclObj.c b/generic/tclObj.c index 7fe0293..4f7194b 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1765,6 +1765,7 @@ Tcl_InitStringRep( } } else { objPtr->bytes = tclEmptyStringRep; + return NULL; } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ -- cgit v0.12 From cae0944edaf0979a05c2dab80d18f6434b0b306e Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 10:10:10 +0000 Subject: Release memory after truncation. --- generic/tclObj.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/generic/tclObj.c b/generic/tclObj.c index 4f7194b..72c2340 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1769,6 +1769,11 @@ Tcl_InitStringRep( } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ + assert(numBytes <= objPtr->length); + if (objPtr->length > numBytes) { + objPtr->bytes = (char *)ckrealloc(objPtr->bytes, + (unsigned)(numBytes+1)); + } objPtr->length = numBytes; } -- cgit v0.12 From 847f2ba0d5e6d3bdc2c069bb54dcea60f2174cd0 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 14:10:39 +0000 Subject: Revise Tcl_InitStringRep(); numBytes is unsigned. Only truncation permitted. --- generic/tcl.decls | 3 ++- generic/tclDecls.h | 4 ++-- generic/tclObj.c | 23 ++++++++++++----------- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 24484a5..2bb49b9 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2331,7 +2331,8 @@ declare 631 { void Tcl_FreeIntRep(Tcl_Obj *objPtr) } declare 632 { - char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, int numBytes) + char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, + unsigned int numBytes) } # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3e2ac18..7114ad9 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1820,7 +1820,7 @@ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); /* 632 */ EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - int numBytes); + unsigned int numBytes); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2488,7 +2488,7 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 631 */ - char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, int numBytes); /* 632 */ + char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 632 */ } TclStubs; extern const TclStubs *tclStubsPtr; diff --git a/generic/tclObj.c b/generic/tclObj.c index 72c2340..3fb344e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1746,22 +1746,24 @@ char * Tcl_InitStringRep( Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, - int numBytes) + unsigned int numBytes) { - assert(numBytes >= 0); - assert(objPtr->bytes == NULL || bytes == NULL); + if (numBytes > INT_MAX) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + /* Allocate */ if (objPtr->bytes == NULL) { /* Allocate only as empty - extend later if bytes copied */ objPtr->length = 0; if (numBytes) { - objPtr->bytes = (char *)ckalloc((unsigned)(numBytes+1)); + objPtr->bytes = (char *)ckalloc(numBytes+1); if (bytes) { /* Copy */ - memcpy(objPtr->bytes, bytes, (unsigned) numBytes); - objPtr->length = numBytes; + memcpy(objPtr->bytes, bytes, numBytes); + objPtr->length = (int) numBytes; } } else { objPtr->bytes = tclEmptyStringRep; @@ -1769,12 +1771,11 @@ Tcl_InitStringRep( } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ - assert(numBytes <= objPtr->length); - if (objPtr->length > numBytes) { - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, - (unsigned)(numBytes+1)); + assert((int)numBytes <= objPtr->length); + if (objPtr->length > (int)numBytes) { + objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes+1); + objPtr->length = (int)numBytes; } - objPtr->length = numBytes; } /* Terminate */ -- cgit v0.12 From 422d353b0a2e391d172664cb529dc42ac783b708 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 15:19:05 +0000 Subject: Tcl_InitStringRep() bug. Truncation assumed length == allocated. Wrong! Convert "bytearray" Tcl_ObjType to used new facilities. No longer directly refers to bytes or length fields, or any ckalloc of string rep. --- generic/tclBinary.c | 61 +++++++++++++++++++++++++---------------------------- generic/tclObj.c | 7 ++---- 2 files changed, 31 insertions(+), 37 deletions(-) diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 981f174..7abb5c5 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -15,6 +15,7 @@ #include "tommath.h" #include +#include /* * The following constants are used by GetFormatSpec to indicate various @@ -195,9 +196,9 @@ const Tcl_ObjType tclByteArrayType = { */ typedef struct ByteArray { - int used; /* The number of bytes used in the byte + unsigned int used; /* The number of bytes used in the byte * array. */ - int allocated; /* The amount of space actually allocated + unsigned int allocated; /* The amount of space actually allocated * minus 1 byte. */ unsigned char bytes[1]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field @@ -410,6 +411,10 @@ Tcl_SetByteArrayLength( int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; + unsigned newLength; + + assert(length >= 0); + newLength = (unsigned int)length; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); @@ -419,13 +424,13 @@ Tcl_SetByteArrayLength( } byteArrayPtr = GET_BYTEARRAY(objPtr); - if (length > byteArrayPtr->allocated) { - byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length)); - byteArrayPtr->allocated = length; + if (newLength > byteArrayPtr->allocated) { + byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength)); + byteArrayPtr->allocated = newLength; SET_BYTEARRAY(objPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); - byteArrayPtr->used = length; + byteArrayPtr->used = newLength; return byteArrayPtr->bytes; } @@ -523,7 +528,7 @@ DupByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - int length; + unsigned int length; ByteArray *srcArrayPtr, *copyArrayPtr; srcArrayPtr = GET_BYTEARRAY(srcPtr); @@ -565,41 +570,32 @@ UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { - int i, length, size; - unsigned char *src; - char *dst; - ByteArray *byteArrayPtr; - - byteArrayPtr = GET_BYTEARRAY(objPtr); - src = byteArrayPtr->bytes; - length = byteArrayPtr->used; + ByteArray *byteArrayPtr = GET_BYTEARRAY(objPtr); + unsigned char *src = byteArrayPtr->bytes; + unsigned int i, length = byteArrayPtr->used; + unsigned int size = length; /* * How much space will string rep need? */ - size = length; - for (i = 0; i < length && size >= 0; i++) { + for (i = 0; i < length && size <= INT_MAX; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } - if (size < 0) { + if (size > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } - dst = ckalloc(size + 1); - objPtr->bytes = dst; - objPtr->length = size; - if (size == length) { - memcpy(dst, src, (size_t) size); - dst[size] = '\0'; + (void) Tcl_InitStringRep(objPtr, (char *)src, size); } else { + char *dst = Tcl_InitStringRep(objPtr, NULL, size); for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } - *dst = '\0'; + (void)Tcl_InitStringRep(objPtr, NULL, size); } } @@ -629,7 +625,7 @@ TclAppendBytesToByteArray( int len) { ByteArray *byteArrayPtr; - int needed; + unsigned int length, needed; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); @@ -642,23 +638,24 @@ TclAppendBytesToByteArray( /* Append zero bytes is a no-op. */ return; } + length = (unsigned int)len; if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } byteArrayPtr = GET_BYTEARRAY(objPtr); - if (len > INT_MAX - byteArrayPtr->used) { + if (length > INT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } - needed = byteArrayPtr->used + len; + needed = byteArrayPtr->used + length; /* * If we need to, resize the allocated space in the byte array. */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; - int attempt; + unsigned int attempt; if (needed <= INT_MAX/2) { /* Try to allocate double the total space that is needed. */ @@ -668,7 +665,7 @@ TclAppendBytesToByteArray( if (ptr == NULL) { /* Try to allocate double the increment that is needed (plus). */ unsigned int limit = INT_MAX - needed; - unsigned int extra = len + TCL_MIN_GROWTH; + unsigned int extra = length + TCL_MIN_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; @@ -685,9 +682,9 @@ TclAppendBytesToByteArray( } if (bytes) { - memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len); + memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length); } - byteArrayPtr->used += len; + byteArrayPtr->used += length; TclInvalidateStringRep(objPtr); } diff --git a/generic/tclObj.c b/generic/tclObj.c index 3fb344e..d1fde0e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1771,11 +1771,8 @@ Tcl_InitStringRep( } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ - assert((int)numBytes <= objPtr->length); - if (objPtr->length > (int)numBytes) { - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes+1); - objPtr->length = (int)numBytes; - } + objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes+1); + objPtr->length = (int)numBytes; } /* Terminate */ -- cgit v0.12 From c79a28077fd431a82b7f82e27b1c053fc7f81a94 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 21:36:29 +0000 Subject: Convert "dict" Tcl_ObjType to use new routines. --- generic/tclDictObj.c | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index c8474e6..46fa623 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -513,8 +513,7 @@ UpdateStringOfDict( /* Handle empty list case first, simplifies what follows */ if (numElems == 0) { - dictPtr->bytes = tclEmptyStringRep; - dictPtr->length = 0; + Tcl_InitStringRep(dictPtr, NULL, 0); return; } @@ -560,9 +559,7 @@ UpdateStringOfDict( * Pass 2: copy into string rep buffer. */ - dictPtr->length = bytesNeeded - 1; - dictPtr->bytes = ckalloc(bytesNeeded); - dst = dictPtr->bytes; + dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); @@ -576,7 +573,7 @@ UpdateStringOfDict( dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } - dictPtr->bytes[dictPtr->length] = '\0'; + (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); if (flagPtr != localFlags) { ckfree(flagPtr); @@ -675,10 +672,13 @@ SetDictFromAny( TclNewStringObj(keyPtr, elemStart, elemSize); } else { /* Avoid double copy */ + char *dst; + TclNewObj(keyPtr); - keyPtr->bytes = ckalloc((unsigned) elemSize + 1); - keyPtr->length = TclCopyAndCollapse(elemSize, elemStart, - keyPtr->bytes); + Tcl_InvalidateStringRep(keyPtr); + dst = Tcl_InitStringRep(keyPtr, NULL, elemSize); + (void)Tcl_InitStringRep(keyPtr, NULL, + TclCopyAndCollapse(elemSize, elemStart, dst)); } if (TclFindDictElement(interp, nextElem, (limit - nextElem), @@ -691,10 +691,13 @@ SetDictFromAny( TclNewStringObj(valuePtr, elemStart, elemSize); } else { /* Avoid double copy */ + char *dst; + TclNewObj(valuePtr); - valuePtr->bytes = ckalloc((unsigned) elemSize + 1); - valuePtr->length = TclCopyAndCollapse(elemSize, elemStart, - valuePtr->bytes); + Tcl_InvalidateStringRep(valuePtr); + dst = Tcl_InitStringRep(valuePtr, NULL, elemSize); + (void)Tcl_InitStringRep(valuePtr, NULL, + TclCopyAndCollapse(elemSize, elemStart, dst)); } /* Store key and value in the hash table we're building. */ -- cgit v0.12 From 0412f3af193e42847eea813ee1e7a73f33bb4df2 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Mar 2016 21:50:15 +0000 Subject: Revise "ensembleCommand" Tcl_ObjType to use new routines. --- generic/tclEnsemble.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 986a553..2ef2861 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2703,11 +2703,9 @@ StringOfEnsembleCmdRep( Tcl_Obj *objPtr) { EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; - int length = strlen(ensembleCmd->fullSubcmdName); - objPtr->length = length; - objPtr->bytes = ckalloc(length + 1); - memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1); + Tcl_InitStringRep(objPtr, ensembleCmd->fullSubcmdName, + strlen(ensembleCmd->fullSubcmdName)); } /* -- cgit v0.12 From 80bc5b30c2abaeff82866adde88e8582f8950ac1 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 01:50:58 +0000 Subject: Revise "osType" Tcl_ObjType to use new routine. --- macosx/tclMacOSXFCmd.c | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 8ecfd0b..13a939f 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -692,24 +692,25 @@ UpdateStringOfOSType( register Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { - char string[5]; + const int size = TCL_UTF_MAX * 4; + char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.longValue; - Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); - unsigned len; - - string[0] = (char) (osType >> 24); - string[1] = (char) (osType >> 16); - string[2] = (char) (osType >> 8); - string[3] = (char) (osType); - string[4] = '\0'; - Tcl_ExternalToUtfDString(encoding, string, -1, &ds); - len = (unsigned) Tcl_DStringLength(&ds) + 1; - objPtr->bytes = ckalloc(len); - memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len); - objPtr->length = Tcl_DStringLength(&ds); - Tcl_DStringFree(&ds); + char src[5]; + int written; + + src[0] = (char) (osType >> 24); + src[1] = (char) (osType >> 16); + src[2] = (char) (osType >> 8); + src[3] = (char) (osType); + src[4] = '\0'; + + Tcl_ExternalToUtf(NULL, encoding, src, -1, /* flags */ 0, + /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL, + /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL); Tcl_FreeEncoding(encoding); + + (void)Tcl_InitStringRep(objPtr, NULL, written); } /* -- cgit v0.12 From dc0adeafb4cc6aa8cb93633fa770603a4a3de6ba Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 12:51:49 +0000 Subject: Revised "end-offset" Tcl_ObjType to use new routine. --- generic/tclUtil.c | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 2b0fb72..1d5e8fe 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3653,17 +3653,16 @@ static void UpdateStringOfEndOffset( register Tcl_Obj *objPtr) { - char buffer[TCL_INTEGER_SPACE + 5]; - register int len = 3; + char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); + int len = 3; - memcpy(buffer, "end", 4); + memcpy(dst, "end", len); if (objPtr->internalRep.longValue != 0) { - buffer[len++] = '-'; - len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue)); + dst[len++] = '-'; + len += TclFormatInt(dst+len, -(objPtr->internalRep.longValue)); } - objPtr->bytes = ckalloc((unsigned) len+1); - memcpy(objPtr->bytes, buffer, (unsigned) len+1); - objPtr->length = len; + + (void) Tcl_InitStringRep(objPtr, NULL, len); } /* -- cgit v0.12 From e9a10d7cdae1257ea36691dba5b3000f11abcf5c Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 12:59:06 +0000 Subject: stay out of internals when nice interfaces are available. --- generic/tclTest.c | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 7c30d36..5bfa8f7 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7012,17 +7012,11 @@ TestconcatobjCmd( list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); - if (list1Ptr->bytes != NULL) { - ckfree(list1Ptr->bytes); - list1Ptr->bytes = NULL; - } + Tcl_InvalidateStringrep(list1Ptr); list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); - if (list2Ptr->bytes != NULL) { - ckfree(list2Ptr->bytes); - list2Ptr->bytes = NULL; - } + Tcl_InvalidateStringrep(list2Ptr); /* * Verify that concat'ing a list obj with one or more empty strings does -- cgit v0.12 From f6b543ae9431387f8ea088cb545591b29ee30c90 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 13:16:42 +0000 Subject: oops --- generic/tclOOMethod.c | 4 +--- generic/tclTest.c | 4 ++-- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 34fa108..6c9a2eb 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1540,9 +1540,7 @@ TclOOGetMethodBody( if (mPtr->typePtr == &procMethodType) { ProcedureMethod *pmPtr = mPtr->clientData; - if (pmPtr->procPtr->bodyPtr->bytes == NULL) { - (void) Tcl_GetString(pmPtr->procPtr->bodyPtr); - } + (void) TclGetString(pmPtr->procPtr->bodyPtr); return pmPtr->procPtr->bodyPtr; } return NULL; diff --git a/generic/tclTest.c b/generic/tclTest.c index 5bfa8f7..d96e356 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7012,11 +7012,11 @@ TestconcatobjCmd( list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); - Tcl_InvalidateStringrep(list1Ptr); + Tcl_InvalidateStringRep(list1Ptr); list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); - Tcl_InvalidateStringrep(list2Ptr); + Tcl_InvalidateStringRep(list2Ptr); /* * Verify that concat'ing a list obj with one or more empty strings does -- cgit v0.12 From 83ac8470a00b857bd74ea2071d5aa77e6de4d00b Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 13:50:59 +0000 Subject: TclInitStringRep() already knows about tclEmptyStringRep. --- generic/tclObj.c | 2 +- generic/tclStringObj.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index d1fde0e..52be4cc 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3505,7 +3505,7 @@ GetBignumFromObj( objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; if (objPtr->bytes == NULL) { - TclInitStringRep(objPtr, tclEmptyStringRep, 0); + TclInitStringRep(objPtr, NULL, 0); } } return TCL_OK; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 11a57e9..f867b76 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3026,7 +3026,7 @@ UpdateStringOfString( String *stringPtr = GET_STRING(objPtr); if (stringPtr->numChars == 0) { - TclInitStringRep(objPtr, tclEmptyStringRep, 0); + TclInitStringRep(objPtr, NULL, 0); } else { (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode, stringPtr->numChars); -- cgit v0.12 From 325b2f4adeef8a56f6c4cf0a758e809c544cdd90 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 14:40:35 +0000 Subject: Update more Tcl_ObjTypes to use Tcl_InitStringRep(). Adapt TclInitStringRep macro to accept TclInitStringRep(objptr, NULL, 0) without warning -- requires outwitting compiler. --- generic/tclInt.h | 2 +- generic/tclObj.c | 59 ++++++++++++++++++++++++-------------------------------- 2 files changed, 26 insertions(+), 35 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 42c13dd..462e1e0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4206,7 +4206,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->length = 0; \ } else { \ (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ - memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \ + memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : tclEmptyStringRep, (unsigned) (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ } diff --git a/generic/tclObj.c b/generic/tclObj.c index 52be4cc..aa81588 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1062,9 +1062,8 @@ TclDbInitNewObj( * debugging. */ { objPtr->refCount = 0; - objPtr->bytes = tclEmptyStringRep; - objPtr->length = 0; objPtr->typePtr = NULL; + TclInitStringRep(objPtr, NULL, 0); #ifdef TCL_THREADS /* @@ -1917,6 +1916,7 @@ Tcl_DbNewBooleanObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.longValue = (boolValue? 1 : 0); @@ -2309,6 +2309,7 @@ Tcl_DbNewDoubleObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; @@ -2475,15 +2476,10 @@ static void UpdateStringOfDouble( register Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { - char buffer[TCL_DOUBLE_SPACE]; - register int len; + char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); - Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer); - len = strlen(buffer); - - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, (unsigned) len + 1); - objPtr->length = len; + Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); + (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } /* @@ -2673,14 +2669,9 @@ static void UpdateStringOfInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { - char buffer[TCL_INTEGER_SPACE]; - register int len; - - len = TclFormatInt(buffer, objPtr->internalRep.longValue); - - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, (unsigned) len + 1); - objPtr->length = len; + (void) Tcl_InitStringRep(objPtr, NULL, + TclFormatInt(Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE), + objPtr->internalRep.longValue)); } /* @@ -2784,6 +2775,7 @@ Tcl_DbNewLongObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep */ objPtr->bytes = NULL; objPtr->internalRep.longValue = longValue; @@ -2968,9 +2960,7 @@ static void UpdateStringOfWideInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { - char buffer[TCL_INTEGER_SPACE+2]; - register unsigned len; - register Tcl_WideInt wideVal = objPtr->internalRep.wideValue; + char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 2); /* * Note that sprintf will generate a compiler warning under Mingw claiming @@ -2979,11 +2969,9 @@ UpdateStringOfWideInt( * value. */ - sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal); - len = strlen(buffer); - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, len + 1); - objPtr->length = len; + sprintf(dst, "%" TCL_LL_MODIFIER "d", objPtr->internalRep.wideValue); + + (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } #endif /* !TCL_WIDE_INT_IS_LONG */ @@ -3353,12 +3341,10 @@ UpdateStringOfBignum( { mp_int bignumVal; int size; - int status; char *stringVal; UNPACK_BIGNUM(objPtr, bignumVal); - status = mp_radix_size(&bignumVal, 10, &size); - if (status != MP_OKAY) { + if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) { Tcl_Panic("radix size failure in UpdateStringOfBignum"); } if (size == 3) { @@ -3375,13 +3361,12 @@ UpdateStringOfBignum( Tcl_Panic("UpdateStringOfBignum: string length limit exceeded"); } - stringVal = ckalloc(size); - status = mp_toradix_n(&bignumVal, stringVal, 10, size); - if (status != MP_OKAY) { + + stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1); + if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) { Tcl_Panic("conversion failure in UpdateStringOfBignum"); } - objPtr->bytes = stringVal; - objPtr->length = size - 1; /* size includes a trailing NUL byte. */ + (void) Tcl_InitStringRep(objPtr, NULL, size - 1); } /* @@ -3501,9 +3486,15 @@ GetBignumFromObj( mp_init_copy(bignumValue, &temp); } else { UNPACK_BIGNUM(objPtr, *bignumValue); + /* Optimized TclFreeIntRep */ objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; + /* + * TODO: If objPtr has a string rep, this leaves + * it undisturbed. Not clear that's proper. Pure + * bignum values are converted to empty string. + */ if (objPtr->bytes == NULL) { TclInitStringRep(objPtr, NULL, 0); } -- cgit v0.12 From 959413c95a407dc8c50631052a87aa02bc11ee2d Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 15:01:43 +0000 Subject: More purging of direct access to bytes field where it isn't important. --- generic/tclCmdIL.c | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 739dca9..e32aff0 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -544,9 +544,9 @@ InfoBodyCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; - const char *name; + const char *name, *bytes; Proc *procPtr; - Tcl_Obj *bodyPtr, *resultPtr; + int numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); @@ -571,18 +571,8 @@ InfoBodyCmd( * the object do not invalidate the internal rep. */ - bodyPtr = procPtr->bodyPtr; - if (bodyPtr->bytes == NULL) { - /* - * The string rep might not be valid if the procedure has never been - * run before. [Bug #545644] - */ - - TclGetString(bodyPtr); - } - resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length); - - Tcl_SetObjResult(interp, resultPtr); + bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes); + Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes)); return TCL_OK; } -- cgit v0.12 From 8370f3e2755cd93636a048bfd20d661ff7c56cbc Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 19:21:47 +0000 Subject: Revise Tcl_InitStringRep() to do non-panic attempt at allocation. Let caller decide how catastrophic it is. Revise [string repeat] to use new routine. --- generic/tclCmdMZ.c | 21 +++++---------------- generic/tclObj.c | 7 +++++-- 2 files changed, 10 insertions(+), 18 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 13f9e7d..02d050a 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2275,11 +2275,9 @@ StringReptCmd( } length2 = length1 * count; - /* - * Include space for the NUL. - */ - - string2 = attemptckalloc((unsigned) length2 + 1); + TclNewObj(resultPtr); + Tcl_InvalidateStringRep(resultPtr); + string2 = Tcl_InitStringRep(resultPtr, NULL, length2); if (string2 == NULL) { /* * Alloc failed. Note that in this case we try to do an error message @@ -2292,22 +2290,13 @@ StringReptCmd( "string size overflow, out of memory allocating %u bytes", length2 + 1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } for (index = 0; index < count; index++) { memcpy(string2 + (length1 * index), string1, (size_t) length1); } - string2[length2] = '\0'; - - /* - * We have to directly assign this instead of using Tcl_SetStringObj (and - * indirectly TclInitStringRep) because that makes another copy of the - * data. - */ - - TclNewObj(resultPtr); - resultPtr->bytes = string2; - resultPtr->length = length2; + (void) Tcl_InitStringRep(resultPtr, NULL, length2); Tcl_SetObjResult(interp, resultPtr); done: diff --git a/generic/tclObj.c b/generic/tclObj.c index aa81588..f1f4f1d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1758,7 +1758,10 @@ Tcl_InitStringRep( /* Allocate only as empty - extend later if bytes copied */ objPtr->length = 0; if (numBytes) { - objPtr->bytes = (char *)ckalloc(numBytes+1); + objPtr->bytes = attemptckalloc(numBytes + 1); + if (objPtr->bytes == NULL) { + return NULL; + } if (bytes) { /* Copy */ memcpy(objPtr->bytes, bytes, numBytes); @@ -1770,7 +1773,7 @@ Tcl_InitStringRep( } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes+1); + objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1); objPtr->length = (int)numBytes; } -- cgit v0.12 From 413706af15c4f39a0cec781c067faa9eefafd5b8 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 20:15:01 +0000 Subject: Update Tcl_InitStringRep callers to handle OOM condition. --- generic/tclBinary.c | 4 +++- generic/tclDictObj.c | 3 +++ generic/tclEnsemble.c | 5 +++-- generic/tclInt.h | 7 +++++++ generic/tclObj.c | 12 ++++++++++-- generic/tclUtil.c | 2 ++ macosx/tclMacOSXFCmd.c | 7 +++++-- 7 files changed, 33 insertions(+), 7 deletions(-) diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 7abb5c5..b7fea30 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -589,9 +589,11 @@ UpdateStringOfByteArray( } if (size == length) { - (void) Tcl_InitStringRep(objPtr, (char *)src, size); + char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); + TclOOM(dst, size); } else { char *dst = Tcl_InitStringRep(objPtr, NULL, size); + TclOOM(dst, size); for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 46fa623..ae7280a 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -560,6 +560,7 @@ UpdateStringOfDict( */ dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); + TclOOM(dst, bytesNeeded) for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); @@ -677,6 +678,7 @@ SetDictFromAny( TclNewObj(keyPtr); Tcl_InvalidateStringRep(keyPtr); dst = Tcl_InitStringRep(keyPtr, NULL, elemSize); + TclOOM(dst, elemSize); /* Consider error */ (void)Tcl_InitStringRep(keyPtr, NULL, TclCopyAndCollapse(elemSize, elemStart, dst)); } @@ -696,6 +698,7 @@ SetDictFromAny( TclNewObj(valuePtr); Tcl_InvalidateStringRep(valuePtr); dst = Tcl_InitStringRep(valuePtr, NULL, elemSize); + TclOOM(dst, elemSize); /* Consider error */ (void)Tcl_InitStringRep(valuePtr, NULL, TclCopyAndCollapse(elemSize, elemStart, dst)); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 2ef2861..e034d6e 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2703,9 +2703,10 @@ StringOfEnsembleCmdRep( Tcl_Obj *objPtr) { EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + unsigned int size = strlen(ensembleCmd->fullSubcmdName); + char *dst = Tcl_InitStringRep(objPtr, ensembleCmd->fullSubcmdName, size); - Tcl_InitStringRep(objPtr, ensembleCmd->fullSubcmdName, - strlen(ensembleCmd->fullSubcmdName)); + TclOOM(dst, size); } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 462e1e0..50f7a76 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2314,6 +2314,13 @@ typedef struct Interp { #define TCL_ALIGN(x) (((int)(x) + 7) & ~7) /* + * A common panic alert when memory allocation fails. + */ + +#define TclOOM(ptr, size) \ + ((size) && ((ptr)||(Tcl_Panic("unable to alloc %u bytes", (size)),1))) + +/* * The following enum values are used to specify the runtime platform setting * of the tclPlatform variable. */ diff --git a/generic/tclObj.c b/generic/tclObj.c index f1f4f1d..2a35539 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2481,6 +2481,8 @@ UpdateStringOfDouble( { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); + TclOOM(dst, TCL_DOUBLE_SPACE + 1); + Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } @@ -2672,9 +2674,11 @@ static void UpdateStringOfInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { + char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); + + TclOOM(dst, TCL_INTEGER_SPACE + 1); (void) Tcl_InitStringRep(objPtr, NULL, - TclFormatInt(Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE), - objPtr->internalRep.longValue)); + TclFormatInt(dst, objPtr->internalRep.longValue)); } /* @@ -2965,6 +2969,8 @@ UpdateStringOfWideInt( { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 2); + TclOOM(dst, TCL_INTEGER_SPACE + 3); + /* * Note that sprintf will generate a compiler warning under Mingw claiming * %I64 is an unknown format specifier. Just ignore this warning. We can't @@ -3366,6 +3372,8 @@ UpdateStringOfBignum( } stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1); + + TclOOM(stringVal, size); if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) { Tcl_Panic("conversion failure in UpdateStringOfBignum"); } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 1d5e8fe..01f8225 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3656,6 +3656,8 @@ UpdateStringOfEndOffset( char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); int len = 3; + TclOOM(dst, TCL_INTEGER_SPACE + 6); + memcpy(dst, "end", len); if (objPtr->internalRep.longValue != 0) { dst[len++] = '-'; diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 13a939f..8659e95 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -695,9 +695,11 @@ UpdateStringOfOSType( const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.longValue; - Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + int written = 0; + Tcl_Encoding encoding; char src[5]; - int written; + + TclOOM(dst, size); src[0] = (char) (osType >> 24); src[1] = (char) (osType >> 16); @@ -705,6 +707,7 @@ UpdateStringOfOSType( src[3] = (char) (osType); src[4] = '\0'; + encoding = Tcl_GetEncoding(NULL, "macRoman"); Tcl_ExternalToUtf(NULL, encoding, src, -1, /* flags */ 0, /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL, /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL); -- cgit v0.12 From a19375e928a3f10c0d05c5cdbbfac0a838aee1db Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 20:17:52 +0000 Subject: oops --- generic/tclDictObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index ae7280a..f7e825c 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -560,7 +560,7 @@ UpdateStringOfDict( */ dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); - TclOOM(dst, bytesNeeded) + TclOOM(dst, bytesNeeded); for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); -- cgit v0.12 From 1bebb796bb6f2799a3f1bcc021481a6a71adcbc1 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 20:33:27 +0000 Subject: Revise the "instname" Tcl_ObjType to use the routines. --- generic/tclDisassemble.c | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index c85fe13..ecd5f38 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -804,6 +804,7 @@ TclNewInstNameObj( objPtr->typePtr = &tclInstNameType; objPtr->internalRep.longValue = (long) inst; + /* Optimized Tcl_InvalidateStringRep */ objPtr->bytes = NULL; return objPtr; @@ -824,19 +825,19 @@ UpdateStringOfInstName( Tcl_Obj *objPtr) { int inst = objPtr->internalRep.longValue; - char *s, buf[20]; - int len; + char *dst; if ((inst < 0) || (inst > LAST_INST_OPCODE)) { - sprintf(buf, "inst_%d", inst); - s = buf; + dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 4); + TclOOM(dst, TCL_INTEGER_SPACE + 4); + sprintf(dst, "inst_%d", inst); + (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { - s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name; + const char *s = tclInstructionTable[objPtr->internalRep.longValue].name; + int len = strlen(s); + dst = Tcl_InitStringRep(objPtr, s, len); + TclOOM(dst, len); } - len = strlen(s); - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, s, len + 1); - objPtr->length = len; } /* -- cgit v0.12 From a5e1e1f33e40417a5dbacb82a9f716a858aa12ec Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Mar 2016 21:11:52 +0000 Subject: Revise the "index" Tcl_ObjType to use the new routine. --- generic/tclIndexObj.c | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ce8b9fb..e00ca8c 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -449,15 +449,9 @@ UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; - register char *buf; - register unsigned len; register const char *indexStr = EXPAND_OF(indexRep); - len = strlen(indexStr); - buf = ckalloc(len + 1); - memcpy(buf, indexStr, len+1); - objPtr->bytes = buf; - objPtr->length = len; + Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* -- cgit v0.12 From c7039276a0e64e1cc8f2d8a813a9007eee1e89fa Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 25 Mar 2016 12:24:04 +0000 Subject: Create a type Tcl_ObjIntRep so we can pass intreps as arguments. --- generic/tcl.h | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 3cd90a9..c451579 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -801,6 +801,29 @@ typedef struct Tcl_ObjType { } Tcl_ObjType; /* + * The following structure stores an internal representation (intrep) for + * a Tcl value. An intrep is associated with an Tcl_ObjType when both + * are stored in the same Tcl_Obj. The routines of the Tcl_ObjType govern + * the handling of the intrep. + */ + +typedef union Tcl_ObjIntRep { /* The internal representation: */ + long longValue; /* - an long integer value. */ + double doubleValue; /* - a double-precision floating value. */ + void *otherValuePtr; /* - another, type-specific value, */ + /* not used internally any more. */ + Tcl_WideInt wideValue; /* - an integer value >= 64bits */ + struct { /* - internal rep as two pointers. */ + void *ptr1; + void *ptr2; + } twoPtrValue; + struct { /* - internal rep as a pointer and a long, */ + void *ptr; /* not used internally any more. */ + unsigned long value; + } ptrAndLongRep; +} Tcl_ObjIntRep; + +/* * One of the following structures exists for each object in the Tcl system. * An object stores a value as either a string, some internal representation, * or both. @@ -825,26 +848,7 @@ typedef struct Tcl_Obj { * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ - union { /* The internal representation: */ - long longValue; /* - an long integer value. */ - double doubleValue; /* - a double-precision floating value. */ - void *otherValuePtr; /* - another, type-specific value, - not used internally any more. */ - Tcl_WideInt wideValue; /* - a long long value. */ - struct { /* - internal rep as two pointers. - * the main use of which is a bignum's - * tightly packed fields, where the alloc, - * used and signum flags are packed into - * ptr2 with everything else hung off ptr1. */ - void *ptr1; - void *ptr2; - } twoPtrValue; - struct { /* - internal rep as a pointer and a long, - not used internally any more. */ - void *ptr; - unsigned long value; - } ptrAndLongRep; - } internalRep; + Tcl_ObjIntRep internalRep; /* The internal representation: */ } Tcl_Obj; /* -- cgit v0.12 From f19cbcbff50d1926240759ab4e4bfcd0cc6e54d9 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 25 Mar 2016 13:06:53 +0000 Subject: New routines Tcl_FetchIntRep() and Tcl_StoreIntRep(). --- generic/tcl.decls | 8 ++++++ generic/tclDecls.h | 13 ++++++++++ generic/tclObj.c | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStubInit.c | 2 ++ 4 files changed, 94 insertions(+) diff --git a/generic/tcl.decls b/generic/tcl.decls index 2bb49b9..962a563 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2334,6 +2334,14 @@ declare 632 { char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes) } +declare 633 { + const Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr) +} +declare 634 { + void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, + Tcl_ObjIntRep *irPtr) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 7114ad9..609ec86 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1821,6 +1821,13 @@ EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); /* 632 */ EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); +/* 633 */ +EXTERN const Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr); +/* 634 */ +EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr, + Tcl_ObjIntRep *irPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2489,6 +2496,8 @@ typedef struct TclStubs { void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 631 */ char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 632 */ + const Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 633 */ + void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, Tcl_ObjIntRep *irPtr); /* 634 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3785,6 +3794,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FreeIntRep) /* 631 */ #define Tcl_InitStringRep \ (tclStubsPtr->tcl_InitStringRep) /* 632 */ +#define Tcl_FetchIntRep \ + (tclStubsPtr->tcl_FetchIntRep) /* 633 */ +#define Tcl_StoreIntRep \ + (tclStubsPtr->tcl_StoreIntRep) /* 634 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 2a35539..55426bf 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1812,6 +1812,77 @@ Tcl_InvalidateStringRep( /* *---------------------------------------------------------------------- * + * Tcl_StoreIntRep -- + * + * This function is called to set the object's internal + * representation to match a particular type. + * + * It is the caller's responsibility to guarantee that + * the value of the submitted IntRep is in agreement with + * the value of any existing string rep. + * + * Results: + * None. + * + * Side effects: + * Calls the freeIntRepProc of the current Tcl_ObjType, if any. + * Sets the internalRep and typePtr fields to the submitted values. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_StoreIntRep( + Tcl_Obj *objPtr, /* Object whose internal rep should be set. */ + const Tcl_ObjType *typePtr, /* New type for the object */ + Tcl_ObjIntRep *irPtr) /* New IntRep for the object */ +{ + /* Clear out any existing IntRep ( "shimmer" ) */ + TclFreeIntRep(objPtr); + + /* Copy the new IntRep into place */ + objPtr->internalRep = *irPtr; + + /* Set the type to match */ + objPtr->typePtr = typePtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_FetchIntRep -- + * + * This function is called to retrieve the object's internal + * representation matching a requested type, if any. + * + * Results: + * A read-only pointer to the associated Tcl_ObjIntRep, or + * NULL if no such internal representation exists. + * + * Side effects: + * Calls the freeIntRepProc of the current Tcl_ObjType, if any. + * Sets the internalRep and typePtr fields to the submitted values. + * + *---------------------------------------------------------------------- + */ + +const Tcl_ObjIntRep * +Tcl_FetchIntRep( + Tcl_Obj *objPtr, /* Object to fetch from. */ + const Tcl_ObjType *typePtr) /* Requested type */ +{ + /* If objPtr type doesn't match request, nothing can be fetched */ + if (objPtr->typePtr != typePtr) { + return NULL; + } + + /* Type match! objPtr IntRep is the one sought. */ + return &(objPtr->internalRep); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_FreeIntRep -- * * This function is called to free an object's internal representation. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 775d4ac..2af47b7 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1417,6 +1417,8 @@ const TclStubs tclStubs = { Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ Tcl_FreeIntRep, /* 631 */ Tcl_InitStringRep, /* 632 */ + Tcl_FetchIntRep, /* 633 */ + Tcl_StoreIntRep, /* 634 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12 From 36cf99464d3e6a33deda928dbb3d0b1abe4cf82f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 25 Mar 2016 14:01:00 +0000 Subject: First demonstration conversion to the new intrep manipulation routines. --- generic/tcl.decls | 2 +- generic/tclDecls.h | 4 ++-- generic/tclIndexObj.c | 61 ++++++++++++++++++++++++++++----------------------- 3 files changed, 37 insertions(+), 30 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 962a563..15b7040 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2340,7 +2340,7 @@ declare 633 { } declare 634 { void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, - Tcl_ObjIntRep *irPtr) + const Tcl_ObjIntRep *irPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 609ec86..5ea9151 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1827,7 +1827,7 @@ EXTERN const Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr, /* 634 */ EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, - Tcl_ObjIntRep *irPtr); + const Tcl_ObjIntRep *irPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2497,7 +2497,7 @@ typedef struct TclStubs { void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 631 */ char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 632 */ const Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 633 */ - void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, Tcl_ObjIntRep *irPtr); /* 634 */ + void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 634 */ } TclStubs; extern const TclStubs *tclStubsPtr; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index e00ca8c..836f60b 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -114,15 +114,16 @@ Tcl_GetIndexFromObj( int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { - /* * See if there is a valid cached result from a previous lookup (doing the * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in * the common case where the result is cached). */ - if (objPtr->typePtr == &indexType) { - IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &indexType); + + if (irPtr) { + IndexRep *indexRep = irPtr->twoPtrValue.ptr1; /* * Here's hoping we don't get hit by unfortunate packing constraints @@ -270,6 +271,7 @@ Tcl_GetIndexFromObjStruct( const char *const *entryPtr; Tcl_Obj *resultPtr; IndexRep *indexRep; + const Tcl_ObjIntRep *irPtr; /* Protect against invalid values, like -1 or 0. */ if (offset < (int)sizeof(char *)) { @@ -279,8 +281,9 @@ Tcl_GetIndexFromObjStruct( * See if there is a valid cached result from a previous lookup. */ - if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.twoPtrValue.ptr1; + irPtr = Tcl_FetchIntRep(objPtr, &indexType); + if (irPtr) { + indexRep = irPtr->twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; @@ -340,13 +343,15 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.twoPtrValue.ptr1; + irPtr = Tcl_FetchIntRep(objPtr, &indexType); + if (irPtr) { + indexRep = irPtr->twoPtrValue.ptr1; } else { - TclFreeIntRep(objPtr); + Tcl_ObjIntRep ir; + indexRep = ckalloc(sizeof(IndexRep)); - objPtr->internalRep.twoPtrValue.ptr1 = indexRep; - objPtr->typePtr = &indexType; + ir.twoPtrValue.ptr1 = indexRep; + Tcl_StoreIntRep(objPtr, &indexType, &ir); } indexRep->tablePtr = (void *) tablePtr; indexRep->offset = offset; @@ -448,7 +453,7 @@ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { - IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; + IndexRep *indexRep = Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; register const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); @@ -477,12 +482,14 @@ DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1; + Tcl_ObjIntRep ir; IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep)); - memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); - dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; - dupPtr->typePtr = &indexType; + memcpy(dupIndexRep, Tcl_FetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, + sizeof(IndexRep)); + + ir.twoPtrValue.ptr1 = dupIndexRep; + Tcl_StoreIntRep(dupPtr, &indexType, &ir); } /* @@ -506,7 +513,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree(objPtr->internalRep.twoPtrValue.ptr1); + ckfree(Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -944,16 +951,16 @@ Tcl_WrongNumArgs( /* * Add the element, quoting it if necessary. */ + const Tcl_ObjIntRep *irPtr; - if (origObjv[i]->typePtr == &indexType) { - register IndexRep *indexRep = - origObjv[i]->internalRep.twoPtrValue.ptr1; + if ((irPtr = Tcl_FetchIntRep(origObjv[i], &indexType))) { + register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); - } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) { - register EnsembleCmdRep *ecrPtr = - origObjv[i]->internalRep.twoPtrValue.ptr1; + } else if ((irPtr = + Tcl_FetchIntRep(origObjv[i], &tclEnsembleCmdType))) { + register EnsembleCmdRep *ecrPtr = irPtr->twoPtrValue.ptr1; elementStr = ecrPtr->fullSubcmdName; elemLen = strlen(elementStr); @@ -1000,14 +1007,14 @@ Tcl_WrongNumArgs( * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ + const Tcl_ObjIntRep *irPtr; - if (objv[i]->typePtr == &indexType) { - register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; + if ((irPtr = Tcl_FetchIntRep(objv[i], &indexType))) { + register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); - } else if (objv[i]->typePtr == &tclEnsembleCmdType) { - register EnsembleCmdRep *ecrPtr = - objv[i]->internalRep.twoPtrValue.ptr1; + } else if ((irPtr = Tcl_FetchIntRep(objv[i], &tclEnsembleCmdType))) { + register EnsembleCmdRep *ecrPtr = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL); } else { -- cgit v0.12 From 3bd88409318cdd99b39ad5ce49b87f880f01cf37 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 25 Mar 2016 19:56:56 +0000 Subject: Get signatures in sync. --- generic/tclObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 55426bf..3341fcd 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1835,7 +1835,7 @@ void Tcl_StoreIntRep( Tcl_Obj *objPtr, /* Object whose internal rep should be set. */ const Tcl_ObjType *typePtr, /* New type for the object */ - Tcl_ObjIntRep *irPtr) /* New IntRep for the object */ + const Tcl_ObjIntRep *irPtr) /* New IntRep for the object */ { /* Clear out any existing IntRep ( "shimmer" ) */ TclFreeIntRep(objPtr); -- cgit v0.12 From 0276b6e64460992b893edd94845a3daaa7773c2d Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 25 Mar 2016 20:01:39 +0000 Subject: irPtr = NULL passed to Tcl_StoreIntRep clears out any value for typePtr. --- generic/tclObj.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 3341fcd..7db9ff9 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1840,11 +1840,14 @@ Tcl_StoreIntRep( /* Clear out any existing IntRep ( "shimmer" ) */ TclFreeIntRep(objPtr); - /* Copy the new IntRep into place */ - objPtr->internalRep = *irPtr; + /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */ + if (irPtr) { + /* Copy the new IntRep into place */ + objPtr->internalRep = *irPtr; - /* Set the type to match */ - objPtr->typePtr = typePtr; + /* Set the type to match */ + objPtr->typePtr = typePtr; + } } /* -- cgit v0.12 From 6fd2ed3f11fb3b019f5d859bfe55b8aa1e7709be Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 26 Mar 2016 12:36:01 +0000 Subject: Convert the "bytearray" Tcl_ObjType to use the proposed Tcl_ObjIntRep manipulation routines. This works, but requires too much ugliness. The ugliness reveals that the interface needs some refinement, making this a rejected branch of development. --- generic/tclBinary.c | 109 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 63 insertions(+), 46 deletions(-) diff --git a/generic/tclBinary.c b/generic/tclBinary.c index b7fea30..8e791d5 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -207,10 +207,9 @@ typedef struct ByteArray { #define BYTEARRAY_SIZE(len) \ ((unsigned) (TclOffset(ByteArray, bytes) + (len))) -#define GET_BYTEARRAY(objPtr) \ - ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1) -#define SET_BYTEARRAY(objPtr, baPtr) \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr) +#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) +#define SET_BYTEARRAY(irPtr, baPtr) \ + (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) /* @@ -325,11 +324,11 @@ Tcl_SetByteArrayObj( be >= 0. */ { ByteArray *byteArrayPtr; + Tcl_ObjIntRep ir; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } - TclFreeIntRep(objPtr); TclInvalidateStringRep(objPtr); if (length < 0) { @@ -342,8 +341,9 @@ Tcl_SetByteArrayObj( if ((bytes != NULL) && (length > 0)) { memcpy(byteArrayPtr->bytes, bytes, (size_t) length); } - objPtr->typePtr = &tclByteArrayType; - SET_BYTEARRAY(objPtr, byteArrayPtr); + SET_BYTEARRAY(&ir, byteArrayPtr); + + Tcl_StoreIntRep(objPtr, &tclByteArrayType, &ir); } /* @@ -371,16 +371,18 @@ Tcl_GetByteArrayFromObj( * array of bytes in the ByteArray object. */ { ByteArray *baPtr; + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); - if (objPtr->typePtr != &tclByteArrayType) { + if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); + irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); } - baPtr = GET_BYTEARRAY(objPtr); + baPtr = GET_BYTEARRAY(irPtr); if (lengthPtr != NULL) { *lengthPtr = baPtr->used; } - return (unsigned char *) baPtr->bytes; + return baPtr->bytes; } /* @@ -412,6 +414,7 @@ Tcl_SetByteArrayLength( { ByteArray *byteArrayPtr; unsigned newLength; + const Tcl_ObjIntRep *irPtr; assert(length >= 0); newLength = (unsigned int)length; @@ -419,15 +422,22 @@ Tcl_SetByteArrayLength( if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } - if (objPtr->typePtr != &tclByteArrayType) { + irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); + irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); } - byteArrayPtr = GET_BYTEARRAY(objPtr); + byteArrayPtr = GET_BYTEARRAY(irPtr); if (newLength > byteArrayPtr->allocated) { + Tcl_ObjIntRep ir; + +/* UGLY UGLY UGLY */ +objPtr->typePtr = NULL; byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength)); byteArrayPtr->allocated = newLength; - SET_BYTEARRAY(objPtr, byteArrayPtr); + SET_BYTEARRAY(&ir, byteArrayPtr); + Tcl_StoreIntRep(objPtr, &tclByteArrayType, &ir); } TclInvalidateStringRep(objPtr); byteArrayPtr->used = newLength; @@ -459,25 +469,26 @@ SetByteArrayFromAny( const char *src, *srcEnd; unsigned char *dst; ByteArray *byteArrayPtr; - Tcl_UniChar ch; + Tcl_ObjIntRep ir; - if (objPtr->typePtr != &tclByteArrayType) { - src = TclGetStringFromObj(objPtr, &length); - srcEnd = src + length; + assert (NULL == Tcl_FetchIntRep(objPtr, &tclByteArrayType)); - byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); - for (dst = byteArrayPtr->bytes; src < srcEnd; ) { - src += Tcl_UtfToUniChar(src, &ch); - *dst++ = UCHAR(ch); - } + src = TclGetStringFromObj(objPtr, &length); + srcEnd = src + length; - byteArrayPtr->used = dst - byteArrayPtr->bytes; - byteArrayPtr->allocated = length; + byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); + for (dst = byteArrayPtr->bytes; src < srcEnd; ) { + Tcl_UniChar ch; - TclFreeIntRep(objPtr); - objPtr->typePtr = &tclByteArrayType; - SET_BYTEARRAY(objPtr, byteArrayPtr); + src += Tcl_UtfToUniChar(src, &ch); + *dst++ = UCHAR(ch); } + + byteArrayPtr->used = dst - byteArrayPtr->bytes; + byteArrayPtr->allocated = length; + + SET_BYTEARRAY(&ir, byteArrayPtr); + Tcl_StoreIntRep(objPtr, &tclByteArrayType, &ir); return TCL_OK; } @@ -502,8 +513,7 @@ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(objPtr)); - objPtr->typePtr = NULL; + ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &tclByteArrayType))); } /* @@ -530,17 +540,18 @@ DupByteArrayInternalRep( { unsigned int length; ByteArray *srcArrayPtr, *copyArrayPtr; + Tcl_ObjIntRep ir; - srcArrayPtr = GET_BYTEARRAY(srcPtr); + srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); - SET_BYTEARRAY(copyPtr, copyArrayPtr); - copyPtr->typePtr = &tclByteArrayType; + SET_BYTEARRAY(&ir, copyArrayPtr); + Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir); } /* @@ -548,9 +559,7 @@ DupByteArrayInternalRep( * * UpdateStringOfByteArray -- * - * Update the string representation for a ByteArray data object. Note: - * This procedure does not invalidate an existing old string rep so - * storage will be lost if this has not already been done. + * Update the string representation for a ByteArray data object. * * Results: * None. @@ -559,9 +568,6 @@ DupByteArrayInternalRep( * The object's string is set to a valid string that results from the * ByteArray-to-string conversion. * - * The object becomes a string object -- the internal rep is discarded - * and the typePtr becomes NULL. - * *---------------------------------------------------------------------- */ @@ -570,7 +576,8 @@ UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { - ByteArray *byteArrayPtr = GET_BYTEARRAY(objPtr); + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; unsigned int i, length = byteArrayPtr->used; unsigned int size = length; @@ -628,6 +635,7 @@ TclAppendBytesToByteArray( { ByteArray *byteArrayPtr; unsigned int length, needed; + const Tcl_ObjIntRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); @@ -641,10 +649,13 @@ TclAppendBytesToByteArray( return; } length = (unsigned int)len; - if (objPtr->typePtr != &tclByteArrayType) { + + irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); + irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); } - byteArrayPtr = GET_BYTEARRAY(objPtr); + byteArrayPtr = GET_BYTEARRAY(irPtr); if (length > INT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); @@ -658,7 +669,10 @@ TclAppendBytesToByteArray( if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; unsigned int attempt; + Tcl_ObjIntRep ir; +/* UGLY UGLY UGLY */ +objPtr->typePtr = NULL; if (needed <= INT_MAX/2) { /* Try to allocate double the total space that is needed. */ attempt = 2 * needed; @@ -680,7 +694,8 @@ TclAppendBytesToByteArray( } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; - SET_BYTEARRAY(objPtr, byteArrayPtr); + SET_BYTEARRAY(&ir, byteArrayPtr); + Tcl_StoreIntRep(objPtr, &tclByteArrayType, &ir); } if (bytes) { @@ -1880,10 +1895,11 @@ FormatNumber( */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { - if (src->typePtr != &tclDoubleType) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType); + if (irPtr == NULL) { return TCL_ERROR; } - dvalue = src->internalRep.doubleValue; + dvalue = irPtr->doubleValue; } CopyNumber(&dvalue, *cursorPtr, sizeof(double), type); *cursorPtr += sizeof(double); @@ -1899,10 +1915,11 @@ FormatNumber( */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { - if (src->typePtr != &tclDoubleType) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType); + if (irPtr == NULL) { return TCL_ERROR; } - dvalue = src->internalRep.doubleValue; + dvalue = irPtr->doubleValue; } /* -- cgit v0.12 From dcb52d2ea8467df98c8dc6f28c95a57347080acc Mon Sep 17 00:00:00 2001 From: dgp Date: Sun, 27 Mar 2016 17:07:50 +0000 Subject: A few more easy conversions. --- generic/tclClock.c | 2 +- generic/tclCmdMZ.c | 24 ++++++++++++------------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 949cb1c..a458cb9 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -438,7 +438,7 @@ ClockGetdatefieldsObjCmd( * that it isn't. */ - if (objv[1]->typePtr == &tclBignumType) { + if (Tcl_FetchIntRep(objv[1], &tclBignumType)) { Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 02d050a..71e8555 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1567,12 +1567,12 @@ StringIsCmd( break; case STR_IS_DOUBLE: { /* TODO */ - if ((objPtr->typePtr == &tclDoubleType) || - (objPtr->typePtr == &tclIntType) || + if (Tcl_FetchIntRep(objPtr, &tclDoubleType) || + Tcl_FetchIntRep(objPtr, &tclIntType) || #ifndef TCL_WIDE_INT_IS_LONG - (objPtr->typePtr == &tclWideIntType) || + Tcl_FetchIntRep(objPtr, &tclWideIntType) || #endif - (objPtr->typePtr == &tclBignumType)) { + Tcl_FetchIntRep(objPtr, &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); @@ -1605,11 +1605,11 @@ StringIsCmd( } goto failedIntParse; case STR_IS_ENTIER: - if ((objPtr->typePtr == &tclIntType) || + if (Tcl_FetchIntRep(objPtr, &tclIntType) || #ifndef TCL_WIDE_INT_IS_LONG - (objPtr->typePtr == &tclWideIntType) || + Tcl_FetchIntRep(objPtr, &tclWideIntType) || #endif - (objPtr->typePtr == &tclBignumType)) { + Tcl_FetchIntRep(objPtr, &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); @@ -1880,7 +1880,7 @@ StringMapCmd( * inconsistencies (see test string-10.20 for illustration why!) */ - if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){ + if (Tcl_FetchIntRep(objv[objc-2], &tclDictType) && objv[objc-2]->bytes == NULL){ int i, done; Tcl_DictSearch search; @@ -2621,8 +2621,8 @@ StringEqualCmd( string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1); string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2); strCmpFn = (strCmpFn_t) memcmp; - } else if ((objv[0]->typePtr == &tclStringType) - && (objv[1]->typePtr == &tclStringType)) { + } else if (Tcl_FetchIntRep(objv[0], &tclStringType) + && Tcl_FetchIntRep(objv[1], &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of String * type. In benchmark testing this proved the most efficient check @@ -2771,8 +2771,8 @@ StringCmpCmd( string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1); string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2); strCmpFn = (strCmpFn_t) memcmp; - } else if ((objv[0]->typePtr == &tclStringType) - && (objv[1]->typePtr == &tclStringType)) { + } else if (Tcl_FetchIntRep(objv[0], &tclStringType) + && Tcl_FetchIntRep(objv[1], &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of String * type. In benchmark testing this proved the most efficient check -- cgit v0.12 From 30d0cf44cb0f60e3aeeff3483eaac7b80bab79aa Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 29 Mar 2016 20:07:42 +0000 Subject: Functional conversion of "list" Tcl_ObjType to proposed routines. Not yet completely tidy and finished. --- generic/tclDictObj.c | 2 +- generic/tclExecute.c | 2 +- generic/tclInt.h | 14 +--- generic/tclListObj.c | 207 ++++++++++++++++++++++++++++++++------------------- 4 files changed, 137 insertions(+), 88 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index f7e825c..6e54137 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -618,7 +618,7 @@ SetDictFromAny( * the conversion from lists to dictionaries. */ - if (objPtr->typePtr == &tclListType) { + if (Tcl_FetchIntRep(objPtr, &tclListType)) { int objc, i; Tcl_Obj **objv; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d4077f5..b3a8d8e 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5043,7 +5043,7 @@ TEBCresume( */ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) - && (value2Ptr->typePtr != &tclListType) + && (NULL == Tcl_FetchIntRep(value2Ptr, &tclListType)) && (TclGetIntForIndexM(NULL , value2Ptr, objc-1, &index) == TCL_OK)) { TclDecrRefCount(value2Ptr); diff --git a/generic/tclInt.h b/generic/tclInt.h index 50f7a76..2de0046 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2394,12 +2394,6 @@ typedef struct List { #define ListRepPtr(listPtr) \ ((List *) (listPtr)->internalRep.twoPtrValue.ptr1) -#define ListSetIntRep(objPtr, listRepPtr) \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \ - (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \ - (listRepPtr)->refCount++, \ - (objPtr)->typePtr = &tclListType - #define ListObjGetElements(listPtr, objc, objv) \ ((objv) = &(ListRepPtr(listPtr)->elements), \ (objc) = ListRepPtr(listPtr)->elemCount) @@ -4266,11 +4260,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInvalidateStringRep(objPtr) \ - if (objPtr->bytes != NULL) { \ - if (objPtr->bytes != tclEmptyStringRep) { \ - ckfree((char *) objPtr->bytes); \ + if ((objPtr)->bytes != NULL) { \ + if ((objPtr)->bytes != tclEmptyStringRep) { \ + ckfree((char *) (objPtr)->bytes); \ } \ - objPtr->bytes = NULL; \ + (objPtr)->bytes = NULL; \ } /* diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 14b8a14..0b6473b 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -12,6 +12,7 @@ */ #include "tclInt.h" +#include /* * Prototypes for functions defined later in this file: @@ -46,6 +47,27 @@ const Tcl_ObjType tclListType = { SetListFromAny /* setFromAnyProc */ }; +/* Macros to manipulate the List internal rep */ + +#define ListSetIntRep(objPtr, listRepPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (listRepPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + (listRepPtr)->refCount++; \ + Tcl_StoreIntRep((objPtr), &tclListType, &ir); \ + } while (0) + +#define ListGetIntRep(objPtr, listRepPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &tclListType); \ + (listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + +#define ListResetIntRep(objPtr, listRepPtr) \ + Tcl_FetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr) + #ifndef TCL_MIN_ELEMENT_GROWTH #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *) #endif @@ -374,8 +396,7 @@ Tcl_SetListObj( listRepPtr = NewListIntRep(objc, objv, 1); ListSetIntRep(objPtr, listRepPtr); } else { - objPtr->bytes = tclEmptyStringRep; - objPtr->length = 0; + Tcl_InitStringRep(objPtr, NULL, 0); } } @@ -407,8 +428,10 @@ TclListObjCopy( * to be returned. */ { Tcl_Obj *copyPtr; + List *listRepPtr; - if (listPtr->typePtr != &tclListType) { + ListGetIntRep(listPtr, listRepPtr); + if (NULL == listRepPtr) { if (SetListFromAny(interp, listPtr) != TCL_OK) { return NULL; } @@ -462,10 +485,13 @@ Tcl_ListObjGetElements( { register List *listRepPtr; - if (listPtr->typePtr != &tclListType) { - int result; + ListGetIntRep(listPtr, listRepPtr); - if (listPtr->bytes == tclEmptyStringRep) { + if (listRepPtr == NULL) { + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (length == 0) { *objcPtr = 0; *objvPtr = NULL; return TCL_OK; @@ -474,8 +500,8 @@ Tcl_ListObjGetElements( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); *objcPtr = listRepPtr->elemCount; *objvPtr = &listRepPtr->elements; return TCL_OK; @@ -572,10 +598,13 @@ Tcl_ListObjAppendElement( if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement"); } - if (listPtr->typePtr != &tclListType) { - int result; - if (listPtr->bytes == tclEmptyStringRep) { + ListGetIntRep(listPtr, listRepPtr); + if (listRepPtr == NULL) { + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (length == 0) { Tcl_SetListObj(listPtr, 1, &objPtr); return TCL_OK; } @@ -583,9 +612,9 @@ Tcl_ListObjAppendElement( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); numElems = listRepPtr->elemCount; numRequired = numElems + 1 ; needGrow = (numRequired > listRepPtr->maxElemCount); @@ -681,7 +710,7 @@ Tcl_ListObjAppendElement( } listRepPtr = newPtr; } - listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; + ListResetIntRep(listPtr, listRepPtr); /* * Add objPtr to the end of listPtr's array of element pointers. Increment @@ -736,10 +765,12 @@ Tcl_ListObjIndex( { register List *listRepPtr; - if (listPtr->typePtr != &tclListType) { - int result; + ListGetIntRep(listPtr, listRepPtr); + if (listRepPtr == NULL) { + int result, length; - if (listPtr->bytes == tclEmptyStringRep) { + (void) Tcl_GetStringFromObj(listPtr, &length); + if (length == 0) { *objPtrPtr = NULL; return TCL_OK; } @@ -747,9 +778,9 @@ Tcl_ListObjIndex( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); if ((index < 0) || (index >= listRepPtr->elemCount)) { *objPtrPtr = NULL; } else { @@ -789,10 +820,12 @@ Tcl_ListObjLength( { register List *listRepPtr; - if (listPtr->typePtr != &tclListType) { - int result; + ListGetIntRep(listPtr, listRepPtr); + if (listRepPtr == NULL) { + int result, length; - if (listPtr->bytes == tclEmptyStringRep) { + (void) Tcl_GetStringFromObj(listPtr, &length); + if (length == 0) { *intPtr = 0; return TCL_OK; } @@ -800,9 +833,9 @@ Tcl_ListObjLength( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); *intPtr = listRepPtr->elemCount; return TCL_OK; } @@ -862,9 +895,14 @@ Tcl_ListObjReplace( if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } - if (listPtr->typePtr != &tclListType) { - if (listPtr->bytes == tclEmptyStringRep) { - if (!objc) { + + ListGetIntRep(listPtr, listRepPtr); + if (listRepPtr == NULL) { + int length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (length == 0) { + if (objc == 0) { return TCL_OK; } Tcl_SetListObj(listPtr, objc, NULL); @@ -875,6 +913,7 @@ Tcl_ListObjReplace( return result; } } + ListGetIntRep(listPtr, listRepPtr); } /* @@ -885,7 +924,6 @@ Tcl_ListObjReplace( * Resist any temptation to optimize this case. */ - listRepPtr = ListRepPtr(listPtr); elemPtrs = &listRepPtr->elements; numElems = listRepPtr->elemCount; @@ -939,7 +977,7 @@ Tcl_ListObjReplace( } if (newPtr) { listRepPtr = newPtr; - listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; + ListResetIntRep(listPtr, listRepPtr); elemPtrs = &listRepPtr->elements; listRepPtr->maxElemCount = attempt; needGrow = numRequired > listRepPtr->maxElemCount; @@ -1012,7 +1050,7 @@ Tcl_ListObjReplace( } } - listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; + ListResetIntRep(listPtr, listRepPtr); listRepPtr->refCount++; elemPtrs = &listRepPtr->elements; @@ -1127,6 +1165,7 @@ TclLindexList( int index; /* Index into the list. */ Tcl_Obj *indexListCopy; + List *listRepPtr; /* * Determine whether argPtr designates a list or a single index. We have @@ -1134,7 +1173,8 @@ TclLindexList( * shimmering; see TIP#22 and TIP#33 for the details. */ - if (argPtr->typePtr != &tclListType + ListGetIntRep(argPtr, listRepPtr); + if ((listRepPtr == NULL) && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) { /* * argPtr designates a single index. @@ -1165,19 +1205,12 @@ TclLindexList( return TclLindexFlat(interp, listPtr, 1, &argPtr); } - if (indexListCopy->typePtr == &tclListType) { - List *listRepPtr = ListRepPtr(indexListCopy); + ListGetIntRep(indexListCopy, listRepPtr); - listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount, - &listRepPtr->elements); - } else { - int indexCount = -1; /* Size of the array of list indices. */ - Tcl_Obj **indices = NULL; - /* Array of list indices. */ + assert(listRepPtr != NULL); - Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices); - listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); - } + listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount, + &listRepPtr->elements); Tcl_DecrRefCount(indexListCopy); return listPtr; } @@ -1312,6 +1345,7 @@ TclLsetList( Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ int index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; + List *listRepPtr; /* * Determine whether the index arg designates a list or a single index. @@ -1319,7 +1353,8 @@ TclLsetList( * shimmering; see TIP #22 and #23 for details. */ - if (indexArgPtr->typePtr != &tclListType + ListGetIntRep(indexArgPtr, listRepPtr); + if (listRepPtr == NULL && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) { /* * indexArgPtr designates a single index. @@ -1404,6 +1439,7 @@ TclLsetFlat( { int index, result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; + Tcl_ObjIntRep *irPtr; /* * If there are no indices, simply return the new value. (Without @@ -1534,7 +1570,8 @@ TclLsetFlat( * them at that time. */ - parentList->internalRep.twoPtrValue.ptr2 = chainPtr; + irPtr = Tcl_FetchIntRep(parentList, &tclListType); + irPtr->twoPtrValue.ptr2 = chainPtr; chainPtr = parentList; } } while (indexCount > 0); @@ -1562,8 +1599,9 @@ TclLsetFlat( * Clear away our intrep surgery mess. */ - chainPtr = objPtr->internalRep.twoPtrValue.ptr2; - objPtr->internalRep.twoPtrValue.ptr2 = NULL; + irPtr = Tcl_FetchIntRep(objPtr, &tclListType); + chainPtr = irPtr->twoPtrValue.ptr2; + irPtr->twoPtrValue.ptr2 = NULL; } if (result != TCL_OK) { @@ -1647,10 +1685,13 @@ TclListObjSetElement( if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "TclListObjSetElement"); } - if (listPtr->typePtr != &tclListType) { - int result; - if (listPtr->bytes == tclEmptyStringRep) { + ListGetIntRep(listPtr, listRepPtr); + if (listRepPtr == NULL) { + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (length == 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); @@ -1663,9 +1704,9 @@ TclListObjSetElement( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); elemCount = listRepPtr->elemCount; /* @@ -1708,7 +1749,8 @@ TclListObjSetElement( listRepPtr->refCount--; - listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr; + listRepPtr = newPtr; + ListResetIntRep(listPtr, listRepPtr); } elemPtrs = &listRepPtr->elements; @@ -1745,9 +1787,8 @@ TclListObjSetElement( * None. * * Side effects: - * Frees listPtr's List* internal representation and sets listPtr's - * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all - * element objects, which may free them. + * Frees listPtr's List* internal representation, if no longer shared. + * May decrement the ref counts of element objects, which may free them. * *---------------------------------------------------------------------- */ @@ -1756,7 +1797,10 @@ static void FreeListInternalRep( Tcl_Obj *listPtr) /* List object with internal rep to free. */ { - List *listRepPtr = ListRepPtr(listPtr); + List *listRepPtr; + + ListGetIntRep(listPtr, listRepPtr); + assert(listRepPtr != NULL); if (listRepPtr->refCount-- <= 1) { Tcl_Obj **elemPtrs = &listRepPtr->elements; @@ -1767,8 +1811,6 @@ FreeListInternalRep( } ckfree(listRepPtr); } - - listPtr->typePtr = NULL; } /* @@ -1793,8 +1835,10 @@ DupListInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - List *listRepPtr = ListRepPtr(srcPtr); + List *listRepPtr; + ListGetIntRep(srcPtr, listRepPtr); + assert(listRepPtr != NULL); ListSetIntRep(copyPtr, listRepPtr); } @@ -1833,7 +1877,7 @@ SetListFromAny( * describe duplicate keys). */ - if (objPtr->typePtr == &tclDictType && !objPtr->bytes) { + if (Tcl_FetchIntRep(objPtr, &tclDictType) && !objPtr->bytes) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done, size; @@ -1891,10 +1935,12 @@ SetListFromAny( while (nextElem < limit) { const char *elemStart; + char *check; int elemSize, literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { + fail: while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); } @@ -1905,14 +1951,21 @@ SetListFromAny( break; } - /* TODO: replace panic with error on alloc failure? */ - if (literal) { - TclNewStringObj(*elemPtrs, elemStart, elemSize); - } else { - TclNewObj(*elemPtrs); - (*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1); - (*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart, - (*elemPtrs)->bytes); + TclNewObj(*elemPtrs); + TclInvalidateStringRep(*elemPtrs); + check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL, + elemSize); + if (elemSize && check == NULL) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot construct list, out of memory", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + goto fail; + } + if (!literal) { + Tcl_InitStringRep(*elemPtrs, NULL, + TclCopyAndCollapse(elemSize, elemStart, check)); } Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */ @@ -1922,12 +1975,11 @@ SetListFromAny( } /* - * Free the old internalRep before setting the new one. We do this as late + * Store the new internalRep. We do this as late * as possible to allow the conversion code, in particular - * Tcl_GetStringFromObj, to use that old internalRep. + * Tcl_GetStringFromObj, to use the old internalRep. */ - TclFreeIntRep(objPtr); ListSetIntRep(objPtr, listRepPtr); return TCL_OK; } @@ -1959,12 +2011,17 @@ UpdateStringOfList( { # define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr = NULL; - List *listRepPtr = ListRepPtr(listPtr); - int numElems = listRepPtr->elemCount; - int i, length, bytesNeeded = 0; + int numElems, i, length, bytesNeeded = 0; const char *elem; char *dst; Tcl_Obj **elemPtrs; + List *listRepPtr; + + ListGetIntRep(listPtr, listRepPtr); + + assert(listRepPtr != NULL); + + numElems = listRepPtr->elemCount; /* * Mark the list as being canonical; although it will now have a string @@ -1979,8 +2036,7 @@ UpdateStringOfList( */ if (numElems == 0) { - listPtr->bytes = tclEmptyStringRep; - listPtr->length = 0; + Tcl_InitStringRep(listPtr, NULL, 0); return; } @@ -2009,22 +2065,21 @@ UpdateStringOfList( if (bytesNeeded > INT_MAX - numElems + 1) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } - bytesNeeded += numElems; + bytesNeeded += numElems - 1; /* * Pass 2: copy into string rep buffer. */ - listPtr->length = bytesNeeded - 1; - listPtr->bytes = ckalloc(bytesNeeded); - dst = listPtr->bytes; + dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded); + TclOOM(dst, bytesNeeded); for (i = 0; i < numElems; i++) { flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; } - listPtr->bytes[listPtr->length] = '\0'; + (void) Tcl_InitStringRep(listPtr, NULL, bytesNeeded); if (flagPtr != localFlags) { ckfree(flagPtr); -- cgit v0.12 From 395d0889b0a2eb0f0626b193ee4dccab8d9882ee Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 30 Mar 2016 07:52:15 +0000 Subject: merge core-8-6-branch --- generic/tclCompCmdsGR.c | 14 +++- library/tzdata/America/Santiago | 169 +++++++++++++++++++++++++++++++++++++- library/tzdata/Antarctica/Palmer | 169 +++++++++++++++++++++++++++++++++++++- library/tzdata/Asia/Baku | 168 ------------------------------------- library/tzdata/Asia/Barnaul | 6 +- library/tzdata/Europe/Kaliningrad | 10 +-- library/tzdata/Europe/Vilnius | 11 +-- library/tzdata/Europe/Volgograd | 6 +- library/tzdata/Pacific/Easter | 169 +++++++++++++++++++++++++++++++++++++- tests/lreplace.test | 11 +++ 10 files changed, 545 insertions(+), 188 deletions(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 87ed745..9f430ea 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -1488,8 +1488,18 @@ TclCompileLreplaceCmd( return TCL_ERROR; } - if(idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) { - idx2 = idx1-1; + /* + * Compilation fails when one index is end-based but the other isn't. + * Fixing this will require more bytecodes, but this is a workaround for + * now. [Bug 47ac84309b] + */ + + if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) { + return TCL_ERROR; + } + + if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) { + idx2 = idx1 - 1; } /* diff --git a/library/tzdata/America/Santiago b/library/tzdata/America/Santiago index b6d9b38..3a5c0fd 100644 --- a/library/tzdata/America/Santiago +++ b/library/tzdata/America/Santiago @@ -118,5 +118,172 @@ set TZData(:America/Santiago) { {1378612800 -10800 1 CLST} {1398567600 -14400 0 CLT} {1410062400 -10800 1 CLST} - {1430017200 -10800 0 CLT} + {1463281200 -14400 0 CLT} + {1471147200 -10800 1 CLST} + {1494730800 -14400 0 CLT} + {1502596800 -10800 1 CLST} + {1526180400 -14400 0 CLT} + {1534046400 -10800 1 CLST} + {1557630000 -14400 0 CLT} + {1565496000 -10800 1 CLST} + {1589079600 -14400 0 CLT} + {1596945600 -10800 1 CLST} + {1620529200 -14400 0 CLT} + {1629000000 -10800 1 CLST} + {1652583600 -14400 0 CLT} + {1660449600 -10800 1 CLST} + {1684033200 -14400 0 CLT} + {1691899200 -10800 1 CLST} + {1715482800 -14400 0 CLT} + {1723348800 -10800 1 CLST} + {1746932400 -14400 0 CLT} + {1754798400 -10800 1 CLST} + {1778382000 -14400 0 CLT} + {1786248000 -10800 1 CLST} + {1809831600 -14400 0 CLT} + {1818302400 -10800 1 CLST} + {1841886000 -14400 0 CLT} + {1849752000 -10800 1 CLST} + {1873335600 -14400 0 CLT} + {1881201600 -10800 1 CLST} + {1904785200 -14400 0 CLT} + {1912651200 -10800 1 CLST} + {1936234800 -14400 0 CLT} + {1944100800 -10800 1 CLST} + {1967684400 -14400 0 CLT} + {1976155200 -10800 1 CLST} + {1999738800 -14400 0 CLT} + {2007604800 -10800 1 CLST} + {2031188400 -14400 0 CLT} + {2039054400 -10800 1 CLST} + {2062638000 -14400 0 CLT} + {2070504000 -10800 1 CLST} + {2094087600 -14400 0 CLT} + {2101953600 -10800 1 CLST} + {2125537200 -14400 0 CLT} + {2133403200 -10800 1 CLST} + {2156986800 -14400 0 CLT} + {2165457600 -10800 1 CLST} + {2189041200 -14400 0 CLT} + {2196907200 -10800 1 CLST} + {2220490800 -14400 0 CLT} + {2228356800 -10800 1 CLST} + {2251940400 -14400 0 CLT} + {2259806400 -10800 1 CLST} + {2283390000 -14400 0 CLT} + {2291256000 -10800 1 CLST} + {2314839600 -14400 0 CLT} + {2322705600 -10800 1 CLST} + {2346894000 -14400 0 CLT} + {2354760000 -10800 1 CLST} + {2378343600 -14400 0 CLT} + {2386209600 -10800 1 CLST} + {2409793200 -14400 0 CLT} + {2417659200 -10800 1 CLST} + {2441242800 -14400 0 CLT} + {2449108800 -10800 1 CLST} + {2472692400 -14400 0 CLT} + {2480558400 -10800 1 CLST} + {2504142000 -14400 0 CLT} + {2512612800 -10800 1 CLST} + {2536196400 -14400 0 CLT} + {2544062400 -10800 1 CLST} + {2567646000 -14400 0 CLT} + {2575512000 -10800 1 CLST} + {2599095600 -14400 0 CLT} + {2606961600 -10800 1 CLST} + {2630545200 -14400 0 CLT} + {2638411200 -10800 1 CLST} + {2661994800 -14400 0 CLT} + {2669860800 -10800 1 CLST} + {2693444400 -14400 0 CLT} + {2701915200 -10800 1 CLST} + {2725498800 -14400 0 CLT} + {2733364800 -10800 1 CLST} + {2756948400 -14400 0 CLT} + {2764814400 -10800 1 CLST} + {2788398000 -14400 0 CLT} + {2796264000 -10800 1 CLST} + {2819847600 -14400 0 CLT} + {2827713600 -10800 1 CLST} + {2851297200 -14400 0 CLT} + {2859768000 -10800 1 CLST} + {2883351600 -14400 0 CLT} + {2891217600 -10800 1 CLST} + {2914801200 -14400 0 CLT} + {2922667200 -10800 1 CLST} + {2946250800 -14400 0 CLT} + {2954116800 -10800 1 CLST} + {2977700400 -14400 0 CLT} + {2985566400 -10800 1 CLST} + {3009150000 -14400 0 CLT} + {3017016000 -10800 1 CLST} + {3040599600 -14400 0 CLT} + {3049070400 -10800 1 CLST} + {3072654000 -14400 0 CLT} + {3080520000 -10800 1 CLST} + {3104103600 -14400 0 CLT} + {3111969600 -10800 1 CLST} + {3135553200 -14400 0 CLT} + {3143419200 -10800 1 CLST} + {3167002800 -14400 0 CLT} + {3174868800 -10800 1 CLST} + {3198452400 -14400 0 CLT} + {3206318400 -10800 1 CLST} + {3230506800 -14400 0 CLT} + {3238372800 -10800 1 CLST} + {3261956400 -14400 0 CLT} + {3269822400 -10800 1 CLST} + {3293406000 -14400 0 CLT} + {3301272000 -10800 1 CLST} + {3324855600 -14400 0 CLT} + {3332721600 -10800 1 CLST} + {3356305200 -14400 0 CLT} + {3364171200 -10800 1 CLST} + {3387754800 -14400 0 CLT} + {3396225600 -10800 1 CLST} + {3419809200 -14400 0 CLT} + {3427675200 -10800 1 CLST} + {3451258800 -14400 0 CLT} + {3459124800 -10800 1 CLST} + {3482708400 -14400 0 CLT} + {3490574400 -10800 1 CLST} + {3514158000 -14400 0 CLT} + {3522024000 -10800 1 CLST} + {3545607600 -14400 0 CLT} + {3553473600 -10800 1 CLST} + {3577057200 -14400 0 CLT} + {3585528000 -10800 1 CLST} + {3609111600 -14400 0 CLT} + {3616977600 -10800 1 CLST} + {3640561200 -14400 0 CLT} + {3648427200 -10800 1 CLST} + {3672010800 -14400 0 CLT} + {3679876800 -10800 1 CLST} + {3703460400 -14400 0 CLT} + {3711326400 -10800 1 CLST} + {3734910000 -14400 0 CLT} + {3743380800 -10800 1 CLST} + {3766964400 -14400 0 CLT} + {3774830400 -10800 1 CLST} + {3798414000 -14400 0 CLT} + {3806280000 -10800 1 CLST} + {3829863600 -14400 0 CLT} + {3837729600 -10800 1 CLST} + {3861313200 -14400 0 CLT} + {3869179200 -10800 1 CLST} + {3892762800 -14400 0 CLT} + {3900628800 -10800 1 CLST} + {3924212400 -14400 0 CLT} + {3932683200 -10800 1 CLST} + {3956266800 -14400 0 CLT} + {3964132800 -10800 1 CLST} + {3987716400 -14400 0 CLT} + {3995582400 -10800 1 CLST} + {4019166000 -14400 0 CLT} + {4027032000 -10800 1 CLST} + {4050615600 -14400 0 CLT} + {4058481600 -10800 1 CLST} + {4082065200 -14400 0 CLT} + {4089931200 -10800 1 CLST} } diff --git a/library/tzdata/Antarctica/Palmer b/library/tzdata/Antarctica/Palmer index 2c43861..5767985 100644 --- a/library/tzdata/Antarctica/Palmer +++ b/library/tzdata/Antarctica/Palmer @@ -81,5 +81,172 @@ set TZData(:Antarctica/Palmer) { {1378612800 -10800 1 CLST} {1398567600 -14400 0 CLT} {1410062400 -10800 1 CLST} - {1430017200 -10800 0 CLT} + {1463281200 -14400 0 CLT} + {1471147200 -10800 1 CLST} + {1494730800 -14400 0 CLT} + {1502596800 -10800 1 CLST} + {1526180400 -14400 0 CLT} + {1534046400 -10800 1 CLST} + {1557630000 -14400 0 CLT} + {1565496000 -10800 1 CLST} + {1589079600 -14400 0 CLT} + {1596945600 -10800 1 CLST} + {1620529200 -14400 0 CLT} + {1629000000 -10800 1 CLST} + {1652583600 -14400 0 CLT} + {1660449600 -10800 1 CLST} + {1684033200 -14400 0 CLT} + {1691899200 -10800 1 CLST} + {1715482800 -14400 0 CLT} + {1723348800 -10800 1 CLST} + {1746932400 -14400 0 CLT} + {1754798400 -10800 1 CLST} + {1778382000 -14400 0 CLT} + {1786248000 -10800 1 CLST} + {1809831600 -14400 0 CLT} + {1818302400 -10800 1 CLST} + {1841886000 -14400 0 CLT} + {1849752000 -10800 1 CLST} + {1873335600 -14400 0 CLT} + {1881201600 -10800 1 CLST} + {1904785200 -14400 0 CLT} + {1912651200 -10800 1 CLST} + {1936234800 -14400 0 CLT} + {1944100800 -10800 1 CLST} + {1967684400 -14400 0 CLT} + {1976155200 -10800 1 CLST} + {1999738800 -14400 0 CLT} + {2007604800 -10800 1 CLST} + {2031188400 -14400 0 CLT} + {2039054400 -10800 1 CLST} + {2062638000 -14400 0 CLT} + {2070504000 -10800 1 CLST} + {2094087600 -14400 0 CLT} + {2101953600 -10800 1 CLST} + {2125537200 -14400 0 CLT} + {2133403200 -10800 1 CLST} + {2156986800 -14400 0 CLT} + {2165457600 -10800 1 CLST} + {2189041200 -14400 0 CLT} + {2196907200 -10800 1 CLST} + {2220490800 -14400 0 CLT} + {2228356800 -10800 1 CLST} + {2251940400 -14400 0 CLT} + {2259806400 -10800 1 CLST} + {2283390000 -14400 0 CLT} + {2291256000 -10800 1 CLST} + {2314839600 -14400 0 CLT} + {2322705600 -10800 1 CLST} + {2346894000 -14400 0 CLT} + {2354760000 -10800 1 CLST} + {2378343600 -14400 0 CLT} + {2386209600 -10800 1 CLST} + {2409793200 -14400 0 CLT} + {2417659200 -10800 1 CLST} + {2441242800 -14400 0 CLT} + {2449108800 -10800 1 CLST} + {2472692400 -14400 0 CLT} + {2480558400 -10800 1 CLST} + {2504142000 -14400 0 CLT} + {2512612800 -10800 1 CLST} + {2536196400 -14400 0 CLT} + {2544062400 -10800 1 CLST} + {2567646000 -14400 0 CLT} + {2575512000 -10800 1 CLST} + {2599095600 -14400 0 CLT} + {2606961600 -10800 1 CLST} + {2630545200 -14400 0 CLT} + {2638411200 -10800 1 CLST} + {2661994800 -14400 0 CLT} + {2669860800 -10800 1 CLST} + {2693444400 -14400 0 CLT} + {2701915200 -10800 1 CLST} + {2725498800 -14400 0 CLT} + {2733364800 -10800 1 CLST} + {2756948400 -14400 0 CLT} + {2764814400 -10800 1 CLST} + {2788398000 -14400 0 CLT} + {2796264000 -10800 1 CLST} + {2819847600 -14400 0 CLT} + {2827713600 -10800 1 CLST} + {2851297200 -14400 0 CLT} + {2859768000 -10800 1 CLST} + {2883351600 -14400 0 CLT} + {2891217600 -10800 1 CLST} + {2914801200 -14400 0 CLT} + {2922667200 -10800 1 CLST} + {2946250800 -14400 0 CLT} + {2954116800 -10800 1 CLST} + {2977700400 -14400 0 CLT} + {2985566400 -10800 1 CLST} + {3009150000 -14400 0 CLT} + {3017016000 -10800 1 CLST} + {3040599600 -14400 0 CLT} + {3049070400 -10800 1 CLST} + {3072654000 -14400 0 CLT} + {3080520000 -10800 1 CLST} + {3104103600 -14400 0 CLT} + {3111969600 -10800 1 CLST} + {3135553200 -14400 0 CLT} + {3143419200 -10800 1 CLST} + {3167002800 -14400 0 CLT} + {3174868800 -10800 1 CLST} + {3198452400 -14400 0 CLT} + {3206318400 -10800 1 CLST} + {3230506800 -14400 0 CLT} + {3238372800 -10800 1 CLST} + {3261956400 -14400 0 CLT} + {3269822400 -10800 1 CLST} + {3293406000 -14400 0 CLT} + {3301272000 -10800 1 CLST} + {3324855600 -14400 0 CLT} + {3332721600 -10800 1 CLST} + {3356305200 -14400 0 CLT} + {3364171200 -10800 1 CLST} + {3387754800 -14400 0 CLT} + {3396225600 -10800 1 CLST} + {3419809200 -14400 0 CLT} + {3427675200 -10800 1 CLST} + {3451258800 -14400 0 CLT} + {3459124800 -10800 1 CLST} + {3482708400 -14400 0 CLT} + {3490574400 -10800 1 CLST} + {3514158000 -14400 0 CLT} + {3522024000 -10800 1 CLST} + {3545607600 -14400 0 CLT} + {3553473600 -10800 1 CLST} + {3577057200 -14400 0 CLT} + {3585528000 -10800 1 CLST} + {3609111600 -14400 0 CLT} + {3616977600 -10800 1 CLST} + {3640561200 -14400 0 CLT} + {3648427200 -10800 1 CLST} + {3672010800 -14400 0 CLT} + {3679876800 -10800 1 CLST} + {3703460400 -14400 0 CLT} + {3711326400 -10800 1 CLST} + {3734910000 -14400 0 CLT} + {3743380800 -10800 1 CLST} + {3766964400 -14400 0 CLT} + {3774830400 -10800 1 CLST} + {3798414000 -14400 0 CLT} + {3806280000 -10800 1 CLST} + {3829863600 -14400 0 CLT} + {3837729600 -10800 1 CLST} + {3861313200 -14400 0 CLT} + {3869179200 -10800 1 CLST} + {3892762800 -14400 0 CLT} + {3900628800 -10800 1 CLST} + {3924212400 -14400 0 CLT} + {3932683200 -10800 1 CLST} + {3956266800 -14400 0 CLT} + {3964132800 -10800 1 CLST} + {3987716400 -14400 0 CLT} + {3995582400 -10800 1 CLST} + {4019166000 -14400 0 CLT} + {4027032000 -10800 1 CLST} + {4050615600 -14400 0 CLT} + {4058481600 -10800 1 CLST} + {4082065200 -14400 0 CLT} + {4089931200 -10800 1 CLST} } diff --git a/library/tzdata/Asia/Baku b/library/tzdata/Asia/Baku index e50071b..c26a2f5 100644 --- a/library/tzdata/Asia/Baku +++ b/library/tzdata/Asia/Baku @@ -71,172 +71,4 @@ set TZData(:Asia/Baku) { {1414281600 14400 0 AZT} {1427587200 18000 1 AZST} {1445731200 14400 0 AZT} - {1459036800 18000 1 AZST} - {1477785600 14400 0 AZT} - {1490486400 18000 1 AZST} - {1509235200 14400 0 AZT} - {1521936000 18000 1 AZST} - {1540684800 14400 0 AZT} - {1553990400 18000 1 AZST} - {1572134400 14400 0 AZT} - {1585440000 18000 1 AZST} - {1603584000 14400 0 AZT} - {1616889600 18000 1 AZST} - {1635638400 14400 0 AZT} - {1648339200 18000 1 AZST} - {1667088000 14400 0 AZT} - {1679788800 18000 1 AZST} - {1698537600 14400 0 AZT} - {1711843200 18000 1 AZST} - {1729987200 14400 0 AZT} - {1743292800 18000 1 AZST} - {1761436800 14400 0 AZT} - {1774742400 18000 1 AZST} - {1792886400 14400 0 AZT} - {1806192000 18000 1 AZST} - {1824940800 14400 0 AZT} - {1837641600 18000 1 AZST} - {1856390400 14400 0 AZT} - {1869091200 18000 1 AZST} - {1887840000 14400 0 AZT} - {1901145600 18000 1 AZST} - {1919289600 14400 0 AZT} - {1932595200 18000 1 AZST} - {1950739200 14400 0 AZT} - {1964044800 18000 1 AZST} - {1982793600 14400 0 AZT} - {1995494400 18000 1 AZST} - {2014243200 14400 0 AZT} - {2026944000 18000 1 AZST} - {2045692800 14400 0 AZT} - {2058393600 18000 1 AZST} - {2077142400 14400 0 AZT} - {2090448000 18000 1 AZST} - {2108592000 14400 0 AZT} - {2121897600 18000 1 AZST} - {2140041600 14400 0 AZT} - {2153347200 18000 1 AZST} - {2172096000 14400 0 AZT} - {2184796800 18000 1 AZST} - {2203545600 14400 0 AZT} - {2216246400 18000 1 AZST} - {2234995200 14400 0 AZT} - {2248300800 18000 1 AZST} - {2266444800 14400 0 AZT} - {2279750400 18000 1 AZST} - {2297894400 14400 0 AZT} - {2311200000 18000 1 AZST} - {2329344000 14400 0 AZT} - {2342649600 18000 1 AZST} - {2361398400 14400 0 AZT} - {2374099200 18000 1 AZST} - {2392848000 14400 0 AZT} - {2405548800 18000 1 AZST} - {2424297600 14400 0 AZT} - {2437603200 18000 1 AZST} - {2455747200 14400 0 AZT} - {2469052800 18000 1 AZST} - {2487196800 14400 0 AZT} - {2500502400 18000 1 AZST} - {2519251200 14400 0 AZT} - {2531952000 18000 1 AZST} - {2550700800 14400 0 AZT} - {2563401600 18000 1 AZST} - {2582150400 14400 0 AZT} - {2595456000 18000 1 AZST} - {2613600000 14400 0 AZT} - {2626905600 18000 1 AZST} - {2645049600 14400 0 AZT} - {2658355200 18000 1 AZST} - {2676499200 14400 0 AZT} - {2689804800 18000 1 AZST} - {2708553600 14400 0 AZT} - {2721254400 18000 1 AZST} - {2740003200 14400 0 AZT} - {2752704000 18000 1 AZST} - {2771452800 14400 0 AZT} - {2784758400 18000 1 AZST} - {2802902400 14400 0 AZT} - {2816208000 18000 1 AZST} - {2834352000 14400 0 AZT} - {2847657600 18000 1 AZST} - {2866406400 14400 0 AZT} - {2879107200 18000 1 AZST} - {2897856000 14400 0 AZT} - {2910556800 18000 1 AZST} - {2929305600 14400 0 AZT} - {2942006400 18000 1 AZST} - {2960755200 14400 0 AZT} - {2974060800 18000 1 AZST} - {2992204800 14400 0 AZT} - {3005510400 18000 1 AZST} - {3023654400 14400 0 AZT} - {3036960000 18000 1 AZST} - {3055708800 14400 0 AZT} - {3068409600 18000 1 AZST} - {3087158400 14400 0 AZT} - {3099859200 18000 1 AZST} - {3118608000 14400 0 AZT} - {3131913600 18000 1 AZST} - {3150057600 14400 0 AZT} - {3163363200 18000 1 AZST} - {3181507200 14400 0 AZT} - {3194812800 18000 1 AZST} - {3212956800 14400 0 AZT} - {3226262400 18000 1 AZST} - {3245011200 14400 0 AZT} - {3257712000 18000 1 AZST} - {3276460800 14400 0 AZT} - {3289161600 18000 1 AZST} - {3307910400 14400 0 AZT} - {3321216000 18000 1 AZST} - {3339360000 14400 0 AZT} - {3352665600 18000 1 AZST} - {3370809600 14400 0 AZT} - {3384115200 18000 1 AZST} - {3402864000 14400 0 AZT} - {3415564800 18000 1 AZST} - {3434313600 14400 0 AZT} - {3447014400 18000 1 AZST} - {3465763200 14400 0 AZT} - {3479068800 18000 1 AZST} - {3497212800 14400 0 AZT} - {3510518400 18000 1 AZST} - {3528662400 14400 0 AZT} - {3541968000 18000 1 AZST} - {3560112000 14400 0 AZT} - {3573417600 18000 1 AZST} - {3592166400 14400 0 AZT} - {3604867200 18000 1 AZST} - {3623616000 14400 0 AZT} - {3636316800 18000 1 AZST} - {3655065600 14400 0 AZT} - {3668371200 18000 1 AZST} - {3686515200 14400 0 AZT} - {3699820800 18000 1 AZST} - {3717964800 14400 0 AZT} - {3731270400 18000 1 AZST} - {3750019200 14400 0 AZT} - {3762720000 18000 1 AZST} - {3781468800 14400 0 AZT} - {3794169600 18000 1 AZST} - {3812918400 14400 0 AZT} - {3825619200 18000 1 AZST} - {3844368000 14400 0 AZT} - {3857673600 18000 1 AZST} - {3875817600 14400 0 AZT} - {3889123200 18000 1 AZST} - {3907267200 14400 0 AZT} - {3920572800 18000 1 AZST} - {3939321600 14400 0 AZT} - {3952022400 18000 1 AZST} - {3970771200 14400 0 AZT} - {3983472000 18000 1 AZST} - {4002220800 14400 0 AZT} - {4015526400 18000 1 AZST} - {4033670400 14400 0 AZT} - {4046976000 18000 1 AZST} - {4065120000 14400 0 AZT} - {4078425600 18000 1 AZST} - {4096569600 14400 0 AZT} } diff --git a/library/tzdata/Asia/Barnaul b/library/tzdata/Asia/Barnaul index 8072e34..f6a45da 100644 --- a/library/tzdata/Asia/Barnaul +++ b/library/tzdata/Asia/Barnaul @@ -24,8 +24,10 @@ set TZData(:Asia/Barnaul) { {622580400 25200 0 +07} {638305200 28800 1 +08} {654634800 25200 0 +07} - {670359600 28800 1 +08} - {686084400 25200 0 +07} + {670359600 21600 0 +07} + {670363200 25200 1 +07} + {686088000 21600 0 +06} + {695764800 25200 0 +08} {701798400 28800 1 +08} {717519600 25200 0 +07} {733258800 28800 1 +08} diff --git a/library/tzdata/Europe/Kaliningrad b/library/tzdata/Europe/Kaliningrad index d03f7d0..32d7aaa 100644 --- a/library/tzdata/Europe/Kaliningrad +++ b/library/tzdata/Europe/Kaliningrad @@ -35,11 +35,11 @@ set TZData(:Europe/Kaliningrad) { {559695600 10800 0 MSK} {575420400 14400 1 MSD} {591145200 10800 0 MSK} - {606870000 14400 1 MSD} - {622594800 10800 0 MSK} - {638319600 14400 1 MSD} - {654649200 10800 0 MSK} - {670374000 7200 0 EEMMTT} + {606870000 7200 0 EEMMTT} + {606873600 10800 1 EEST} + {622598400 7200 0 EET} + {638323200 10800 1 EEST} + {654652800 7200 0 EET} {670377600 10800 1 EEST} {686102400 7200 0 EET} {701816400 10800 1 EEST} diff --git a/library/tzdata/Europe/Vilnius b/library/tzdata/Europe/Vilnius index 62d5d87..5e73150 100644 --- a/library/tzdata/Europe/Vilnius +++ b/library/tzdata/Europe/Vilnius @@ -30,11 +30,12 @@ set TZData(:Europe/Vilnius) { {559695600 10800 0 MSK} {575420400 14400 1 MSD} {591145200 10800 0 MSK} - {606870000 14400 1 MSD} - {622594800 10800 0 MSK} - {638319600 14400 1 MSD} - {654649200 10800 0 MSK} - {670374000 10800 1 EEST} + {606870000 7200 0 EEMMTT} + {606873600 10800 1 EEST} + {622598400 7200 0 EET} + {638323200 10800 1 EEST} + {654652800 7200 0 EET} + {670377600 10800 1 EEST} {686102400 7200 0 EET} {701827200 10800 1 EEST} {717552000 7200 0 EET} diff --git a/library/tzdata/Europe/Volgograd b/library/tzdata/Europe/Volgograd index d71fb0b..ef33d4b 100644 --- a/library/tzdata/Europe/Volgograd +++ b/library/tzdata/Europe/Volgograd @@ -20,9 +20,9 @@ set TZData(:Europe/Volgograd) { {528242400 14400 0 VOLT} {543967200 18000 1 VOLST} {559692000 14400 0 VOLT} - {575416800 18000 1 VOLST} - {591141600 14400 0 VOLT} - {606866400 10800 0 VOLMMTT} + {575416800 10800 0 VOLMMTT} + {575420400 14400 1 VOLST} + {591145200 10800 0 VOLT} {606870000 14400 1 VOLST} {622594800 10800 0 VOLT} {638319600 14400 1 VOLST} diff --git a/library/tzdata/Pacific/Easter b/library/tzdata/Pacific/Easter index 4b45ba2..ef0f2d5 100644 --- a/library/tzdata/Pacific/Easter +++ b/library/tzdata/Pacific/Easter @@ -97,5 +97,172 @@ set TZData(:Pacific/Easter) { {1378612800 -18000 1 EASST} {1398567600 -21600 0 EAST} {1410062400 -18000 1 EASST} - {1430017200 -18000 0 EAST} + {1463281200 -21600 0 EAST} + {1471147200 -18000 1 EASST} + {1494730800 -21600 0 EAST} + {1502596800 -18000 1 EASST} + {1526180400 -21600 0 EAST} + {1534046400 -18000 1 EASST} + {1557630000 -21600 0 EAST} + {1565496000 -18000 1 EASST} + {1589079600 -21600 0 EAST} + {1596945600 -18000 1 EASST} + {1620529200 -21600 0 EAST} + {1629000000 -18000 1 EASST} + {1652583600 -21600 0 EAST} + {1660449600 -18000 1 EASST} + {1684033200 -21600 0 EAST} + {1691899200 -18000 1 EASST} + {1715482800 -21600 0 EAST} + {1723348800 -18000 1 EASST} + {1746932400 -21600 0 EAST} + {1754798400 -18000 1 EASST} + {1778382000 -21600 0 EAST} + {1786248000 -18000 1 EASST} + {1809831600 -21600 0 EAST} + {1818302400 -18000 1 EASST} + {1841886000 -21600 0 EAST} + {1849752000 -18000 1 EASST} + {1873335600 -21600 0 EAST} + {1881201600 -18000 1 EASST} + {1904785200 -21600 0 EAST} + {1912651200 -18000 1 EASST} + {1936234800 -21600 0 EAST} + {1944100800 -18000 1 EASST} + {1967684400 -21600 0 EAST} + {1976155200 -18000 1 EASST} + {1999738800 -21600 0 EAST} + {2007604800 -18000 1 EASST} + {2031188400 -21600 0 EAST} + {2039054400 -18000 1 EASST} + {2062638000 -21600 0 EAST} + {2070504000 -18000 1 EASST} + {2094087600 -21600 0 EAST} + {2101953600 -18000 1 EASST} + {2125537200 -21600 0 EAST} + {2133403200 -18000 1 EASST} + {2156986800 -21600 0 EAST} + {2165457600 -18000 1 EASST} + {2189041200 -21600 0 EAST} + {2196907200 -18000 1 EASST} + {2220490800 -21600 0 EAST} + {2228356800 -18000 1 EASST} + {2251940400 -21600 0 EAST} + {2259806400 -18000 1 EASST} + {2283390000 -21600 0 EAST} + {2291256000 -18000 1 EASST} + {2314839600 -21600 0 EAST} + {2322705600 -18000 1 EASST} + {2346894000 -21600 0 EAST} + {2354760000 -18000 1 EASST} + {2378343600 -21600 0 EAST} + {2386209600 -18000 1 EASST} + {2409793200 -21600 0 EAST} + {2417659200 -18000 1 EASST} + {2441242800 -21600 0 EAST} + {2449108800 -18000 1 EASST} + {2472692400 -21600 0 EAST} + {2480558400 -18000 1 EASST} + {2504142000 -21600 0 EAST} + {2512612800 -18000 1 EASST} + {2536196400 -21600 0 EAST} + {2544062400 -18000 1 EASST} + {2567646000 -21600 0 EAST} + {2575512000 -18000 1 EASST} + {2599095600 -21600 0 EAST} + {2606961600 -18000 1 EASST} + {2630545200 -21600 0 EAST} + {2638411200 -18000 1 EASST} + {2661994800 -21600 0 EAST} + {2669860800 -18000 1 EASST} + {2693444400 -21600 0 EAST} + {2701915200 -18000 1 EASST} + {2725498800 -21600 0 EAST} + {2733364800 -18000 1 EASST} + {2756948400 -21600 0 EAST} + {2764814400 -18000 1 EASST} + {2788398000 -21600 0 EAST} + {2796264000 -18000 1 EASST} + {2819847600 -21600 0 EAST} + {2827713600 -18000 1 EASST} + {2851297200 -21600 0 EAST} + {2859768000 -18000 1 EASST} + {2883351600 -21600 0 EAST} + {2891217600 -18000 1 EASST} + {2914801200 -21600 0 EAST} + {2922667200 -18000 1 EASST} + {2946250800 -21600 0 EAST} + {2954116800 -18000 1 EASST} + {2977700400 -21600 0 EAST} + {2985566400 -18000 1 EASST} + {3009150000 -21600 0 EAST} + {3017016000 -18000 1 EASST} + {3040599600 -21600 0 EAST} + {3049070400 -18000 1 EASST} + {3072654000 -21600 0 EAST} + {3080520000 -18000 1 EASST} + {3104103600 -21600 0 EAST} + {3111969600 -18000 1 EASST} + {3135553200 -21600 0 EAST} + {3143419200 -18000 1 EASST} + {3167002800 -21600 0 EAST} + {3174868800 -18000 1 EASST} + {3198452400 -21600 0 EAST} + {3206318400 -18000 1 EASST} + {3230506800 -21600 0 EAST} + {3238372800 -18000 1 EASST} + {3261956400 -21600 0 EAST} + {3269822400 -18000 1 EASST} + {3293406000 -21600 0 EAST} + {3301272000 -18000 1 EASST} + {3324855600 -21600 0 EAST} + {3332721600 -18000 1 EASST} + {3356305200 -21600 0 EAST} + {3364171200 -18000 1 EASST} + {3387754800 -21600 0 EAST} + {3396225600 -18000 1 EASST} + {3419809200 -21600 0 EAST} + {3427675200 -18000 1 EASST} + {3451258800 -21600 0 EAST} + {3459124800 -18000 1 EASST} + {3482708400 -21600 0 EAST} + {3490574400 -18000 1 EASST} + {3514158000 -21600 0 EAST} + {3522024000 -18000 1 EASST} + {3545607600 -21600 0 EAST} + {3553473600 -18000 1 EASST} + {3577057200 -21600 0 EAST} + {3585528000 -18000 1 EASST} + {3609111600 -21600 0 EAST} + {3616977600 -18000 1 EASST} + {3640561200 -21600 0 EAST} + {3648427200 -18000 1 EASST} + {3672010800 -21600 0 EAST} + {3679876800 -18000 1 EASST} + {3703460400 -21600 0 EAST} + {3711326400 -18000 1 EASST} + {3734910000 -21600 0 EAST} + {3743380800 -18000 1 EASST} + {3766964400 -21600 0 EAST} + {3774830400 -18000 1 EASST} + {3798414000 -21600 0 EAST} + {3806280000 -18000 1 EASST} + {3829863600 -21600 0 EAST} + {3837729600 -18000 1 EASST} + {3861313200 -21600 0 EAST} + {3869179200 -18000 1 EASST} + {3892762800 -21600 0 EAST} + {3900628800 -18000 1 EASST} + {3924212400 -21600 0 EAST} + {3932683200 -18000 1 EASST} + {3956266800 -21600 0 EAST} + {3964132800 -18000 1 EASST} + {3987716400 -21600 0 EAST} + {3995582400 -18000 1 EASST} + {4019166000 -21600 0 EAST} + {4027032000 -18000 1 EASST} + {4050615600 -21600 0 EAST} + {4058481600 -18000 1 EASST} + {4082065200 -21600 0 EAST} + {4089931200 -18000 1 EASST} } diff --git a/tests/lreplace.test b/tests/lreplace.test index e66a331..55a36a8 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -181,6 +181,17 @@ test lreplace-4.11 {lreplace end index first} { test lreplace-4.12 {lreplace end index first} { lreplace {0 1 2 3 4} end-2 2 a b c } {0 1 a b c 3 4} + +test lreplace-5.1 {compiled lreplace: Bug 47ac84309b} { + apply {x { + lreplace $x end 0 + }} {a b c} +} {a b c} +test lreplace-5.2 {compiled lreplace: Bug 47ac84309b} { + apply {x { + lreplace $x end 0 A + }} {a b c} +} {a b A c} # cleanup catch {unset foo} -- cgit v0.12 From 7721fe8b51fce18f525df0bbf8328e84ce97c693 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 30 Mar 2016 17:15:44 +0000 Subject: Remove direct access to Tcl_Obj typePtr field that does nothing of any obvious benefit. --- generic/tclTimer.c | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/generic/tclTimer.c b/generic/tclTimer.c index c10986a..d819657 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -789,7 +789,7 @@ Tcl_AfterObjCmd( AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; - int index; + int index = -1; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL }; @@ -818,15 +818,9 @@ Tcl_AfterObjCmd( * First lets see if the command was passed a number as the first argument. */ - if (objv[1]->typePtr == &tclIntType -#ifndef TCL_WIDE_INT_IS_LONG - || objv[1]->typePtr == &tclWideIntType -#endif - || objv[1]->typePtr == &tclBignumType - || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK)) { - index = -1; - if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { + if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { + if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) + != TCL_OK) { const char *arg = Tcl_GetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( -- cgit v0.12 From 0a4081dc5704449a007440e97a84df6dda5baf02 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 30 Mar 2016 17:55:59 +0000 Subject: Revise several ACCEPT_NAN stanzas. --- generic/tclBasic.c | 79 +++++++++++++++++++++++++++++++++++++----------------- generic/tclLink.c | 5 ++-- generic/tclScan.c | 6 +++-- 3 files changed, 61 insertions(+), 29 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 505f6c2..0a20323 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3513,9 +3513,14 @@ OldMathFuncProc( valuePtr = objv[j]; result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); #ifdef ACCEPT_NAN - if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) { - d = valuePtr->internalRep.doubleValue; - result = TCL_OK; + if (result != TCL_OK) { + const Tcl_ObjIntRep *irPtr + = Tcl_FetchIntRep(valuePtr, &tclDoubleType); + + if (irPtr) { + d = irPtr->doubleValue; + result = TCL_OK; + } } #endif if (result != TCL_OK) { @@ -7061,9 +7066,13 @@ ExprCeilFunc( } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN - if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { - Tcl_SetObjResult(interp, objv[1]); - return TCL_OK; + if (code != TCL_OK) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + + if (irPtr) { + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; + } } #endif if (code != TCL_OK) { @@ -7097,9 +7106,13 @@ ExprFloorFunc( } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN - if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { - Tcl_SetObjResult(interp, objv[1]); - return TCL_OK; + if (code != TCL_OK) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + + if (irPtr) { + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; + } } #endif if (code != TCL_OK) { @@ -7233,9 +7246,13 @@ ExprSqrtFunc( } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN - if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { - Tcl_SetObjResult(interp, objv[1]); - return TCL_OK; + if (code != TCL_OK) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + + if (irPtr) { + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; + } } #endif if (code != TCL_OK) { @@ -7276,10 +7293,14 @@ ExprUnaryFunc( } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN - if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { - d = objv[1]->internalRep.doubleValue; - Tcl_ResetResult(interp); - code = TCL_OK; + if (code != TCL_OK) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + + if (irPtr) { + d = irPtr->doubleValue; + Tcl_ResetResult(interp); + code = TCL_OK; + } } #endif if (code != TCL_OK) { @@ -7336,10 +7357,14 @@ ExprBinaryFunc( } code = Tcl_GetDoubleFromObj(interp, objv[1], &d1); #ifdef ACCEPT_NAN - if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) { - d1 = objv[1]->internalRep.doubleValue; - Tcl_ResetResult(interp); - code = TCL_OK; + if (code != TCL_OK) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + + if (irPtr) { + d1 = irPtr->doubleValue; + Tcl_ResetResult(interp); + code = TCL_OK; + } } #endif if (code != TCL_OK) { @@ -7347,10 +7372,14 @@ ExprBinaryFunc( } code = Tcl_GetDoubleFromObj(interp, objv[2], &d2); #ifdef ACCEPT_NAN - if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) { - d2 = objv[2]->internalRep.doubleValue; - Tcl_ResetResult(interp); - code = TCL_OK; + if (code != TCL_OK) { + const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + + if (irPtr) { + d2 = irPtr->doubleValue; + Tcl_ResetResult(interp); + code = TCL_OK; + } } #endif if (code != TCL_OK) { @@ -7506,7 +7535,7 @@ ExprDoubleFunc( } if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) { #ifdef ACCEPT_NAN - if (objv[1]->typePtr == &tclDoubleType) { + if (Tcl_FetchIntRep(objv[1], &tclDoubleType)) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } diff --git a/generic/tclLink.c b/generic/tclLink.c index 2735256..27bd490 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -401,14 +401,15 @@ LinkTraceProc( if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN - if (valueObj->typePtr != &tclDoubleType) { + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(valueObj, &tclDoubleType); + if (irPtr == NULL) { #endif Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have real value"; #ifdef ACCEPT_NAN } - linkPtr->lastValue.d = valueObj->internalRep.doubleValue; + linkPtr->lastValue.d = irPtr->doubleValue; #endif } LinkedVar(double) = linkPtr->lastValue.d; diff --git a/generic/tclScan.c b/generic/tclScan.c index 3edb8be..735cd15 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -984,8 +984,10 @@ Tcl_ScanObjCmd( double dvalue; if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN - if (objPtr->typePtr == &tclDoubleType) { - dvalue = objPtr->internalRep.doubleValue; + const Tcl_ObjIntRep *irPtr + = Tcl_FetchIntRep(objPtr, &tclDoubleType); + if (irPtr) { + dvalue = irPtr->doubleValue; } else #endif { -- cgit v0.12 From 1dc5de01791dc98bb90e169012ff9cebee4fe0cd Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 30 Mar 2016 23:16:21 +0000 Subject: Revise "dict" Tcl_ObjType to use proposed routines. --- generic/tclDictObj.c | 183 ++++++++++++++++++++++++++++----------------------- 1 file changed, 99 insertions(+), 84 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 6e54137..da18a2b 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -12,6 +12,7 @@ #include "tclInt.h" #include "tommath.h" +#include /* * Forward declaration. @@ -155,13 +156,6 @@ typedef struct Dict { } Dict; /* - * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this - * must be assignable as well as readable. - */ - -#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1)) - -/* * The structure below defines the dictionary object type by means of * functions that can be invoked by generic object code. */ @@ -174,6 +168,21 @@ const Tcl_ObjType tclDictType = { SetDictFromAny /* setFromAnyProc */ }; +#define DictSetIntRep(objPtr, dictRepPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (dictRepPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &tclDictType, &ir); \ + } while (0) + +#define DictGetIntRep(objPtr, dictRepPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &tclDictType); \ + (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + /* * The type of the specially adapted version of the Tcl_Obj*-containing hash * table defined in the tclObj.c code. This version differs in that it @@ -369,10 +378,11 @@ DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict = DICT(srcPtr); - Dict *newDict = ckalloc(sizeof(Dict)); + Dict *oldDict, *newDict = ckalloc(sizeof(Dict)); ChainEntry *cPtr; + DictGetIntRep(srcPtr, oldDict); + /* * Copy values across from the old hash table. */ @@ -404,9 +414,7 @@ DupDictInternalRep( * Store in the object. */ - DICT(copyPtr) = newDict; - copyPtr->internalRep.twoPtrValue.ptr2 = NULL; - copyPtr->typePtr = &tclDictType; + DictSetIntRep(copyPtr, newDict); } /* @@ -431,13 +439,14 @@ static void FreeDictInternalRep( Tcl_Obj *dictPtr) { - Dict *dict = DICT(dictPtr); + Dict *dict; + + DictGetIntRep(dictPtr, dict); dict->refcount--; if (dict->refcount <= 0) { DeleteDict(dict); } - dictPtr->typePtr = NULL; } /* @@ -496,7 +505,7 @@ UpdateStringOfDict( { #define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr = NULL; - Dict *dict = DICT(dictPtr); + Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; int i, length, bytesNeeded = 0; @@ -509,7 +518,13 @@ UpdateStringOfDict( * is not exposed by any API function... */ - int numElems = dict->table.numEntries * 2; + int numElems; + + DictGetIntRep(dictPtr, dict); + + assert (dict != NULL); + + numElems = dict->table.numEntries * 2; /* Handle empty list case first, simplifies what follows */ if (numElems == 0) { @@ -722,13 +737,10 @@ SetDictFromAny( * Tcl_GetStringFromObj, to use that old internalRep. */ - TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - DICT(objPtr) = dict; - objPtr->internalRep.twoPtrValue.ptr2 = NULL; - objPtr->typePtr = &tclDictType; + DictSetIntRep(objPtr, dict); return TCL_OK; missingValue: @@ -742,6 +754,23 @@ SetDictFromAny( ckfree(dict); return TCL_ERROR; } + +static Dict * +GetDictFromObj( + Tcl_Interp *interp, + Tcl_Obj *dictPtr) +{ + Dict *dict; + + DictGetIntRep(dictPtr, dict); + if (dict == NULL) { + if (SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; + } + DictGetIntRep(dictPtr, dict); + } + return dict; +} /* *---------------------------------------------------------------------- @@ -786,11 +815,13 @@ TclTraceDictPath( Dict *dict, *newDict; int i; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return NULL; + DictGetIntRep(dictPtr, dict); + if (dict == NULL) { + if (SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; + } + DictGetIntRep(dictPtr, dict); } - dict = DICT(dictPtr); if (flags & DICT_PATH_UPDATE) { dict->chain = NULL; } @@ -826,13 +857,17 @@ TclTraceDictPath( Tcl_SetHashValue(hPtr, tmpObj); } else { tmpObj = Tcl_GetHashValue(hPtr); - if (tmpObj->typePtr != &tclDictType - && SetDictFromAny(interp, tmpObj) != TCL_OK) { - return NULL; + + DictGetIntRep(tmpObj, newDict); + + if (newDict == NULL) { + if (SetDictFromAny(interp, tmpObj) != TCL_OK) { + return NULL; + } } } - newDict = DICT(tmpObj); + DictGetIntRep(tmpObj, newDict); if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { TclDecrRefCount(tmpObj); @@ -840,7 +875,7 @@ TclTraceDictPath( Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); dict->epoch++; - newDict = DICT(tmpObj); + DictGetIntRep(tmpObj, newDict); } newDict->chain = dictPtr; @@ -875,7 +910,10 @@ static void InvalidateDictChain( Tcl_Obj *dictObj) { - Dict *dict = DICT(dictObj); + Dict *dict; + + DictGetIntRep(dictObj, dict); + assert( dict != NULL); do { TclInvalidateStringRep(dictObj); @@ -885,7 +923,7 @@ InvalidateDictChain( break; } dict->chain = NULL; - dict = DICT(dictObj); + DictGetIntRep(dictObj, dict); } while (dict != NULL); } @@ -923,15 +961,12 @@ Tcl_DictObjPut( Tcl_Panic("%s called with shared object", "Tcl_DictObjPut"); } - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + dict = GetDictFromObj(interp, dictPtr); + if (dict == NULL) { return TCL_ERROR; } - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); - } - dict = DICT(dictPtr); + TclInvalidateStringRep(dictPtr); hPtr = CreateChainEntry(dict, keyPtr, &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { @@ -974,13 +1009,12 @@ Tcl_DictObjGet( Dict *dict; Tcl_HashEntry *hPtr; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + dict = GetDictFromObj(interp, dictPtr); + if (dict == NULL) { *valuePtrPtr = NULL; return TCL_ERROR; } - dict = DICT(dictPtr); hPtr = Tcl_FindHashEntry(&dict->table, keyPtr); if (hPtr == NULL) { *valuePtrPtr = NULL; @@ -1021,16 +1055,13 @@ Tcl_DictObjRemove( Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove"); } - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + dict = GetDictFromObj(interp, dictPtr); + if (dict == NULL) { return TCL_ERROR; } - dict = DICT(dictPtr); if (DeleteChainEntry(dict, keyPtr)) { - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); - } + TclInvalidateStringRep(dictPtr); dict->epoch++; } return TCL_OK; @@ -1062,12 +1093,11 @@ Tcl_DictObjSize( { Dict *dict; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + dict = GetDictFromObj(interp, dictPtr); + if (dict == NULL) { return TCL_ERROR; } - dict = DICT(dictPtr); *sizePtr = dict->table.numEntries; return TCL_OK; } @@ -1114,12 +1144,11 @@ Tcl_DictObjFirst( Dict *dict; ChainEntry *cPtr; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + dict = GetDictFromObj(interp, dictPtr); + if (dict == NULL) { return TCL_ERROR; } - dict = DICT(dictPtr); cPtr = dict->entryChainHead; if (cPtr == NULL) { searchPtr->epoch = -1; @@ -1294,7 +1323,8 @@ Tcl_DictObjPutKeyList( return TCL_ERROR; } - dict = DICT(dictPtr); + DictGetIntRep(dictPtr, dict); + assert(dict != NULL); hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { @@ -1351,7 +1381,8 @@ Tcl_DictObjRemoveKeyList( return TCL_ERROR; } - dict = DICT(dictPtr); + DictGetIntRep(dictPtr, dict); + assert(dict != NULL); DeleteChainEntry(dict, keyv[keyc-1]); InvalidateDictChain(dictPtr); return TCL_OK; @@ -1397,9 +1428,7 @@ Tcl_NewDictObj(void) dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - DICT(dictPtr) = dict; - dictPtr->internalRep.twoPtrValue.ptr2 = NULL; - dictPtr->typePtr = &tclDictType; + DictSetIntRep(dictPtr, dict); return dictPtr; #endif } @@ -1447,9 +1476,7 @@ Tcl_DbNewDictObj( dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - DICT(dictPtr) = dict; - dictPtr->internalRep.twoPtrValue.ptr2 = NULL; - dictPtr->typePtr = &tclDictType; + DictSetIntRep(dictPtr, dict); return dictPtr; #else /* !TCL_MEM_DEBUG */ return Tcl_NewDictObj(); @@ -1635,16 +1662,13 @@ DictReplaceCmd( } dictPtr = objv[1]; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + if (GetDictFromObj(interp, dictPtr) == NULL) { return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); } - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); - } + TclInvalidateStringRep(dictPtr); for (i=2 ; itypePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + if (GetDictFromObj(interp, dictPtr) == NULL) { return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); } - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); - } + TclInvalidateStringRep(dictPtr); for (i=2 ; itypePtr != &tclDictType - && SetDictFromAny(interp, targetObj) != TCL_OK) { + if (GetDictFromObj(interp, targetObj) == NULL) { return TCL_ERROR; } @@ -1830,8 +1850,7 @@ DictKeysCmd( * need. [Bug 1705778, leak K04] */ - if (objv[1]->typePtr != &tclDictType - && SetDictFromAny(interp, objv[1]) != TCL_OK) { + if (GetDictFromObj(interp, objv[1]) == NULL) { return TCL_ERROR; } @@ -2038,7 +2057,6 @@ DictInfoCmd( int objc, Tcl_Obj *const *objv) { - Tcl_Obj *dictPtr; Dict *dict; char *statsStr; @@ -2047,12 +2065,10 @@ DictInfoCmd( return TCL_ERROR; } - dictPtr = objv[1]; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { + dict = GetDictFromObj(interp, objv[1]); + if (dict == NULL) { return TCL_ERROR; } - dict = DICT(dictPtr); statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); @@ -2113,12 +2129,11 @@ DictIncrCmd( * soon be no good. */ - char *saved = dictPtr->bytes; Tcl_Obj *oldPtr = dictPtr; - dictPtr->bytes = NULL; - dictPtr = Tcl_DuplicateObj(dictPtr); - oldPtr->bytes = saved; + TclNewObj(dictPtr); + TclInvalidateStringRep(dictPtr); + DupDictInternalRep(oldPtr, dictPtr); } if (valuePtr == NULL) { /* @@ -2255,7 +2270,7 @@ DictLappendCmd( if (allocatedValue) { Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); - } else if (dictPtr->bytes != NULL) { + } else { TclInvalidateStringRep(dictPtr); } -- cgit v0.12 From e51db8046c91bb1eec29754bf40f5f5cbd3c7ca9 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 4 Apr 2016 17:27:24 +0000 Subject: Revise "regexp" Tcl_ObjType to use proposed routines. --- generic/tclRegexp.c | 60 ++++++++++++++++++++++++++++------------------------- 1 file changed, 32 insertions(+), 28 deletions(-) diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index ea25d4b..6845f7d 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -13,6 +13,7 @@ #include "tclInt.h" #include "tclRegexp.h" +#include /* *---------------------------------------------------------------------- @@ -107,6 +108,23 @@ const Tcl_ObjType tclRegexpType = { NULL, /* updateStringProc */ SetRegexpFromAny /* setFromAnyProc */ }; + +#define RegexpSetIntRep(objPtr, rePtr) \ + do { \ + Tcl_ObjIntRep ir; \ + (rePtr)->refCount++; \ + ir.twoPtrValue.ptr1 = (rePtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir); \ + } while (0) + +#define RegexpGetIntRep(objPtr, rePtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &tclRegexpType); \ + (rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + /* *---------------------------------------------------------------------- @@ -573,14 +591,9 @@ Tcl_GetRegExpFromObj( TclRegexp *regexpPtr; const char *pattern; - /* - * This is OK because we only actually interpret this value properly as a - * TclRegexp* when the type is tclRegexpType. - */ - - regexpPtr = objPtr->internalRep.twoPtrValue.ptr1; + RegexpGetIntRep(objPtr, regexpPtr); - if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) { + if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) { pattern = TclGetStringFromObj(objPtr, &length); regexpPtr = CompileRegexp(interp, pattern, length, flags); @@ -588,21 +601,7 @@ Tcl_GetRegExpFromObj( return NULL; } - /* - * Add a reference to the regexp so it will persist even if it is - * pushed out of the current thread's regexp cache. This reference - * will be removed when the object's internal rep is freed. - */ - - regexpPtr->refCount++; - - /* - * Free the old representation and set our type. - */ - - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr; - objPtr->typePtr = &tclRegexpType; + RegexpSetIntRep(objPtr, regexpPtr); } return (Tcl_RegExp) regexpPtr; } @@ -749,7 +748,11 @@ static void FreeRegexpInternalRep( Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */ { - TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1; + TclRegexp *regexpRepPtr; + + RegexpGetIntRep(objPtr, regexpRepPtr); + + assert(regexpRepPtr != NULL); /* * If this is the last reference to the regexp, free it. @@ -758,7 +761,6 @@ FreeRegexpInternalRep( if (regexpRepPtr->refCount-- <= 1) { FreeRegexp(regexpRepPtr); } - objPtr->typePtr = NULL; } /* @@ -783,11 +785,13 @@ DupRegexpInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1; + TclRegexp *regexpPtr; + + RegexpGetIntRep(srcPtr, regexpPtr); + + assert(regexpPtr != NULL); - regexpPtr->refCount++; - copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1; - copyPtr->typePtr = &tclRegexpType; + RegexpSetIntRep(copyPtr, regexpPtr); } /* -- cgit v0.12 From aec00dd13c8809b024155d124c3e2bc67c947df9 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 4 Apr 2016 17:43:32 +0000 Subject: Revise "instname" ObjType to use proposed routines --- generic/tclDisassemble.c | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index ecd5f38..73a7815 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -39,7 +39,7 @@ static void UpdateStringOfInstName(Tcl_Obj *objPtr); * reporting of inner contexts in errorstack without string allocation. */ -static const Tcl_ObjType tclInstNameType = { +static const Tcl_ObjType instNameType = { "instname", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ @@ -47,6 +47,21 @@ static const Tcl_ObjType tclInstNameType = { NULL, /* setFromAnyProc */ }; +#define InstNameSetIntRep(objPtr, inst) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.longValue = (inst); \ + Tcl_StoreIntRep((objPtr), &instNameType, &ir); \ + } while (0) + +#define InstNameGetIntRep(objPtr, inst) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &instNameType); \ + assert(irPtr != NULL); \ + (inst) = irPtr->longValue; \ + } while (0) + /* * How to get the bytecode out of a Tcl_Obj. */ @@ -802,11 +817,11 @@ TclNewInstNameObj( { Tcl_Obj *objPtr = Tcl_NewObj(); - objPtr->typePtr = &tclInstNameType; - objPtr->internalRep.longValue = (long) inst; /* Optimized Tcl_InvalidateStringRep */ objPtr->bytes = NULL; + InstNameSetIntRep(objPtr, (long) inst); + return objPtr; } @@ -824,16 +839,18 @@ static void UpdateStringOfInstName( Tcl_Obj *objPtr) { - int inst = objPtr->internalRep.longValue; + int inst; char *dst; + InstNameGetIntRep(objPtr, inst); + if ((inst < 0) || (inst > LAST_INST_OPCODE)) { - dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 4); - TclOOM(dst, TCL_INTEGER_SPACE + 4); + dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); + TclOOM(dst, TCL_INTEGER_SPACE + 5); sprintf(dst, "inst_%d", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { - const char *s = tclInstructionTable[objPtr->internalRep.longValue].name; + const char *s = tclInstructionTable[inst].name; int len = strlen(s); dst = Tcl_InitStringRep(objPtr, s, len); TclOOM(dst, len); -- cgit v0.12 From 6661778d6e9f121c214b29a9011fbd884fc59b8c Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 4 Apr 2016 18:12:42 +0000 Subject: Revise "nsName" ObjType to use proposed routines. --- generic/tclNamesp.c | 65 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 38 insertions(+), 27 deletions(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index dfab185..81d2f80 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -25,6 +25,7 @@ #include "tclInt.h" #include "tclCompile.h" /* for TclLogCommandInfo visibility */ +#include /* * Thread-local storage used to avoid having a global lock on data that is not @@ -154,6 +155,22 @@ static const Tcl_ObjType nsNameType = { SetNsNameFromAny /* setFromAnyProc */ }; +#define NsNameSetIntRep(objPtr, nnPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + (nnPtr)->refCount++; \ + ir.twoPtrValue.ptr1 = (nnPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &nsNameType, &ir); \ + } while (0) + +#define NsNameGetIntRep(objPtr, nnPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &nsNameType); \ + (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. @@ -2830,15 +2847,16 @@ GetNamespaceFromObj( Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ { ResolvedNsName *resNamePtr; - Namespace *nsPtr, *refNsPtr; - if (objPtr->typePtr == &nsNameType) { + NsNameGetIntRep(objPtr, resNamePtr); + if (resNamePtr) { + Namespace *nsPtr, *refNsPtr; + /* * Check that the ResolvedNsName is still valid; avoid letting the ref * cross interps. */ - resNamePtr = objPtr->internalRep.twoPtrValue.ptr1; nsPtr = resNamePtr->nsPtr; refNsPtr = resNamePtr->refNsPtr; if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) && @@ -2847,9 +2865,11 @@ GetNamespaceFromObj( *nsPtrPtr = (Tcl_Namespace *) nsPtr; return TCL_OK; } + TclFreeIntRep(objPtr); } if (SetNsNameFromAny(interp, objPtr) == TCL_OK) { - resNamePtr = objPtr->internalRep.twoPtrValue.ptr1; + NsNameGetIntRep(objPtr, resNamePtr); + assert(resNamePtr != NULL); *nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr; return TCL_OK; } @@ -4634,8 +4654,11 @@ FreeNsNameInternalRep( register Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { - ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1; + ResolvedNsName *resNamePtr; + NsNameGetIntRep(objPtr, resNamePtr); + assert(resNamePtr != NULL); + /* * Decrement the reference count of the namespace. If there are no more * references, free it up. @@ -4652,7 +4675,6 @@ FreeNsNameInternalRep( TclNsDecrRefCount(resNamePtr->nsPtr); ckfree(resNamePtr); } - objPtr->typePtr = NULL; } /* @@ -4679,11 +4701,11 @@ DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1; + ResolvedNsName *resNamePtr; - copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr; - resNamePtr->refCount++; - copyPtr->typePtr = &nsNameType; + NsNameGetIntRep(srcPtr, resNamePtr); + assert(resNamePtr != NULL); + NsNameSetIntRep(copyPtr, resNamePtr); } /* @@ -4728,24 +4750,15 @@ SetNsNameFromAny( TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); + if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) { + return TCL_ERROR; + } + /* * If we found a namespace, then create a new ResolvedNsName structure * that holds a reference to it. */ - if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) { - /* - * Our failed lookup proves any previously cached nsName intrep is no - * longer valid. Get rid of it so we no longer waste memory storing - * it, nor time determining its invalidity again and again. - */ - - if (objPtr->typePtr == &nsNameType) { - TclFreeIntRep(objPtr); - } - return TCL_ERROR; - } - nsPtr->refCount++; resNamePtr = ckalloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; @@ -4754,10 +4767,8 @@ SetNsNameFromAny( } else { resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); } - resNamePtr->refCount = 1; - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr; - objPtr->typePtr = &nsNameType; + resNamePtr->refCount = 0; + NsNameSetIntRep(objPtr, resNamePtr); return TCL_OK; } -- cgit v0.12 From cbfce81f380db6f7472982384457409f58537747 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 4 Apr 2016 19:41:07 +0000 Subject: Use simple name for file static struct. --- generic/tclVar.c | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index be035f7..a05bcf8 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -218,10 +218,6 @@ static Tcl_SetFromAnyProc PanicOnSetVarName; * or NULL if it is this same obj * twoPtrValue.ptr2: index into locals table * - * nsVarName - INTERNALREP DEFINITION: - * twoPtrValue.ptr1: pointer to the namespace containing the reference - * twoPtrValue.ptr2: pointer to the corresponding Var - * * parsedVarName - INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a * scalar variable @@ -234,7 +230,7 @@ static const Tcl_ObjType localVarNameType = { FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName }; -static const Tcl_ObjType tclParsedVarNameType = { +static const Tcl_ObjType parsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, PanicOnUpdateVarName, PanicOnSetVarName }; @@ -442,7 +438,7 @@ TclLookupVar( * Side effects: * New hashtable entries may be created if createPart1 or createPart2 * are 1. The object part1Ptr is converted to one of localVarNameType, - * tclNsVarNameType or tclParsedVarNameType and caches as much of the + * tclNsVarNameType or parsedVarNameType and caches as much of the * lookup as it can. * When createPart1 is 1, callers must IncrRefCount part1Ptr if they * plan to DecrRefCount it. @@ -562,11 +558,11 @@ TclObjLookupVarEx( } /* - * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed + * If part1Ptr is a parsedVarNameType, separate it into the pre-parsed * parts. */ - if (typePtr == &tclParsedVarNameType) { + if (typePtr == &parsedVarNameType) { if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { if (part2Ptr != NULL) { /* @@ -632,12 +628,12 @@ TclObjLookupVarEx( /* * Free the internal rep of the original part1Ptr, now renamed - * objPtr, and set it to tclParsedVarNameType. + * objPtr, and set it to parsedVarNameType. */ objPtr = part1Ptr; TclFreeIntRep(objPtr); - objPtr->typePtr = &tclParsedVarNameType; + objPtr->typePtr = &parsedVarNameType; /* * Define a new string object to hold the new part1Ptr, i.e., @@ -706,7 +702,7 @@ TclObjLookupVarEx( * At least mark part1Ptr as already parsed. */ - part1Ptr->typePtr = &tclParsedVarNameType; + part1Ptr->typePtr = &parsedVarNameType; part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; part1Ptr->internalRep.twoPtrValue.ptr2 = NULL; } @@ -5603,7 +5599,7 @@ DupParsedVarName( dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr; dupPtr->internalRep.twoPtrValue.ptr2 = elem; - dupPtr->typePtr = &tclParsedVarNameType; + dupPtr->typePtr = &parsedVarNameType; } /* -- cgit v0.12 From 90bb5bf23c75bf9403f3d485964e4f14cc203a05 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 4 Apr 2016 22:00:02 +0000 Subject: Use new routine TclGetLambdaFromObj to better isolate the "lambdaExpr" ObjType. Then convert it to use the proposed routines. --- generic/tclDisassemble.c | 16 ++------ generic/tclInt.h | 2 + generic/tclProc.c | 100 +++++++++++++++++++++++++++++++---------------- 3 files changed, 72 insertions(+), 46 deletions(-) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 73a7815..83e950a 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -1325,27 +1325,19 @@ Tcl_DisassembleObjCmd( /* * Compile (if uncompiled) and disassemble a lambda term. - * - * WARNING! Pokes inside the lambda objtype. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm"); return TCL_ERROR; } - if (objv[2]->typePtr == &tclLambdaType) { - procPtr = objv[2]->internalRep.twoPtrValue.ptr1; - } - if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) { - result = tclLambdaType.setFromAnyProc(interp, objv[2]); - if (result != TCL_OK) { - return result; - } - procPtr = objv[2]->internalRep.twoPtrValue.ptr1; + + procPtr = TclGetLambdaFromObj(interp, objv[2], &nsObjPtr); + if (procPtr == NULL) { + return TCL_ERROR; } memset(&cmd, 0, sizeof(Command)); - nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2; result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); if (result != TCL_OK) { return result; diff --git a/generic/tclInt.h b/generic/tclInt.h index e8eba7a..1017fd6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2944,6 +2944,8 @@ MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp, int *modePtr, int flags); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); +MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); diff --git a/generic/tclProc.c b/generic/tclProc.c index ac65bde..2f0da70 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -15,6 +15,7 @@ #include "tclInt.h" #include "tclCompile.h" +#include /* * Variables that are part of the [apply] command implementation and which @@ -91,13 +92,31 @@ static const Tcl_ObjType levelReferenceType = { * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO. */ -const Tcl_ObjType tclLambdaType = { +static const Tcl_ObjType lambdaType = { "lambdaExpr", /* name */ FreeLambdaInternalRep, /* freeIntRepProc */ DupLambdaInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetLambdaFromAny /* setFromAnyProc */ }; + +#define LambdaSetIntRep(objPtr, procPtr, nsObjPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (procPtr); \ + ir.twoPtrValue.ptr2 = (nsObjPtr); \ + Tcl_IncrRefCount((nsObjPtr)); \ + Tcl_StoreIntRep((objPtr), &lambdaType, &ir); \ + } while (0) + +#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &lambdaType); \ + (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ + } while (0) + /* *---------------------------------------------------------------------- @@ -2423,15 +2442,15 @@ DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1; - Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2; + Proc *procPtr; + Tcl_Obj *nsObjPtr; - copyPtr->internalRep.twoPtrValue.ptr1 = procPtr; - copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr; + LambdaGetIntRep(srcPtr, procPtr, nsObjPtr); + assert(procPtr != NULL); procPtr->refCount++; - Tcl_IncrRefCount(nsObjPtr); - copyPtr->typePtr = &tclLambdaType; + + LambdaSetIntRep(copyPtr, procPtr, nsObjPtr); } static void @@ -2439,14 +2458,16 @@ FreeLambdaInternalRep( register Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { - Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; - Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2; + Proc *procPtr; + Tcl_Obj *nsObjPtr; + + LambdaGetIntRep(objPtr, procPtr, nsObjPtr); + assert(procPtr != NULL); if (procPtr->refCount-- == 1) { TclProcCleanupProc(procPtr); } TclDecrRefCount(nsObjPtr); - objPtr->typePtr = NULL; } static int @@ -2467,7 +2488,7 @@ SetLambdaFromAny( /* * Convert objPtr to list type first; if it cannot be converted, or if its - * length is not 2, then it cannot be converted to tclLambdaType. + * length is not 2, then it cannot be converted to lambdaType. */ result = TclListObjGetElements(NULL, objPtr, &objc, &objv); @@ -2608,21 +2629,42 @@ SetLambdaFromAny( } } - Tcl_IncrRefCount(nsObjPtr); - /* * Free the list internalrep of objPtr - this will free argsPtr, but * bodyPtr retains a reference from the Proc structure. Then finish the - * conversion to tclLambdaType. + * conversion to lambdaType. */ - TclFreeIntRep(objPtr); - - objPtr->internalRep.twoPtrValue.ptr1 = procPtr; - objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr; - objPtr->typePtr = &tclLambdaType; + LambdaSetIntRep(objPtr, procPtr, nsObjPtr); return TCL_OK; } + +Proc * +TclGetLambdaFromObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr, + Tcl_Obj **nsObjPtrPtr) +{ + Proc *procPtr; + Tcl_Obj *nsObjPtr; + + LambdaGetIntRep(objPtr, procPtr, nsObjPtr); + + if (procPtr == NULL) { + if (SetLambdaFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + LambdaGetIntRep(objPtr, procPtr, nsObjPtr); + } + + assert(procPtr != NULL); + if (procPtr->iPtr != (Interp *)interp) { + return NULL; + } + + *nsObjPtrPtr = nsObjPtr; + return procPtr; +} /* *---------------------------------------------------------------------- @@ -2676,10 +2718,9 @@ TclNRApplyObjCmd( */ lambdaPtr = objv[1]; - if (lambdaPtr->typePtr == &tclLambdaType) { - procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1; - } + procPtr = TclGetLambdaFromObj(interp, lambdaPtr, &nsObjPtr); + if (procPtr == NULL) { #define JOE_EXTENSION 0 /* * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT @@ -2688,7 +2729,6 @@ TclNRApplyObjCmd( */ #if JOE_EXTENSION - else { /* * Joe English's suggestion to allow cmdNames to function as lambdas. */ @@ -2701,23 +2741,15 @@ TclNRApplyObjCmd( &elemPtr) == TCL_OK && numElem == 1)) { return Tcl_EvalObjv(interp, objc-1, objv+1, 0); } - } #endif - - if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) { - result = SetLambdaFromAny(interp, lambdaPtr); - if (result != TCL_OK) { - return result; - } - procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1; + return TCL_ERROR; } /* - * Find the namespace where this lambda should run, and push a call frame - * for that namespace. Note that TclObjInterpProc() will pop it. + * Push a call frame for the lambda namespace. + * Note that TclObjInterpProc() will pop it. */ - nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2; result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); if (result != TCL_OK) { return TCL_ERROR; -- cgit v0.12 From 08b6a144bd140b72f2b4400a39f23eee149542c9 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 5 Apr 2016 00:05:35 +0000 Subject: Revise the "procbody" Tcl_ObjType to use proposed routines. --- generic/tclProc.c | 33 ++++++++++++++++++++++----------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index 2f0da70..a95cad4 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -69,6 +69,22 @@ const Tcl_ObjType tclProcBodyType = { * should panic instead. */ }; +#define ProcSetIntRep(objPtr, procPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + (procPtr)->refCount++; \ + ir.twoPtrValue.ptr1 = (procPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir); \ + } while (0) + +#define ProcGetIntRep(objPtr, procPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &tclProcBodyType); \ + (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + /* * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field, * encoding the type of level reference in ptr and the actual parsed out @@ -339,7 +355,7 @@ Tcl_ProcObjCmd( * of all procs whose argument list is just _args_ */ - if (objv[3]->typePtr == &tclProcBodyType) { + if (Tcl_FetchIntRep(objv[3], &tclProcBodyType)) { goto done; } @@ -416,14 +432,15 @@ TclCreateProc( Interp *iPtr = (Interp *) interp; const char **argArray = NULL; - register Proc *procPtr; + register Proc *procPtr = NULL; int i, length, result, numArgs; const char *args, *bytes, *p; register CompiledLocal *localPtr = NULL; Tcl_Obj *defPtr; int precompiled = 0; - if (bodyPtr->typePtr == &tclProcBodyType) { + ProcGetIntRep(bodyPtr, procPtr); + if (procPtr != NULL) { /* * Because the body is a TclProProcBody, the actual body is already * compiled, and it is not shared with anyone else, so it's OK not to @@ -436,7 +453,6 @@ TclCreateProc( * will be holding a reference to it. */ - procPtr = bodyPtr->internalRep.twoPtrValue.ptr1; procPtr->iPtr = iPtr; procPtr->refCount++; precompiled = 1; @@ -2355,10 +2371,7 @@ TclNewProcBodyObj( TclNewObj(objPtr); if (objPtr) { - objPtr->typePtr = &tclProcBodyType; - objPtr->internalRep.twoPtrValue.ptr1 = procPtr; - - procPtr->refCount++; + ProcSetIntRep(objPtr, procPtr); } return objPtr; @@ -2388,9 +2401,7 @@ ProcBodyDup( { Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1; - dupPtr->typePtr = &tclProcBodyType; - dupPtr->internalRep.twoPtrValue.ptr1 = procPtr; - procPtr->refCount++; + ProcSetIntRep(dupPtr, procPtr); } /* -- cgit v0.12 From 1f0220295609a72bc08aaec1504ce91edb222860 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Apr 2016 10:38:05 +0000 Subject: Update all Unicode tables to version 9.0 beta --- generic/regc_locale.c | 393 ++++++------ generic/tclUniData.c | 1615 +++++++++++++++++++++++++------------------------ 2 files changed, 1035 insertions(+), 973 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 0a00a18d..ab3b7f1 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -140,35 +140,36 @@ static const crange alphaRangeTable[] = { {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587}, {0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3}, {0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea}, - {0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x904, 0x939}, - {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, {0x993, 0x9a8}, - {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, {0xa05, 0xa0a}, - {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, {0xa72, 0xa74}, - {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0}, - {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, - {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, - {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xc05, 0xc0c}, - {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc58, 0xc5a}, - {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, - {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a}, - {0xd5f, 0xd61}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, - {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, - {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0}, - {0xec0, 0xec4}, {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c}, - {0xf88, 0xf8c}, {0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d}, - {0x106e, 0x1070}, {0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, - {0x10fc, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, - {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, - {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, - {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5}, - {0x13f8, 0x13fd}, {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, - {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, - {0x1720, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, - {0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8}, {0x18b0, 0x18f5}, - {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, - {0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, - {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, - {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, + {0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x8b6, 0x8bd}, + {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, + {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, + {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, + {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, + {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, + {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, + {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, + {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, + {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, + {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, + {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61}, {0xd7a, 0xd7f}, + {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, + {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97}, {0xe99, 0xe9f}, + {0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf}, + {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a}, + {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081}, + {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d}, + {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, + {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, + {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, + {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c}, + {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, + {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, + {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877}, + {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, + {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, + {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, + {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, + {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, @@ -183,7 +184,7 @@ static const crange alphaRangeTable[] = { {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fd5}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, - {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ad}, {0xa7b0, 0xa7b7}, + {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae}, {0xa7b0, 0xa7b7}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, @@ -193,6 +194,8 @@ static const crange alphaRangeTable[] = { {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, + {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, + {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, @@ -205,36 +208,38 @@ static const crange alphaRangeTable[] = { {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0}, {0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375}, {0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, - {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755}, - {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855}, - {0x10860, 0x10876}, {0x10880, 0x1089e}, {0x108e0, 0x108f2}, {0x10900, 0x10915}, - {0x10920, 0x10939}, {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, - {0x10a19, 0x10a33}, {0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, - {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, - {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, - {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8}, {0x11103, 0x11126}, - {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11200, 0x11211}, - {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, - {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c}, {0x11313, 0x11328}, - {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361}, {0x11480, 0x114af}, + {0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563}, + {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805}, + {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e}, + {0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7}, + {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c}, + {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, + {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, + {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af}, + {0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, + {0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, + {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, + {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, + {0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, - {0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x12000, 0x12399}, - {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, - {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, - {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f}, - {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, - {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, - {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, - {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, - {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da}, - {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e}, - {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2}, - {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, - {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, - {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, - {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, - {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, - {0x2f800, 0x2fa1d} + {0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, + {0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x12000, 0x12399}, {0x12480, 0x12543}, + {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, + {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77}, + {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f}, {0x17000, 0x187ec}, + {0x18800, 0x18af2}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, + {0x1bc90, 0x1bc99}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, + {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, + {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, + {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, + {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, + {0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, + {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, + {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, + {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, + {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, + {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, + {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d} #endif }; @@ -249,24 +254,24 @@ static const chr alphaCharTable[] = { 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d, - 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2, 0xd3d, - 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, - 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3, 0xebd, - 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7, 0x10cd, - 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf, 0x1cf5, - 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107, - 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, - 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a, - 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0, - 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44 + 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2, + 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87, + 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3, + 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7, + 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf, + 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102, + 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, + 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c, + 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, + 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44 #if TCL_UTF_MAX > 4 ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be, 0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332, - 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x16f50, - 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, - 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, - 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, - 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e + 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11c40, + 0x16f50, 0x16fe0, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, + 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, + 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, + 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e #endif }; @@ -289,7 +294,7 @@ static const crange controlRangeTable[] = { #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) static const chr controlCharTable[] = { - 0xad, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff + 0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff #if TCL_UTF_MAX > 4 ,0x110bd, 0xe0001 #endif @@ -314,9 +319,10 @@ static const crange digitRangeTable[] = { {0xff10, 0xff19} #if TCL_UTF_MAX > 4 ,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f}, - {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x114d0, 0x114d9}, {0x11650, 0x11659}, - {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9}, {0x16a60, 0x16a69}, - {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff} + {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9}, + {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9}, + {0x11c50, 0x11c59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, + {0x1e950, 0x1e959} #endif }; @@ -339,7 +345,7 @@ static const crange punctRangeTable[] = { {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, - {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e42}, + {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e44}, {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, @@ -348,9 +354,9 @@ static const crange punctRangeTable[] = { #if TCL_UTF_MAX > 4 ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f}, {0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143}, - {0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x115c1, 0x115d7}, - {0x11641, 0x11643}, {0x1173c, 0x1173e}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, - {0x1da87, 0x1da8b} + {0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f}, + {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e}, + {0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b} #endif }; @@ -371,8 +377,8 @@ static const chr punctCharTable[] = { 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d #if TCL_UTF_MAX > 4 ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc, - 0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x114c6, 0x16a6e, 0x16a6f, 0x16af5, - 0x16b44, 0x1bc9f + 0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70, + 0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f #endif }; @@ -404,24 +410,24 @@ static const crange lowerRangeTable[] = { {0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293}, {0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7}, {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd}, - {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, - {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, - {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, - {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, - {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, - {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, - {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, - {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, - {0xff41, 0xff5a} + {0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, + {0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, + {0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, + {0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, + {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, + {0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, + {0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795}, + {0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06}, + {0xfb13, 0xfb17}, {0xff41, 0xff5a} #if TCL_UTF_MAX > 4 - ,{0x10428, 0x1044f}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, {0x1d41a, 0x1d433}, - {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, - {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, - {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, - {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, - {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, - {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, - {0x1d7c4, 0x1d7c9} + ,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, + {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, + {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, + {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, + {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, + {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, + {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, + {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943} #endif }; @@ -513,15 +519,15 @@ static const crange upperRangeTable[] = { {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, - {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ad}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a} + {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a} #if TCL_UTF_MAX > 4 - ,{0x10400, 0x10427}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, {0x1d400, 0x1d419}, - {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, - {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, - {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, - {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, - {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, - {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8} + ,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, + {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, + {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, + {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, + {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, + {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, + {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921} #endif }; @@ -610,26 +616,26 @@ static const crange graphRangeTable[] = { {0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b4}, - {0x8e3, 0x983}, {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, - {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, - {0x9e6, 0x9fb}, {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, - {0xa2a, 0xa30}, {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, - {0xa66, 0xa75}, {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, - {0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, - {0xac7, 0xac9}, {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, - {0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, - {0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, - {0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, - {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, - {0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c}, - {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44}, - {0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63}, - {0xc66, 0xc6f}, {0xc78, 0xc7f}, {0xc81, 0xc83}, {0xc85, 0xc8c}, - {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, - {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, - {0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, - {0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e}, - {0xd5f, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96}, + {0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c}, + {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, + {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03}, + {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42}, + {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83}, + {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0}, + {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd}, + {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c}, + {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44}, + {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a}, + {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, + {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa}, + {0xc00, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, + {0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d}, + {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc83}, + {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, + {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, + {0xce0, 0xce3}, {0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c}, + {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, + {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, @@ -650,25 +656,25 @@ static const crange graphRangeTable[] = { {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, - {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5}, - {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, + {0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5}, + {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20be}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, - {0x2190, 0x23fa}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73}, + {0x2190, 0x23fe}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1}, {0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, - {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e42}, + {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e44}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fd5}, {0xa000, 0xa48c}, - {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ad}, + {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae}, {0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, - {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953}, + {0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, @@ -687,54 +693,59 @@ static const crange graphRangeTable[] = { #if TCL_UTF_MAX > 4 ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d}, {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133}, - {0x10137, 0x1018c}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c}, + {0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c}, {0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a}, {0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, - {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x10500, 0x10527}, {0x10530, 0x10563}, - {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805}, - {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10857, 0x1089e}, {0x108a7, 0x108af}, - {0x108e0, 0x108f2}, {0x108fb, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7}, - {0x109bc, 0x109cf}, {0x109d2, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, - {0x10a19, 0x10a33}, {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, - {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, - {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, - {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, - {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f}, - {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, - {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11150, 0x11176}, {0x11180, 0x111cd}, - {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211}, {0x11213, 0x1123d}, - {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a9}, - {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303}, {0x11305, 0x1130c}, - {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1133c, 0x11344}, - {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c}, {0x11370, 0x11374}, - {0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, - {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, + {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb}, + {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755}, + {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855}, + {0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b}, + {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03}, + {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a}, + {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, + {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, + {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, + {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e}, + {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, + {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143}, + {0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, + {0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, + {0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, + {0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, + {0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, + {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, + {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, + {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2}, - {0x11ac0, 0x11af8}, {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, - {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, - {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, - {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, - {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, - {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, - {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, - {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, - {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, - {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, - {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, - {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, - {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, - {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, - {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, - {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, - {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093}, - {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5}, - {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f19a}, - {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, {0x1f300, 0x1f579}, - {0x1f57b, 0x1f5a3}, {0x1f5a5, 0x1f6d0}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f3}, - {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, - {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f910, 0x1f918}, - {0x1f980, 0x1f984}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, - {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef} + {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, + {0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, + {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543}, + {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, + {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45}, + {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, + {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec}, + {0x18800, 0x18af2}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, + {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, + {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, + {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, + {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, + {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, + {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, + {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, + {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, + {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, + {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, + {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, + {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, + {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, + {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, + {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, + {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f300, 0x1f6d2}, {0x1f6e0, 0x1f6ec}, + {0x1f6f0, 0x1f6f6}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, + {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, + {0x1f910, 0x1f91e}, {0x1f920, 0x1f927}, {0x1f933, 0x1f93e}, {0x1f940, 0x1f94b}, + {0x1f950, 0x1f95e}, {0x1f980, 0x1f991}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, + {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef} #endif }; @@ -747,20 +758,20 @@ static const chr graphCharTable[] = { 0xad0, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, - 0xcde, 0xcf1, 0xcf2, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, - 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, - 0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, - 0x1940, 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, - 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, - 0xfffd + 0xcde, 0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, + 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, + 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, + 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, + 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd #if TCL_UTF_MAX > 4 ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333, - 0x11347, 0x11348, 0x11350, 0x11357, 0x118ff, 0x16a6e, 0x16a6f, 0x1b000, 0x1b001, - 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, - 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, - 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, - 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0 + 0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x16a6e, 0x16a6f, + 0x16fe0, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, + 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, + 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, + 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, + 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f930, 0x1f9c0 #endif }; diff --git a/generic/tclUniData.c b/generic/tclUniData.c index 1ca119d..d8b317a 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -29,36 +29,36 @@ static const unsigned short pageMap[] = { 832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088, 1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344, 1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728, - 1760, 1792, 1792, 1824, 1792, 1856, 1888, 1920, 1952, 1984, 2016, 2048, - 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, - 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, - 2848, 2880, 2784, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, - 3200, 1792, 3232, 3264, 3296, 1792, 3328, 3360, 3392, 3424, 3456, 3488, - 3520, 1792, 1344, 3552, 3584, 3616, 3648, 3680, 3712, 3744, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3776, 1344, 3808, 3840, - 3872, 1344, 3904, 1344, 3936, 3968, 4000, 4032, 4032, 4064, 4096, 1344, + 1760, 1792, 1792, 1824, 1856, 1888, 1920, 1952, 1984, 2016, 2048, 2080, + 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, 2464, + 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, 2848, + 2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, 3200, 3232, + 3264, 1792, 3296, 3328, 3360, 1792, 3392, 3424, 3456, 3488, 3520, 3552, + 3584, 1792, 1344, 3616, 3648, 3680, 3712, 3744, 3776, 3808, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3840, 1344, 3872, 3904, + 3936, 1344, 3968, 1344, 4000, 4032, 4064, 4096, 4096, 4128, 4160, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 4128, 4160, 1344, 1344, 4192, 4224, 4256, - 4288, 4320, 1344, 4352, 4384, 4416, 4448, 1344, 4480, 4512, 1344, 4544, - 1344, 4576, 4608, 4640, 4672, 4704, 1344, 4736, 4768, 4800, 4832, 1344, - 4864, 4896, 4928, 4960, 1792, 1792, 4992, 5024, 5056, 5088, 5120, 5152, - 1344, 5184, 1344, 5216, 5248, 5280, 1792, 1792, 5312, 5344, 5376, 5408, - 5440, 5472, 5504, 5440, 704, 5536, 224, 224, 224, 224, 5568, 224, 224, - 224, 5600, 5632, 5664, 5696, 5728, 5760, 5792, 5824, 5856, 5888, 5920, - 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240, 6272, 6304, - 6336, 6368, 6368, 6368, 6368, 6368, 6368, 6368, 6368, 6400, 6432, 4800, - 6464, 6496, 6528, 6560, 6592, 4800, 6624, 6656, 6688, 6720, 6752, 6784, - 6816, 4800, 4800, 4800, 4800, 4800, 6848, 6880, 6912, 4800, 4800, 4800, - 6944, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 6976, 7008, 4800, 7040, - 7072, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 6368, 6368, 6368, - 6368, 7104, 6368, 7136, 7168, 6368, 6368, 6368, 6368, 6368, 6368, 6368, - 6368, 4800, 7200, 7232, 7264, 7296, 7328, 7360, 7392, 7424, 7456, 7488, - 7520, 224, 224, 224, 7552, 7584, 7616, 1344, 7648, 7680, 7712, 7712, - 704, 7744, 7776, 7808, 1792, 7840, 4800, 4800, 7872, 4800, 4800, 4800, - 4800, 4800, 4800, 7904, 7936, 7968, 8000, 3136, 1344, 8032, 4096, 1344, - 8064, 8096, 8128, 1344, 1344, 8160, 8192, 4800, 8224, 8256, 8288, 8320, - 4800, 8288, 8352, 4800, 8256, 4800, 4800, 4800, 4800, 4800, 4800, 4800, - 4800, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 4192, 4224, 1344, 1344, 4256, 4288, 4320, + 4352, 4384, 1344, 4416, 4448, 4480, 4512, 1344, 4544, 4576, 4608, 4640, + 1344, 4672, 4704, 4736, 4768, 4800, 1344, 4832, 4864, 4896, 4928, 1344, + 4960, 4992, 5024, 5056, 1792, 1792, 5088, 5120, 5152, 5184, 5216, 5248, + 1344, 5280, 1344, 5312, 5344, 5376, 5408, 1792, 5440, 5472, 5504, 5536, + 5568, 5600, 5632, 5568, 704, 5664, 224, 224, 224, 224, 5696, 224, 224, + 224, 5728, 5760, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, + 6080, 6112, 6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, + 6464, 6496, 6496, 6496, 6496, 6496, 6496, 6496, 6496, 6528, 6560, 4896, + 6592, 6624, 6656, 6688, 6720, 4896, 6752, 6784, 6816, 6848, 6880, 6912, + 6944, 4896, 4896, 4896, 4896, 4896, 6976, 7008, 7040, 4896, 4896, 4896, + 7072, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 7104, 7136, 4896, 7168, + 7200, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 6496, 6496, 6496, + 6496, 7232, 6496, 7264, 7296, 6496, 6496, 6496, 6496, 6496, 6496, 6496, + 6496, 4896, 7328, 7360, 7392, 7424, 7456, 7488, 7520, 7552, 7584, 7616, + 7648, 224, 224, 224, 7680, 7712, 7744, 1344, 7776, 7808, 7840, 7840, + 704, 7872, 7904, 7936, 1792, 7968, 4896, 4896, 8000, 4896, 4896, 4896, + 4896, 4896, 4896, 8032, 8064, 8096, 8128, 3200, 1344, 8160, 4160, 1344, + 8192, 8224, 8256, 1344, 1344, 8288, 8320, 4896, 8352, 8384, 8416, 8448, + 4896, 8416, 8480, 4896, 8384, 4896, 4896, 4896, 4896, 4896, 4896, 4896, + 4896, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -75,7 +75,7 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 4576, 4800, 4800, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 4672, 4896, 4896, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -129,16 +129,16 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4576, - 1792, 8384, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4672, + 1792, 8512, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 8416, 4800, 8448, 5280, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 8480, 8512, 224, 8544, 8576, 1344, 1344, 8608, 8640, 8672, 224, - 8704, 8736, 8768, 1792, 8800, 8832, 8864, 1344, 8896, 8928, 8960, 8992, - 9024, 1632, 9056, 9088, 9120, 1888, 9152, 9184, 9216, 1344, 9248, 9280, - 9312, 1344, 9344, 9376, 9408, 9440, 9472, 9504, 9536, 9568, 9568, 1344, - 9600, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 8544, 4896, 8576, 5376, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 8608, 8640, 224, 8672, 8704, 1344, 1344, 8736, 8768, 8800, 224, + 8832, 8864, 8896, 1792, 8928, 8960, 8992, 1344, 9024, 9056, 9088, 9120, + 9152, 1632, 9184, 9216, 9248, 1920, 9280, 9312, 9344, 1344, 9376, 9408, + 9440, 1344, 9472, 9504, 9536, 9568, 9600, 9632, 9664, 9696, 9696, 1344, + 9728, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -167,95 +167,73 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 9632, 9664, 9696, 9728, 9728, 9728, 9728, 9728, 9728, 9728, - 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, - 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, - 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, - 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, - 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9728, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, 9760, - 9760, 9760, 9760, 9760, 9760, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 9792, 1344, 1344, 9824, 1792, 9856, 9888, 9920, - 1344, 1344, 9952, 9984, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 10016, 10048, 1344, 10080, 1344, 10112, 10144, 10176, 10208, - 10240, 10272, 1344, 1344, 1344, 10304, 10336, 64, 10368, 10400, 10432, - 4608, 10464, 10496 + 1344, 1344, 9760, 9792, 9824, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 9920, 1344, 1344, 9952, 1792, 9984, 10016, + 10048, 1344, 1344, 10080, 10112, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 10144, 10176, 1344, 10208, 1344, 10240, 10272, + 10304, 10336, 10368, 10400, 1344, 1344, 1344, 10432, 10464, 64, 10496, + 10528, 10560, 4704, 10592, 10624 #if TCL_UTF_MAX > 3 - ,10528, 10560, 10592, 1792, 1344, 1344, 1344, 8192, 10624, 10656, 10688, - 10720, 10752, 10784, 10816, 10848, 1792, 1792, 1792, 1792, 9120, 1344, - 10880, 10912, 1344, 10944, 10976, 11008, 11040, 1344, 11072, 1792, - 11104, 11136, 11168, 1344, 11200, 11232, 1792, 1792, 1344, 11264, 1344, - 11296, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 7680, 4576, 10112, 1792, 1792, 1792, 1792, 11328, - 11360, 11392, 11424, 4608, 11456, 1792, 11488, 11520, 11552, 1792, - 1792, 1344, 11584, 11616, 6688, 11648, 11680, 11712, 11744, 11776, - 1792, 11808, 11840, 1344, 11872, 11904, 11936, 11968, 12000, 1792, - 1792, 1344, 1344, 12032, 1792, 12064, 12096, 12128, 12160, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 12192, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 12224, - 12256, 12288, 12320, 5120, 12352, 12384, 12416, 12448, 12480, 12512, - 12544, 5120, 12576, 12608, 12640, 12672, 12704, 1792, 1792, 12736, - 12768, 12800, 12832, 12864, 2304, 12896, 12928, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1344, 12960, 12992, 1792, 1792, 1792, 1792, - 1792, 1344, 13024, 13056, 1792, 1344, 13088, 13120, 1792, 1344, 13152, - 11232, 1792, 13184, 13216, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 13248, 13280, 13312, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 13344, + ,10656, 10688, 10720, 1792, 1344, 1344, 1344, 8320, 10752, 10784, 10816, + 10848, 10880, 10912, 10944, 10976, 1792, 1792, 1792, 1792, 9248, 1344, + 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200, 1792, + 11232, 11264, 11296, 1344, 11328, 11360, 11392, 11424, 1344, 11456, + 1344, 11488, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 7808, 4672, 10240, 1792, 1792, 1792, 1792, + 11520, 11552, 11584, 11616, 4704, 11648, 1792, 11680, 11712, 11744, + 1792, 1792, 1344, 11776, 11808, 6816, 11840, 11872, 11904, 11936, 11968, + 1792, 12000, 12032, 1344, 12064, 12096, 12128, 12160, 12192, 1792, + 1792, 1344, 1344, 12224, 1792, 12256, 12288, 12320, 12352, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 12384, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 12416, + 12448, 12480, 12512, 5216, 12544, 12576, 12608, 12640, 12672, 12704, + 12736, 5216, 12768, 12800, 12832, 12864, 12896, 1792, 1792, 12928, + 12960, 12992, 13024, 13056, 2336, 13088, 13120, 1792, 1792, 1792, 1792, + 1344, 13152, 13184, 1792, 1344, 13216, 13248, 1792, 1792, 1792, 1792, + 1792, 1344, 13280, 13312, 1792, 1344, 13344, 13376, 13408, 1344, 13440, + 13472, 1792, 13504, 13536, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 13568, 13600, 13632, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 13664, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 13696, 13728, 13760, + 13792, 13824, 13856, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9824, 1792, 1792, 1792, - 10688, 10688, 10688, 13376, 1344, 1344, 1344, 1344, 1344, 1344, 13408, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9952, 1792, + 1792, 1792, 10816, 10816, 10816, 13888, 1344, 1344, 1344, 1344, 1344, + 1344, 13920, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 13440, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 13472, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1344, 13952, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -265,14 +243,10 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 13344, 4608, 13504, 1792, 1792, 10048, 13536, 1344, 13568, 13600, 13632, - 13664, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1344, 1344, 1344, 13984, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1344, 1344, 13696, 13728, 13760, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -293,7 +267,31 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 13664, 4704, 14016, 1792, 1792, 10176, 14048, 1344, + 14080, 14112, 14144, 14176, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 14208, + 14240, 14272, 1792, 1792, 14304, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 14336, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 14368, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -315,19 +313,18 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 13792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 14400, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, - 1344, 1344, 13824, 13856, 13888, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 14432, 14464, 14496, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -337,40 +334,44 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 7904, - 4800, 13920, 4800, 13952, 13984, 14016, 4800, 14048, 4800, 4800, 14080, - 1792, 1792, 1792, 1792, 1792, 4800, 4800, 14112, 14144, 1792, 1792, - 1792, 1792, 14176, 14208, 14240, 14272, 14304, 14336, 14368, 14400, - 14432, 14464, 14496, 14528, 14560, 14176, 14208, 14592, 14272, 14624, - 14656, 14688, 14400, 14720, 14752, 14784, 14816, 14848, 14880, 14912, - 14944, 14976, 15008, 15040, 4800, 4800, 4800, 4800, 4800, 4800, 4800, - 4800, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 4800, 704, 15072, 704, - 15104, 15136, 15168, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 4896, 4896, + 4896, 4896, 4896, 4896, 4896, 8032, 4896, 14528, 4896, 14560, 14592, + 14624, 4896, 14656, 4896, 4896, 14688, 1792, 1792, 1792, 1792, 1792, + 4896, 4896, 14720, 14752, 1792, 1792, 1792, 1792, 14784, 14816, 14848, + 14880, 14912, 14944, 14976, 15008, 15040, 15072, 15104, 15136, 15168, + 14784, 14816, 15200, 14880, 15232, 15264, 15296, 15008, 15328, 15360, + 15392, 15424, 15456, 15488, 15520, 15552, 15584, 15616, 15648, 4896, + 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, + 4896, 4896, 4896, 704, 15680, 704, 15712, 15744, 15776, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 15808, 15840, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 15200, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, + 1344, 1344, 1344, 15872, 1792, 15904, 15936, 15968, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 15232, 15264, 15296, 15328, 15360, 15392, 1792, 15424, - 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 4800, 15456, 4800, - 4800, 7872, 15488, 15520, 7904, 15552, 15584, 4800, 15456, 15616, 1792, - 1792, 15648, 15680, 15616, 15712, 1792, 1792, 1792, 1792, 1792, 4800, - 4800, 4800, 4800, 4800, 4800, 4800, 15744, 4800, 4800, 4800, 4800, - 4800, 4800, 4800, 4800, 4800, 4800, 4800, 7840, 4800, 15776, 4800, - 4800, 4800, 4800, 4800, 4800, 4800, 4800, 15808, 15840, 4800, 4800, - 4800, 7872, 4800, 4800, 15872, 1792, 15456, 4800, 15904, 4800, 15936, - 15968, 1792, 1792, 16000, 1792, 1792, 1792, 16032, 1792, 10784, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 16000, + 16032, 16064, 16096, 16128, 16160, 1792, 16192, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 4896, 16224, 4896, 4896, 8000, 16256, 16288, + 8032, 16320, 16352, 4896, 16224, 4896, 16384, 1792, 16416, 16448, 16480, + 16512, 1792, 1792, 1792, 1792, 1792, 4896, 4896, 4896, 4896, 4896, + 4896, 4896, 16544, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, + 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, 4896, + 4896, 4896, 16576, 16608, 4896, 4896, 4896, 8000, 4896, 4896, 16640, + 1792, 16224, 4896, 16672, 4896, 16704, 16736, 1792, 1792, 16768, 16800, + 16832, 1792, 16864, 1792, 10912, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, + 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -481,8 +482,7 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 7680, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 7808, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -493,7 +493,8 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 11200, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 16896, 1344, 1344, + 1344, 1344, 1344, 1344, 11328, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -508,7 +509,7 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 13792, + 1344, 1344, 1344, 1344, 1344, 1344, 14400, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, @@ -536,8 +537,8 @@ static const unsigned short pageMap[] = { 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, - 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11200 + 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 11328 #endif /* TCL_UTF_MAX > 3 */ }; @@ -579,7 +580,7 @@ static const unsigned char groupMap[] = { 23, 24, 21, 21, 21, 21, 21, 21, 55, 23, 24, 56, 57, 58, 58, 23, 24, 59, 60, 61, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 62, 63, 64, 65, 66, 21, 67, 67, 21, 68, 21, 69, 70, 21, 21, 21, 67, 71, 21, 72, 21, - 73, 74, 21, 75, 76, 21, 77, 78, 21, 21, 76, 21, 79, 80, 21, 21, 81, + 73, 74, 21, 75, 76, 74, 77, 78, 21, 21, 76, 21, 79, 80, 21, 21, 81, 21, 21, 21, 21, 21, 21, 21, 82, 21, 21, 83, 21, 21, 83, 21, 21, 21, 84, 83, 85, 86, 86, 87, 21, 21, 21, 21, 21, 88, 21, 15, 21, 21, 21, 21, 21, 21, 21, 21, 89, 90, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, @@ -654,453 +655,460 @@ static const unsigned char groupMap[] = { 92, 92, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 17, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 124, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 15, 124, - 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 92, 124, - 124, 15, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 92, 92, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 91, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, - 0, 0, 92, 15, 124, 124, 124, 92, 92, 92, 92, 0, 0, 124, 124, 0, 0, - 124, 124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, 0, 15, 15, - 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, - 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, 0, 0, 0, 0, 0, 92, 92, 124, 0, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 0, - 0, 92, 0, 124, 124, 124, 92, 92, 0, 0, 0, 0, 92, 92, 0, 0, 92, 92, - 92, 0, 0, 0, 92, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 0, 0, - 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 15, 15, 15, 92, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 124, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124, - 124, 124, 92, 92, 92, 92, 92, 0, 92, 92, 124, 0, 124, 124, 92, 0, 0, - 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 92, 0, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0, 0, 0, 0, 0, 15, 0, - 0, 0, 0, 0, 0, 0, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124, 92, 124, 92, - 92, 92, 92, 0, 0, 124, 124, 0, 0, 124, 124, 92, 0, 0, 0, 0, 0, 0, 0, - 0, 92, 124, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 92, 15, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, - 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, - 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 124, 124, 92, 124, 124, 0, 0, 0, 124, 124, - 124, 0, 124, 124, 124, 92, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, - 18, 18, 14, 14, 14, 14, 14, 14, 4, 14, 0, 0, 0, 0, 0, 92, 124, 124, - 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, + 92, 92, 92, 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 0, 0, 15, 92, 92, 92, 124, 124, 124, 124, 0, 92, 92, - 92, 0, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 92, 92, 0, 15, 15, 15, - 0, 0, 0, 0, 0, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 14, 0, 92, 124, - 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, - 15, 15, 0, 0, 92, 15, 124, 92, 124, 124, 124, 124, 124, 0, 92, 124, - 124, 0, 124, 124, 92, 92, 0, 0, 0, 0, 0, 0, 0, 124, 124, 0, 0, 0, 0, - 0, 0, 0, 15, 0, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 15, 124, 124, 124, 92, 92, 92, 92, 0, 124, - 124, 124, 0, 124, 124, 124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 124, 0, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 15, 15, 15, 15, 15, 15, - 0, 0, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 0, 92, 0, 0, 0, 0, 124, 124, 124, 92, 92, 92, 0, 92, 0, 124, - 124, 124, 124, 124, 124, 124, 124, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 0, 0, 124, 124, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, - 15, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, - 15, 91, 92, 92, 92, 92, 92, 92, 92, 92, 3, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 0, 15, 15, 0, 15, 0, 0, - 15, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 15, 15, 0, 15, 0, 15, 0, 0, 15, 15, 0, 15, 15, 15, 15, 92, 15, - 15, 92, 92, 92, 92, 92, 92, 0, 92, 92, 15, 0, 0, 15, 15, 15, 15, 15, - 0, 91, 0, 92, 92, 92, 92, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 92, 92, 14, 14, 14, 14, 14, 14, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 14, 92, 14, 92, 14, 92, 5, 6, 5, 6, 124, 124, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 15, 124, 124, 124, 92, 92, + 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 92, 124, 124, 15, 92, 92, + 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, + 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 91, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, + 15, 15, 15, 15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 92, 15, 124, + 124, 124, 92, 92, 92, 92, 0, 0, 124, 124, 0, 0, 124, 124, 92, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 92, 92, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, + 18, 14, 4, 0, 0, 0, 0, 0, 92, 92, 124, 0, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 0, 0, 92, 0, 124, 124, 124, + 92, 92, 0, 0, 0, 0, 92, 92, 0, 0, 92, 92, 92, 0, 0, 0, 92, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 92, 92, 15, 15, 15, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 92, 92, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, + 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124, 124, 124, 92, 92, 92, 92, + 92, 0, 92, 92, 124, 0, 124, 124, 92, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 3, 4, 0, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 92, 124, + 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, + 15, 15, 0, 0, 92, 15, 124, 92, 124, 92, 92, 92, 92, 0, 0, 124, 124, + 0, 0, 124, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0, 92, 124, 0, 0, 0, 0, 15, + 15, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, + 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 0, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, + 0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 124, 124, 92, 124, 124, 0, 0, 0, 124, 124, 124, 0, 124, 124, 124, 92, + 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, + 14, 4, 14, 0, 0, 0, 0, 0, 92, 124, 124, 124, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 92, + 92, 92, 124, 124, 124, 124, 0, 92, 92, 92, 0, 92, 92, 92, 92, 0, 0, + 0, 0, 0, 0, 0, 92, 92, 0, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 92, 92, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, + 18, 18, 18, 18, 18, 14, 15, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124, 92, + 124, 124, 124, 124, 124, 0, 92, 124, 124, 0, 124, 124, 92, 92, 0, 0, + 0, 0, 0, 0, 0, 124, 124, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 92, 92, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 124, 124, 124, + 92, 92, 92, 92, 0, 124, 124, 124, 0, 124, 124, 124, 92, 15, 14, 0, + 0, 0, 0, 15, 15, 15, 124, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 92, + 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 0, 124, 124, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 92, 0, 0, 0, 0, 124, + 124, 124, 92, 92, 92, 0, 92, 0, 124, 124, 124, 124, 124, 124, 124, + 124, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 124, 124, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 92, 92, 92, 92, 92, 92, 92, + 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 91, 92, 92, 92, 92, 92, 92, + 92, 92, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, + 0, 15, 0, 0, 15, 15, 0, 15, 0, 0, 15, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 0, 15, 0, + 0, 15, 15, 0, 15, 15, 15, 15, 92, 15, 15, 92, 92, 92, 92, 92, 92, 0, + 92, 92, 15, 0, 0, 15, 15, 15, 15, 15, 0, 91, 0, 92, 92, 92, 92, 92, + 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, + 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, + 14, 92, 92, 14, 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 92, 14, 92, 14, 92, 5, 6, 5, + 6, 124, 124, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 3, 92, 92, 15, 15, 15, - 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 92, 92, + 92, 92, 92, 3, 92, 92, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, - 14, 14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 14, 14, 14, 14, 0, 14, - 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92, 92, 92, 124, 92, - 92, 92, 92, 92, 92, 124, 92, 92, 124, 124, 92, 92, 15, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 124, 124, - 92, 92, 15, 15, 15, 15, 92, 92, 92, 15, 124, 124, 124, 15, 15, 124, - 124, 124, 124, 124, 124, 124, 15, 15, 15, 92, 92, 92, 92, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92, 124, - 124, 124, 124, 124, 124, 92, 15, 124, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 124, 124, 124, 92, 14, 14, 125, 125, 125, 125, 125, 125, 125, 125, + 92, 92, 92, 92, 92, 92, 92, 92, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 92, 14, 14, 14, 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, + 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, + 124, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 124, 92, 92, 124, + 124, 92, 92, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, + 15, 15, 15, 15, 15, 124, 124, 92, 92, 15, 15, 15, 15, 92, 92, 92, 15, + 124, 124, 124, 15, 15, 124, 124, 124, 124, 124, 124, 124, 15, 15, 15, + 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 92, 124, 124, 92, 92, 124, 124, 124, 124, 124, 124, 92, 15, 124, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 124, 124, 124, 92, 14, 14, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, - 125, 125, 0, 125, 0, 0, 0, 0, 0, 125, 0, 0, 15, 15, 15, 15, 15, 15, + 125, 125, 125, 125, 125, 125, 125, 0, 125, 0, 0, 0, 0, 0, 125, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 3, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, - 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, - 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 91, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, - 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 92, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 126, 126, - 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, + 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 92, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 0, 0, 0, 0, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, - 126, 126, 126, 126, 104, 104, 104, 104, 104, 104, 0, 0, 110, 110, 110, - 110, 110, 110, 0, 0, 8, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, - 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 6, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 127, 127, 127, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 92, 92, 92, 0, 0, 0, + 126, 126, 126, 126, 126, 126, 126, 126, 126, 104, 104, 104, 104, 104, + 104, 0, 0, 110, 110, 110, 110, 110, 110, 0, 0, 8, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5, + 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 127, + 127, 127, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, + 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 3, 3, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 92, 92, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 124, 92, 92, 92, 92, - 92, 92, 92, 124, 124, 124, 124, 124, 124, 124, 124, 92, 124, 124, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 91, 3, 3, 3, 4, 15, - 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8, - 3, 3, 3, 3, 92, 92, 92, 17, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 0, 0, 0, 0, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, + 0, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, + 124, 92, 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 124, 124, 124, + 124, 92, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, + 3, 91, 3, 3, 3, 4, 15, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, + 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 92, 92, 92, 17, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 92, 92, 92, 124, 124, 124, 124, 92, 92, 124, 124, - 124, 0, 0, 0, 0, 124, 124, 92, 124, 124, 124, 124, 124, 124, 92, 92, - 92, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, - 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, + 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 92, 92, 92, 124, 124, 124, 124, 92, + 92, 124, 124, 124, 0, 0, 0, 0, 124, 124, 92, 124, 124, 124, 124, 124, + 124, 92, 92, 92, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 92, 92, 124, 124, 92, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92, - 124, 92, 92, 92, 92, 92, 92, 92, 0, 92, 124, 92, 124, 124, 92, 92, - 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 124, 124, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 0, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, - 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, - 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 0, 0, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 119, 0, 92, 92, 92, 92, 124, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 92, 92, 92, - 92, 124, 92, 124, 124, 124, 124, 124, 92, 124, 124, 15, 15, 15, 15, - 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, - 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 92, 92, 124, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92, 92, 92, - 92, 124, 124, 92, 92, 124, 92, 92, 92, 15, 15, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, - 92, 124, 124, 124, 92, 124, 92, 92, 92, 124, 124, 0, 0, 0, 0, 0, 0, - 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 124, 124, 124, 124, 124, 124, 124, - 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 0, 0, 0, 3, - 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, 15, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 91, 91, 91, 91, 91, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, - 0, 0, 0, 0, 0, 0, 92, 92, 92, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 92, - 15, 15, 15, 15, 124, 124, 92, 15, 15, 0, 92, 92, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 92, 92, 124, 124, 92, 0, 0, 3, 3, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 124, 92, 124, 92, 92, 92, 92, 92, 92, 92, 0, 92, 124, 92, 124, + 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 124, 124, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 92, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, + 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 0, 0, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 119, 0, 92, 92, 92, 92, + 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, + 92, 92, 92, 92, 124, 92, 124, 124, 124, 124, 124, 92, 124, 124, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, + 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, + 92, 92, 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, + 92, 92, 92, 92, 124, 124, 92, 92, 124, 92, 92, 92, 15, 15, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 92, 124, 92, 92, 124, 124, 124, 92, 124, 92, 92, 92, 124, 124, 0, 0, + 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 124, 124, 124, 124, 124, + 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 0, + 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, + 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 91, 91, 91, 91, 91, 91, 3, 3, 128, 129, 130, 131, 131, + 132, 133, 134, 135, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, + 92, 92, 92, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 124, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 92, 15, 15, 15, 15, + 124, 124, 92, 15, 15, 0, 92, 92, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 91, 91, 91, 91, 91, 91, + 21, 21, 21, 21, 21, 21, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - 91, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 91, 128, 21, 21, 21, 129, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 91, 91, 91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 92, - 92, 92, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, - 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 130, 21, 21, 131, - 21, 132, 132, 132, 132, 132, 132, 132, 132, 133, 133, 133, 133, 133, - 133, 133, 133, 132, 132, 132, 132, 132, 132, 0, 0, 133, 133, 133, 133, - 133, 133, 0, 0, 132, 132, 132, 132, 132, 132, 132, 132, 133, 133, 133, - 133, 133, 133, 133, 133, 132, 132, 132, 132, 132, 132, 132, 132, 133, - 133, 133, 133, 133, 133, 133, 133, 132, 132, 132, 132, 132, 132, 0, - 0, 133, 133, 133, 133, 133, 133, 0, 0, 21, 132, 21, 132, 21, 132, 21, - 132, 0, 133, 0, 133, 0, 133, 0, 133, 132, 132, 132, 132, 132, 132, - 132, 132, 133, 133, 133, 133, 133, 133, 133, 133, 134, 134, 135, 135, - 135, 135, 136, 136, 137, 137, 138, 138, 139, 139, 0, 0, 132, 132, 132, - 132, 132, 132, 132, 132, 140, 140, 140, 140, 140, 140, 140, 140, 132, - 132, 132, 132, 132, 132, 132, 132, 140, 140, 140, 140, 140, 140, 140, - 140, 132, 132, 132, 132, 132, 132, 132, 132, 140, 140, 140, 140, 140, - 140, 140, 140, 132, 132, 21, 141, 21, 0, 21, 21, 133, 133, 142, 142, - 143, 11, 144, 11, 11, 11, 21, 141, 21, 0, 21, 21, 145, 145, 145, 145, - 143, 11, 11, 11, 132, 132, 21, 21, 0, 0, 21, 21, 133, 133, 146, 146, - 0, 11, 11, 11, 132, 132, 21, 21, 21, 113, 21, 21, 133, 133, 147, 147, - 117, 11, 11, 11, 0, 0, 21, 141, 21, 0, 21, 21, 148, 148, 149, 149, - 143, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, - 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, - 3, 3, 3, 150, 151, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, - 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 91, 0, 0, 18, - 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 91, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 7, 7, 7, 5, 6, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, - 91, 91, 91, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 119, 119, 119, 119, 92, 119, 119, 119, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 14, 14, 107, 14, 14, 14, 14, 107, 14, 14, 21, 107, 107, 107, - 21, 21, 107, 107, 107, 21, 14, 107, 14, 14, 7, 107, 107, 107, 107, - 107, 14, 14, 14, 14, 14, 14, 107, 14, 152, 14, 107, 14, 153, 154, 107, - 107, 14, 21, 107, 107, 155, 107, 21, 15, 15, 15, 15, 21, 14, 14, 21, - 21, 107, 107, 7, 7, 7, 7, 7, 107, 21, 21, 21, 21, 14, 7, 14, 14, 156, - 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, 157, - 157, 157, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, 158, - 158, 158, 158, 158, 127, 127, 127, 23, 24, 127, 127, 127, 127, 18, - 14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, - 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, + 91, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 136, 21, + 21, 21, 137, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 91, + 91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, + 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 138, 21, 21, 139, 21, 140, + 140, 140, 140, 140, 140, 140, 140, 141, 141, 141, 141, 141, 141, 141, + 141, 140, 140, 140, 140, 140, 140, 0, 0, 141, 141, 141, 141, 141, 141, + 0, 0, 140, 140, 140, 140, 140, 140, 140, 140, 141, 141, 141, 141, 141, + 141, 141, 141, 140, 140, 140, 140, 140, 140, 140, 140, 141, 141, 141, + 141, 141, 141, 141, 141, 140, 140, 140, 140, 140, 140, 0, 0, 141, 141, + 141, 141, 141, 141, 0, 0, 21, 140, 21, 140, 21, 140, 21, 140, 0, 141, + 0, 141, 0, 141, 0, 141, 140, 140, 140, 140, 140, 140, 140, 140, 141, + 141, 141, 141, 141, 141, 141, 141, 142, 142, 143, 143, 143, 143, 144, + 144, 145, 145, 146, 146, 147, 147, 0, 0, 140, 140, 140, 140, 140, 140, + 140, 140, 148, 148, 148, 148, 148, 148, 148, 148, 140, 140, 140, 140, + 140, 140, 140, 140, 148, 148, 148, 148, 148, 148, 148, 148, 140, 140, + 140, 140, 140, 140, 140, 140, 148, 148, 148, 148, 148, 148, 148, 148, + 140, 140, 21, 149, 21, 0, 21, 21, 141, 141, 150, 150, 151, 11, 152, + 11, 11, 11, 21, 149, 21, 0, 21, 21, 153, 153, 153, 153, 151, 11, 11, + 11, 140, 140, 21, 21, 0, 0, 21, 21, 141, 141, 154, 154, 0, 11, 11, + 11, 140, 140, 21, 21, 21, 113, 21, 21, 141, 141, 155, 155, 117, 11, + 11, 11, 0, 0, 21, 149, 21, 0, 21, 21, 156, 156, 157, 157, 151, 11, + 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, 8, 8, 8, + 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, + 158, 159, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 20, + 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, 17, 17, 0, + 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 91, 0, 0, 18, 18, 18, 18, + 18, 18, 7, 7, 7, 5, 6, 91, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 7, 7, 7, 5, 6, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, + 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 119, 119, 119, 119, 92, 119, 119, 119, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, + 14, 107, 14, 14, 14, 14, 107, 14, 14, 21, 107, 107, 107, 21, 21, 107, + 107, 107, 21, 14, 107, 14, 14, 7, 107, 107, 107, 107, 107, 14, 14, + 14, 14, 14, 14, 107, 14, 160, 14, 107, 14, 161, 162, 107, 107, 14, + 21, 107, 107, 163, 107, 21, 15, 15, 15, 15, 21, 14, 14, 21, 21, 107, + 107, 7, 7, 7, 7, 7, 107, 21, 21, 21, 21, 14, 7, 14, 14, 164, 14, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 165, 165, + 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, + 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, + 166, 166, 127, 127, 127, 23, 24, 127, 127, 127, 127, 18, 14, 14, 0, + 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 7, + 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, - 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, - 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, - 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, + 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, + 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 159, 159, 159, 159, 159, 159, 159, - 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, - 159, 159, 159, 159, 159, 160, 160, 160, 160, 160, 160, 160, 160, 160, - 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, 160, - 160, 160, 160, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 167, 167, 167, 167, 167, 167, 167, 167, + 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, + 167, 167, 167, 167, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, + 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, + 168, 168, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, - 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, + 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, - 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, + 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, + 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, + 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, - 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 122, 122, 122, 122, 122, 122, 122, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, - 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 0, 123, + 122, 122, 122, 122, 122, 122, 122, 122, 122, 0, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, - 123, 123, 123, 123, 0, 23, 24, 161, 162, 163, 164, 165, 23, 24, 23, - 24, 23, 24, 166, 167, 168, 169, 21, 23, 24, 21, 23, 24, 21, 21, 21, - 21, 21, 91, 91, 170, 170, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, - 23, 24, 23, 24, 92, 92, 92, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, - 3, 3, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, - 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, - 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 0, 171, 0, 0, - 0, 0, 0, 171, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, - 91, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, - 15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, - 6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, + 123, 0, 23, 24, 169, 170, 171, 172, 173, 23, 24, 23, 24, 23, 24, 174, + 175, 176, 177, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21, 21, 91, 91, + 178, 178, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23, 24, 23, 24, + 92, 92, 92, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3, 179, 179, + 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, + 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, + 179, 179, 179, 179, 179, 179, 179, 179, 0, 179, 0, 0, 0, 0, 0, 179, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 91, 3, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6, + 5, 6, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3, + 3, 3, 8, 3, 5, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 91, 15, - 127, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, - 8, 5, 6, 6, 14, 127, 127, 127, 127, 127, 127, 127, 127, 127, 92, 92, - 92, 92, 124, 124, 8, 91, 91, 91, 91, 91, 14, 14, 127, 127, 127, 91, - 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 11, 11, 91, 91, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 91, 91, 91, 15, 0, 0, - 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 91, 15, 127, 5, 6, 5, 6, 5, + 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 127, + 127, 127, 127, 127, 127, 127, 127, 127, 92, 92, 92, 92, 124, 124, 8, + 91, 91, 91, 91, 91, 14, 14, 127, 127, 127, 91, 15, 3, 14, 14, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 92, 92, 11, 11, 91, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 3, 91, 91, 91, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, 18, 18, 18, 18, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, + 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 14, 14, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, 14, + 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, + 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, + 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 91, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 15, 92, 119, 119, 119, + 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 91, 23, 24, 23, 24, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 91, 91, 92, 92, 15, 15, 15, 15, 15, 15, 127, + 127, 127, 127, 127, 127, 127, 127, 127, 127, 92, 92, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 91, 91, 91, 91, + 91, 91, 91, 91, 91, 11, 11, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 91, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24, 23, 24, 180, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 11, 11, 23, 24, 181, 21, 15, + 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, + 24, 23, 24, 23, 24, 23, 24, 23, 24, 182, 183, 184, 185, 182, 0, 186, + 187, 188, 189, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 91, 91, + 21, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 92, 15, 15, 15, 15, + 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92, 124, 14, 14, 14, 14, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 3, 3, 3, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 15, 92, 119, 119, 119, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 3, 91, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 91, 92, 92, - 15, 15, 15, 15, 15, 15, 127, 127, 127, 127, 127, 127, 127, 127, 127, - 127, 92, 92, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 91, 91, 91, 91, 91, 91, 91, 91, 91, 11, 11, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, - 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 21, 21, 21, 21, 21, 21, 21, - 21, 23, 24, 23, 24, 172, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, - 11, 11, 23, 24, 173, 21, 15, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, - 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 174, - 175, 176, 177, 0, 0, 178, 179, 180, 181, 23, 24, 23, 24, 0, 0, 0, 0, + 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 124, 124, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 92, + 92, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, + 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 3, 3, 3, 15, 3, 15, 0, + 0, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, + 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92, 92, 92, 124, + 124, 92, 124, 124, 124, 124, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 0, 91, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, + 15, 15, 92, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 124, 124, 92, 92, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, + 15, 92, 124, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3, 3, 3, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, + 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 124, 92, 124, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 92, + 92, 92, 15, 15, 92, 92, 15, 15, 15, 15, 15, 92, 92, 15, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 15, 91, 91, 21, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, - 15, 92, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92, - 124, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, 4, - 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 124, 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, - 124, 124, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 3, 3, 3, - 15, 3, 15, 0, 0, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, - 92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 124, 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92, - 92, 92, 124, 124, 92, 124, 124, 124, 124, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 0, 91, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, - 15, 15, 15, 15, 15, 92, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 124, 124, - 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15, 15, - 15, 15, 15, 15, 92, 124, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 91, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 124, 92, 124, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 92, 15, 92, 92, 92, 15, 15, 92, 92, 15, 15, 15, 15, 15, 92, 92, 15, - 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 15, 15, 91, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 124, 92, 92, 124, 124, 3, 3, 15, 91, 91, 124, 92, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, - 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, 21, 21, + 15, 15, 91, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, + 92, 92, 124, 124, 3, 3, 15, 91, 91, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 182, 21, 21, 21, - 21, 21, 21, 21, 11, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, - 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, - 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, - 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 15, 15, 15, 124, - 124, 92, 124, 124, 92, 124, 124, 3, 124, 92, 0, 0, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 184, 184, 184, - 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, - 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, 184, - 184, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, - 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, 185, - 185, 185, 185, 185, 185, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 190, 21, 21, 21, 21, 21, + 21, 21, 11, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, + 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, + 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, + 191, 191, 191, 191, 191, 191, 191, 191, 191, 15, 15, 15, 124, 124, + 92, 124, 124, 92, 124, 124, 3, 124, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 192, 192, 192, + 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, + 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, + 192, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, + 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, + 193, 193, 193, 193, 193, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, @@ -1155,229 +1163,263 @@ static const unsigned char groupMap[] = { 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 18, 18, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 18, 18, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 92, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 18, + 14, 14, 14, 92, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 127, 15, 15, 15, 15, 15, 15, 15, 15, - 127, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 127, 15, 15, 15, 15, 15, 15, 15, + 15, 127, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 127, 127, 127, - 127, 127, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 186, 186, 186, 186, 186, 186, - 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, - 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, 186, - 186, 186, 186, 186, 186, 186, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 127, 127, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 194, 194, 194, 194, 194, 194, + 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, + 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, + 194, 194, 194, 194, 194, 194, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 194, 194, 194, + 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, + 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, + 194, 194, 194, 194, 194, 0, 0, 0, 0, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, - 0, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, - 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, - 18, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, - 0, 0, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, - 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 92, 92, 92, 0, 92, 92, - 0, 0, 0, 0, 0, 92, 92, 92, 92, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 92, 92, 92, 0, 0, 0, - 0, 92, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 18, 18, 18, - 18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 18, 18, - 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, - 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 97, + 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, + 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 15, 92, 92, 92, 0, 92, 92, 0, 0, 0, 0, 0, 92, + 92, 92, 92, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 92, 92, 92, 0, 0, 0, 0, 92, 18, 18, 18, + 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 18, 18, 18, 18, 18, 3, 3, 3, + 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, - 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 102, 102, 102, 102, 102, 102, 102, - 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, + 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, - 102, 102, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 0, 0, 0, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 124, 92, 124, 15, 15, + 18, 18, 18, 18, 18, 18, 0, 124, 92, 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 3, 3, 3, 3, 0, 0, + 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, 124, 124, 92, + 92, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, - 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, - 92, 124, 124, 92, 92, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, + 92, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 92, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 15, 15, 15, 15, 3, 3, - 3, 3, 3, 92, 92, 92, 3, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 3, - 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 3, 3, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 124, 124, 15, 15, 15, 15, 3, 3, 3, 3, 3, 92, 92, + 92, 3, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 3, 15, 3, 3, 3, 0, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 124, 124, - 92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 92, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 124, 124, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 124, 124, 0, 0, 124, - 124, 0, 0, 124, 124, 124, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, - 0, 0, 15, 15, 15, 15, 15, 124, 124, 0, 0, 92, 92, 92, 92, 92, 92, 92, - 0, 0, 0, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, - 92, 92, 92, 92, 92, 92, 124, 92, 124, 124, 124, 124, 92, 92, 124, 92, - 92, 15, 15, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, 0, 0, 124, 124, 124, - 124, 92, 92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, - 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 124, 92, 92, 3, 3, 3, - 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, - 92, 124, 124, 92, 92, 92, 92, 92, 92, 124, 92, 0, 0, 0, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 92, 92, 92, 124, 124, - 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 10, 10, 10, 10, 10, 10, 10, 10, + 15, 15, 15, 124, 124, 124, 92, 92, 92, 124, 124, 92, 124, 92, 92, 3, + 3, 3, 3, 3, 3, 92, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, + 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 0, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 124, + 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 124, 124, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 92, 124, 124, 124, 124, 0, 0, 124, 124, 0, 0, 124, + 124, 124, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 124, 124, 0, 0, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 92, 92, + 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, + 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 92, 124, 92, + 15, 15, 15, 15, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 3, + 0, 3, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 124, 92, 124, 124, 124, + 124, 92, 92, 124, 92, 92, 15, 15, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, + 0, 0, 124, 124, 124, 124, 92, 92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 92, + 92, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 124, + 92, 92, 3, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 124, 124, 92, 92, + 92, 92, 92, 92, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 92, 92, 92, 124, + 124, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 0, 0, 0, 0, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, - 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 13, 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 127, 127, 127, 127, 127, 127, - 127, 127, 127, 127, 127, 127, 127, 127, 127, 0, 3, 3, 3, 3, 3, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 92, 92, 92, 92, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 3, 3, 14, 14, 14, 14, 91, 91, - 91, 91, 3, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 0, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 124, 124, 124, 124, - 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 124, 92, 92, 92, 92, 92, 92, 92, 0, 124, + 124, 124, 124, 92, 92, 124, 92, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 3, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 0, 124, 92, 92, 92, 92, 92, 92, 92, 124, 92, 92, 124, 92, 92, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 127, 127, 127, 127, 127, 127, 127, 127, 127, + 127, 127, 127, 127, 127, 127, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 92, 92, 92, 92, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, + 92, 92, 92, 92, 3, 3, 3, 3, 3, 14, 14, 14, 14, 91, 91, 91, 91, 3, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, + 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 91, - 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 15, 15, 0, 0, 0, 0, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 91, 91, 91, + 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 14, 92, 92, 3, 17, 17, 17, 17, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 124, 124, 92, 92, 92, 14, 14, 14, 124, 124, 124, 124, 124, - 124, 17, 17, 17, 17, 17, 17, 17, 17, 92, 92, 92, 92, 92, 92, 92, 92, - 14, 14, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 14, 14, 92, 92, 92, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, + 14, 92, 92, 3, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 124, 124, 92, + 92, 92, 14, 14, 14, 124, 124, 124, 124, 124, 124, 17, 17, 17, 17, 17, + 17, 17, 17, 92, 92, 92, 92, 92, 92, 92, 92, 14, 14, 92, 92, 92, 92, + 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, + 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 92, 92, + 92, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 107, 107, 107, 107, 107, + 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, + 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, + 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 0, + 107, 107, 0, 0, 107, 0, 0, 107, 107, 0, 0, 107, 107, 107, 107, 0, 107, + 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 0, 21, 0, 21, 21, + 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 107, 107, 0, 107, 107, 107, 107, 0, 0, + 107, 107, 107, 107, 107, 107, 107, 107, 0, 107, 107, 107, 107, 107, + 107, 107, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 0, 107, 107, + 107, 107, 0, 107, 107, 107, 107, 107, 0, 107, 0, 0, 0, 107, 107, 107, + 107, 107, 107, 107, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 107, 0, 107, 107, 0, 0, 107, 0, 0, 107, 107, 0, 0, - 107, 107, 107, 107, 0, 107, 107, 107, 107, 107, 107, 107, 107, 21, - 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, + 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 0, - 107, 107, 107, 107, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107, 0, - 107, 107, 107, 107, 107, 107, 107, 0, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 107, 107, 0, 107, 107, 107, 107, 0, 107, 107, 107, 107, 107, 0, - 107, 0, 0, 0, 107, 107, 107, 107, 107, 107, 107, 0, 21, 21, 21, 21, + 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 21, 21, 21, + 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, - 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, - 21, 21, 21, 21, 21, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107, 107, + 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, + 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, @@ -1388,60 +1430,62 @@ static const unsigned char groupMap[] = { 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, - 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, - 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, - 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 92, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 14, 14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 92, 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 92, 92, 92, 92, 92, 14, 14, 14, 14, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, + 14, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, + 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, + 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 0, 0, 92, 92, 92, 92, 92, 92, 92, 0, 92, + 92, 0, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, - 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, - 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, - 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, + 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, + 196, 196, 196, 196, 196, 196, 196, 197, 197, 197, 197, 197, 197, 197, + 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, + 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 92, + 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, + 0, 0, 0, 0, 15, 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, + 15, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, + 15, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11, 14, - 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, + 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, @@ -1450,8 +1494,14 @@ static const unsigned char groupMap[] = { 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, + 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 #endif /* TCL_UTF_MAX > 3 */ }; @@ -1486,15 +1536,16 @@ static const int groups[] = { 29761, 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258, 2113, 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662, 29826, -15295, 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418, - 8, 1859649, 9949249, 10, -9044862, -976254, 15234, -1949375, -1918, - -1983, -18814, -21886, -25470, -32638, -28542, -32126, -1981, - -2174, -18879, -2237, 1844610, -21951, -25535, -28607, -32703, - -32191, 13, 14, -1924287, -2145983, -2115007, 7233, 7298, 4170, - 4234, 6749, 6813, -2750143, -976319, -2746047, 2763650, 2762882, - -2759615, -2751679, -2760383, -2760127, -2768575, 1859714, -9044927, - -10823615, -10830783, -10833599, -10832575, -10830015, -10817983, - -10824127, -10818751, 237633, 237698, 9949314, 18, 17, 10305, - 10370 + 8, 1859649, 9949249, 10, 1601154, 1600898, 1598594, 1598082, 1598338, + 1596546, 1582466, -9027966, -9044862, -976254, 15234, -1949375, + -1918, -1983, -18814, -21886, -25470, -32638, -28542, -32126, + -1981, -2174, -18879, -2237, 1844610, -21951, -25535, -28607, + -32703, -32191, 13, 14, -1924287, -2145983, -2115007, 7233, 7298, + 4170, 4234, 6749, 6813, -2750143, -976319, -2746047, 2763650, + 2762882, -2759615, -2751679, -2760383, -2760127, -2768575, 1859714, + -9044927, -10823615, -10830783, -10833599, -10832575, -10830015, + -10817983, -10824127, -10818751, 237633, 237698, 9949314, 18, + 17, 10305, 10370, 8769, 8834 }; #if TCL_UTF_MAX > 3 -- cgit v0.12 From b42de3a4f38cb8f3837142c0107244102e74e113 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 7 Apr 2016 21:07:26 +0000 Subject: Revise "levelReference" ObjType to use proposed routines. --- generic/tclProc.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index 570e5ba..6307002 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -841,6 +841,7 @@ TclObjGetFrame( { register Interp *iPtr = (Interp *) interp; int curLevel, level, result; + const Tcl_ObjIntRep *irPtr; const char *name = NULL; /* @@ -861,16 +862,17 @@ TclObjGetFrame( && (level >= 0)) { level = curLevel - level; result = 1; - } else if (objPtr->typePtr == &levelReferenceType) { - level = (int) objPtr->internalRep.longValue; + } else if ((irPtr = Tcl_FetchIntRep(objPtr, &levelReferenceType))) { + level = irPtr->longValue; result = 1; } else { name = TclGetString(objPtr); if (name[0] == '#') { if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) { - TclFreeIntRep(objPtr); - objPtr->typePtr = &levelReferenceType; - objPtr->internalRep.longValue = level; + Tcl_ObjIntRep ir; + + ir.longValue = level; + Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir); result = 1; } else { result = -1; -- cgit v0.12 From 188ebe6ceb9813b6e988dcb7af19ee3b3fe51f3b Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 7 Apr 2016 21:34:21 +0000 Subject: Revise the "TclOO method name" objType to use proposed routines. --- generic/tclOOCall.c | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index facf90d..68c4b8e 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -15,6 +15,7 @@ #endif #include "tclInt.h" #include "tclOOInt.h" +#include /* * Structure containing a CallContext and any other values needed only during @@ -92,6 +93,7 @@ static const Tcl_ObjType methodNameType = { NULL, NULL }; + /* * ---------------------------------------------------------------------- @@ -181,10 +183,11 @@ StashCallChain( Tcl_Obj *objPtr, CallChain *callPtr) { + Tcl_ObjIntRep ir; + callPtr->refCount++; - TclFreeIntRep(objPtr); - objPtr->typePtr = &methodNameType; - objPtr->internalRep.twoPtrValue.ptr1 = callPtr; + ir.twoPtrValue.ptr1 = callPtr; + Tcl_StoreIntRep(objPtr, &methodNameType, &ir); } void @@ -211,21 +214,16 @@ DupMethodNameRep( Tcl_Obj *srcPtr, Tcl_Obj *dstPtr) { - register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1; - - dstPtr->typePtr = &methodNameType; - dstPtr->internalRep.twoPtrValue.ptr1 = callPtr; - callPtr->refCount++; + StashCallChain(dstPtr, + Tcl_FetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); } static void FreeMethodNameRep( Tcl_Obj *objPtr) { - register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1; - - TclOODeleteChain(callPtr); - objPtr->typePtr = NULL; + TclOODeleteChain( + Tcl_FetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1); } /* @@ -962,15 +960,16 @@ TclOOGetCallContext( * the object, and in the class). */ + const Tcl_ObjIntRep *irPtr; const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); - if (cacheInThisObj->typePtr == &methodNameType) { - callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1; + if ((irPtr = Tcl_FetchIntRep(cacheInThisObj, &methodNameType))) { + callPtr = irPtr->twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } - FreeMethodNameRep(cacheInThisObj); + Tcl_FreeIntRep(cacheInThisObj); } if (oPtr->flags & USE_CLASS_CACHE) { -- cgit v0.12 From 2c83a6f53e4a4f245befff0309fc99f77925bfb6 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 11 Apr 2016 01:07:31 +0000 Subject: Revise the "end-offset" objType to use proposed routines, and not export or provide unneeded things. --- generic/tclInt.h | 1 - generic/tclObj.c | 1 - generic/tclUtil.c | 157 ++++++++++++------------------------------------------ tests/obj.test | 48 ----------------- 4 files changed, 34 insertions(+), 173 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 59fa018..1aea09b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2685,7 +2685,6 @@ MODULE_SCOPE const Tcl_ObjType tclBooleanType; MODULE_SCOPE const Tcl_ObjType tclByteArrayType; MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; -MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; diff --git a/generic/tclObj.c b/generic/tclObj.c index 338e027..4ec2779 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -397,7 +397,6 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); - Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 01f8225..08fc735 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -108,9 +108,8 @@ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(ClientData clientData); static void FreeThreadHash(ClientData clientData); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); -static int SetEndOffsetFromAny(Tcl_Interp *interp, - Tcl_Obj *objPtr); -static void UpdateStringOfEndOffset(Tcl_Obj *objPtr); +static int GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue, + int *indexPtr); static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, @@ -123,12 +122,12 @@ static int FindElement(Tcl_Interp *interp, const char *string, * integer, so no memory management is required for it. */ -const Tcl_ObjType tclEndOffsetType = { +static const Tcl_ObjType endOffsetType = { "end-offset", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ - UpdateStringOfEndOffset, /* updateStringProc */ - SetEndOffsetFromAny + NULL, /* updateStringProc */ + NULL }; /* @@ -3560,13 +3559,7 @@ TclGetIntForIndex( return TCL_OK; } - if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) { - /* - * If the object is already an offset from the end of the list, or can - * be converted to one, use it. - */ - - *indexPtr = endValue + objPtr->internalRep.longValue; + if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) { return TCL_OK; } @@ -3632,135 +3625,53 @@ TclGetIntForIndex( /* *---------------------------------------------------------------------- * - * UpdateStringOfEndOffset -- - * - * Update the string rep of a Tcl object holding an "end-offset" - * expression. - * - * Results: - * None. - * - * Side effects: - * Stores a valid string in the object's string rep. - * - * This function does NOT free any earlier string rep. If it is called on an - * object that already has a valid string rep, it will leak memory. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfEndOffset( - register Tcl_Obj *objPtr) -{ - char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); - int len = 3; - - TclOOM(dst, TCL_INTEGER_SPACE + 6); - - memcpy(dst, "end", len); - if (objPtr->internalRep.longValue != 0) { - dst[len++] = '-'; - len += TclFormatInt(dst+len, -(objPtr->internalRep.longValue)); - } - - (void) Tcl_InitStringRep(objPtr, NULL, len); -} - -/* - *---------------------------------------------------------------------- - * - * SetEndOffsetFromAny -- + * GetEndOffsetFromObj -- * * Look for a string of the form "end[+-]offset" and convert it to an * internal representation holding the offset. * * Results: - * Returns TCL_OK if ok, TCL_ERROR if the string was badly formed. + * Tcl return code. * * Side effects: - * If interp is not NULL, stores an error message in the interpreter - * result. + * May store a Tcl_ObjType. * *---------------------------------------------------------------------- */ static int -SetEndOffsetFromAny( - Tcl_Interp *interp, /* Tcl interpreter or NULL */ - Tcl_Obj *objPtr) /* Pointer to the object to parse */ +GetEndOffsetFromObj( + Tcl_Obj *objPtr, /* Pointer to the object to parse */ + int endValue, /* The value to be stored at "indexPtr" if + * "objPtr" holds "end". */ + int *indexPtr) /* Location filled in with an integer + * representing an index. */ { - int offset; /* Offset in the "end-offset" expression */ - register const char *bytes; /* String rep of the object */ - int length; /* Length of the object's string rep */ + const Tcl_ObjIntRep *irPtr; - /* - * If it's already the right type, we're fine. - */ + while (NULL == (irPtr = Tcl_FetchIntRep(objPtr, &endOffsetType))) { + Tcl_ObjIntRep ir; + int length, offset = 0; + const char *bytes = TclGetStringFromObj(objPtr, &length); - if (objPtr->typePtr == &tclEndOffsetType) { - return TCL_OK; - } - - /* - * Check for a string rep of the right form. - */ - - bytes = TclGetStringFromObj(objPtr, &length); - if ((*bytes != 'e') || (strncmp(bytes, "end", - (size_t)((length > 3) ? 3 : length)) != 0)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be end?[+-]integer?", bytes)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); - } - return TCL_ERROR; - } - - /* - * Convert the string rep. - */ - - if (length <= 3) { - offset = 0; - } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { - /* - * This is our limited string expression evaluator. Pass everything - * after "end-" to Tcl_GetInt, then reverse for offset. - */ - - if (TclIsSpaceProc(bytes[4])) { - goto badIndexFormat; - } - if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { + if ((length == 4) || (*bytes != 'e') || (strncmp(bytes, "end", + (size_t)((length > 3) ? 3 : length)) != 0)) { return TCL_ERROR; } - if (bytes[3] == '-') { - offset = -offset; - } - } else { - /* - * Conversion failed. Report the error. - */ - - badIndexFormat: - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be end?[+-]integer?", bytes)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); + if (length > 4) { + if (((bytes[3] != '-') && (bytes[3] != '+')) + || (TclIsSpaceProc(bytes[4])) + || (TCL_OK != Tcl_GetInt(NULL, bytes+4, &offset))) { + return TCL_ERROR; + } + if (bytes[3] == '-') { + offset = -offset; + } } - return TCL_ERROR; + ir.longValue = offset; + Tcl_StoreIntRep(objPtr, &endOffsetType, &ir); } - - /* - * The conversion succeeded. Free the old internal rep and set the new - * one. - */ - - TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = offset; - objPtr->typePtr = &tclEndOffsetType; - + *indexPtr = endValue + irPtr->longValue; return TCL_OK; } diff --git a/tests/obj.test b/tests/obj.test index 7bf00f7..8f783fe 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -31,7 +31,6 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes bytecode cmdName dict - end-offset regexp string } { @@ -53,15 +52,6 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj { lappend result [testobj refcount 1] } {{} 12 12 bytearray 3} -test obj-3.1 {Tcl_ConvertToType error} testobj { - list [testdoubleobj set 1 12.34] \ - [catch {testobj convert 1 end-offset} msg] \ - $msg -} {12.34 1 {bad index "12.34": must be end?[+-]integer?}} -test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj { - list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg -} {{} 1 {bad index "": must be end?[+-]integer?}} - test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj { set result "" lappend result [testobj freeallvars] @@ -551,44 +541,6 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj { lappend result [testobj refcount 2] } {{} 1024 1024 int 4 4 0 int 3 2} - -test obj-31.1 {regenerate string rep of "end"} testobj { - testobj freeallvars - teststringobj set 1 end - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end -test obj-31.2 {regenerate string rep of "end-1"} testobj { - testobj freeallvars - teststringobj set 1 end-0x1 - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end-1 -test obj-31.3 {regenerate string rep of "end--1"} testobj { - testobj freeallvars - teststringobj set 1 end--0x1 - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end--1 -test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj { - testobj freeallvars - teststringobj set 1 end-0x7fffffff - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end-2147483647 -test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj { - testobj freeallvars - teststringobj set 1 end--0x7fffffff - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end--2147483647 -test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} { - testobj freeallvars - teststringobj set 1 end--0x80000000 - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end--2147483648 - test obj-32.1 {freeing very large object trees} { set x {} for {set i 0} {$i<100000} {incr i} { -- cgit v0.12 From 53c50e58bf25cab1fe612b66471ad13a0f3b6cf4 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 11 Apr 2016 17:46:20 +0000 Subject: Use static name for a static struct. --- generic/tclPathObj.c | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 99d576d..90a5ebe 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -35,7 +35,7 @@ static int MakePathFromNormalized(Tcl_Interp *interp, * internally. */ -static const Tcl_ObjType tclFsPathType = { +static const Tcl_ObjType fsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ @@ -563,7 +563,7 @@ TclPathPart( Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { - if (pathPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &fsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { @@ -872,7 +872,7 @@ TclJoinPath( */ if ((i == (elements-2)) && (i == 0) - && (elt->typePtr == &tclFsPathType) + && (elt->typePtr == &fsPathType) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) { Tcl_Obj *tailObj = objv[i+1]; @@ -1145,7 +1145,7 @@ Tcl_FSConvertToPathType( * path. */ - if (pathPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &fsPathType) { if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { return TCL_OK; } @@ -1172,7 +1172,7 @@ Tcl_FSConvertToPathType( * UpdateStringOfFsPath(pathPtr); * } * FreeFsPathInternalRep(pathPtr); - * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + * return Tcl_ConvertToType(interp, pathPtr, &fsPathType); * } * } * @@ -1309,7 +1309,7 @@ TclNewFSPathObj( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; - pathPtr->typePtr = &tclFsPathType; + pathPtr->typePtr = &fsPathType; pathPtr->bytes = NULL; pathPtr->length = 0; @@ -1412,7 +1412,7 @@ TclFSMakePathRelative( int cwdLen, len; const char *tempStr; - if (pathPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &fsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { @@ -1480,7 +1480,7 @@ MakePathFromNormalized( { FsPath *fsPathPtr; - if (pathPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &fsPathType) { return TCL_OK; } @@ -1525,7 +1525,7 @@ MakePathFromNormalized( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; + pathPtr->typePtr = &fsPathType; return TCL_OK; } @@ -1602,7 +1602,7 @@ Tcl_FSNewNativePath( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; + pathPtr->typePtr = &fsPathType; return pathPtr; } @@ -1656,7 +1656,7 @@ Tcl_FSGetTranslatedPath( retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); srcFsPathPtr->translatedPathPtr = retObj; - if (translatedCwdPtr->typePtr == &tclFsPathType) { + if (translatedCwdPtr->typePtr == &fsPathType) { srcFsPathPtr->filesystemEpoch = PATHOBJ(translatedCwdPtr)->filesystemEpoch; } else { @@ -1827,7 +1827,7 @@ Tcl_FSGetNormalizedPath( /* * NOTE: here we are (dangerously?) assuming that origDir points - * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The + * to a Tcl_Obj with Tcl_ObjType == &fsPathType. The * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); * above that set the pathType value should have established that, * but it's far less clear on what basis we know there's been no @@ -2152,7 +2152,7 @@ TclFSEnsureEpochOk( { FsPath *srcFsPathPtr; - if (pathPtr->typePtr != &tclFsPathType) { + if (pathPtr->typePtr != &fsPathType) { return TCL_OK; } @@ -2216,7 +2216,7 @@ TclFSSetPathDetails( * Make sure pathPtr is of the correct type. */ - if (pathPtr->typePtr != &tclFsPathType) { + if (pathPtr->typePtr != &fsPathType) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } @@ -2315,7 +2315,7 @@ SetFsPathFromAny( Tcl_Obj *transPtr; char *name; - if (pathPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &fsPathType) { return TCL_OK; } @@ -2477,7 +2477,7 @@ SetFsPathFromAny( TclFreeIntRep(pathPtr); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; + pathPtr->typePtr = &fsPathType; return TCL_OK; } @@ -2569,7 +2569,7 @@ DupFsPathInternalRep( copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - copyPtr->typePtr = &tclFsPathType; + copyPtr->typePtr = &fsPathType; } /* @@ -2642,7 +2642,7 @@ TclNativePathInFilesystem( * semantics of Tcl (at present anyway), so we have to abide by them here. */ - if (pathPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &fsPathType) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { /* * We reject the empty path "". @@ -2657,7 +2657,7 @@ TclNativePathInFilesystem( } else { /* * It is somewhat unusual to reach this code path without the object - * being of tclFsPathType. However, we do our best to deal with the + * being of fsPathType. However, we do our best to deal with the * situation. */ -- cgit v0.12 From 712675a74471cd7bac4f09430c1df7e6a1585e9a Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Apr 2016 18:02:45 +0000 Subject: Revise "dictIterator" objType to use proposed routines. --- generic/tclExecute.c | 37 ++++++++++++++++++++++++------------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 5fcde79..831ef6f 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -823,20 +823,22 @@ ReleaseDictIterator( { Tcl_DictSearch *searchPtr; Tcl_Obj *dictPtr; + const Tcl_ObjIntRep *irPtr; + + irPtr = Tcl_FetchIntRep(objPtr, &dictIteratorType); + assert(irPtr != NULL); /* * First kill the search, and then release the reference to the dictionary * that we were holding. */ - searchPtr = objPtr->internalRep.twoPtrValue.ptr1; + searchPtr = irPtr->twoPtrValue.ptr1; Tcl_DictObjDone(searchPtr); ckfree(searchPtr); - dictPtr = objPtr->internalRep.twoPtrValue.ptr2; + dictPtr = irPtr->twoPtrValue.ptr2; TclDecrRefCount(dictPtr); - - objPtr->typePtr = NULL; } /* @@ -7647,13 +7649,16 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - TclNewObj(statePtr); - statePtr->typePtr = &dictIteratorType; - statePtr->internalRep.twoPtrValue.ptr1 = searchPtr; - statePtr->internalRep.twoPtrValue.ptr2 = dictPtr; + { + Tcl_ObjIntRep ir; + TclNewObj(statePtr); + ir.twoPtrValue.ptr1 = searchPtr; + ir.twoPtrValue.ptr2 = dictPtr; + Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir); + } varPtr = LOCAL(opnd); if (varPtr->value.objPtr) { - if (varPtr->value.objPtr->typePtr == &dictIteratorType) { + if (Tcl_FetchIntRep(varPtr->value.objPtr, &dictIteratorType)) { Tcl_Panic("mis-issued dictFirst!"); } TclDecrRefCount(varPtr->value.objPtr); @@ -7666,11 +7671,17 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); statePtr = (*LOCAL(opnd)).value.objPtr; - if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) { - Tcl_Panic("mis-issued dictNext!"); + { + const Tcl_ObjIntRep *irPtr; + + if (statePtr && + (irPtr = Tcl_FetchIntRep(statePtr, &dictIteratorType))) { + searchPtr = irPtr->twoPtrValue.ptr1; + Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done); + } else { + Tcl_Panic("mis-issued dictNext!"); + } } - searchPtr = statePtr->internalRep.twoPtrValue.ptr1; - Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done); pushDictIteratorResult: if (done) { TclNewObj(emptyPtr); -- cgit v0.12 From 8819aab738e9e53aecbc69f4c3ce8c932241d387 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 22 Apr 2016 18:57:38 +0000 Subject: repair merge --- generic/tclAssembly.c | 3 ++- generic/tclCompile.h | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 3928956..9ea0b48 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -32,6 +32,7 @@ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" +#include /* * Structure that represents a range of instructions in the bytecode. @@ -4311,7 +4312,7 @@ static void FreeAssembleCodeInternalRep( Tcl_Obj *objPtr) { - ByteCode *codePtr = NULL; + ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr); assert(codePtr != NULL); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 86a9db0..f046091 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -514,6 +514,13 @@ typedef struct ByteCode { * created. */ #endif /* TCL_COMPILE_STATS */ } ByteCode; + +#define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), (typePtr)); \ + (codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) /* * Opcodes for the Tcl bytecode instructions. These must correspond to the -- cgit v0.12 From be804ed5e6133fd5a00a433f2c88c13dada0a8ee Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Apr 2016 20:04:12 +0000 Subject: Revise "assemblecode" Tcl_ObjType to proposed routines. --- generic/tclAssembly.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 1826fec..b07333a 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -845,15 +845,15 @@ CompileAssembleObj( const char* source; /* String representation of the source code */ int sourceLen; /* Length of the source code in bytes */ - /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ - if (objPtr->typePtr == &assembleCodeType) { + ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr); + + if (codePtr) { namespacePtr = iPtr->varFramePtr->nsPtr; - codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle == iPtr) && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == namespacePtr) -- cgit v0.12 From 2e23e829d9cd7ea52665d333482cedf5255464e5 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Apr 2016 20:20:33 +0000 Subject: Revise the "exprcode" Tcl_ObjType to proposed routines. --- generic/tclExecute.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 23337f4..9d8dd25 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1527,19 +1527,23 @@ CompileExprObj( * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ - if (objPtr->typePtr == &exprCodeType) { + + ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr); + + if (codePtr != NULL) { Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; - codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { TclFreeIntRep(objPtr); + codePtr = NULL; } } - if (objPtr->typePtr != &exprCodeType) { + + if (codePtr == NULL) { /* * TIP #280: No invoker (yet) - Expression compilation. */ -- cgit v0.12 From c22277cf6a24458c9ffd0fdbbf4aaa7229725a0b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Apr 2016 20:33:43 +0000 Subject: more revisions --- generic/tclCompile.c | 23 ++++++++++++++--------- generic/tclCompile.h | 10 ++++++++++ 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 96b418c..9485d98 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -967,7 +967,10 @@ static void FreeByteCodeInternalRep( register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; + + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); + assert(codePtr != NULL); TclReleaseByteCode(codePtr); } @@ -1297,10 +1300,11 @@ CompileSubstObj( Interp *iPtr = (Interp *) interp; ByteCode *codePtr = NULL; - if (objPtr->typePtr == &substCodeType) { + ByteCodeGetIntRep(objPtr, &subsCodeType, codePtr); + + if (codePtr != NULL) { Namespace *nsPtr = iPtr->varFramePtr->nsPtr; - codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) || ((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) @@ -1309,9 +1313,10 @@ CompileSubstObj( || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { TclFreeIntRep(objPtr); + codePtr = NULL; } } - if (objPtr->typePtr != &substCodeType) { + if (codePtr == NULL) { CompileEnv compEnv; int numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); @@ -1325,7 +1330,6 @@ CompileSubstObj( codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv); TclFreeCompileEnv(&compEnv); - objPtr->internalRep.twoPtrValue.ptr1 = codePtr; objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags); if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; @@ -1365,7 +1369,10 @@ static void FreeSubstCodeInternalRep( register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + register ByteCode *codePtr; + + ByteCodeGetIntRep(objPtr, &substCodeType, codePtr); + assert(codePtr != NULL); TclReleaseByteCode(codePtr); } @@ -2897,9 +2904,7 @@ TclInitByteCodeObj( * by making its internal rep point to the just compiled ByteCode. */ - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = codePtr; - objPtr->typePtr = typePtr; + ByteCodeSetIntRep(objPtr, typePtr, codePtr); return codePtr; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 502dcf8..2f7a180 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -515,6 +515,16 @@ typedef struct ByteCode { #endif /* TCL_COMPILE_STATS */ } ByteCode; +#define ByteCodeSetIntRep(objPtr, typePtr, codePtr) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (codePtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), (typePtr), &ir); \ + } while (0) + + + #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ -- cgit v0.12 From 9f2bd1e80f785a0de4aa8065bb5735acc4fb3da6 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Apr 2016 20:34:29 +0000 Subject: typo --- generic/tclCompile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 9485d98..8c2d703 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1300,7 +1300,7 @@ CompileSubstObj( Interp *iPtr = (Interp *) interp; ByteCode *codePtr = NULL; - ByteCodeGetIntRep(objPtr, &subsCodeType, codePtr); + ByteCodeGetIntRep(objPtr, &substCodeType, codePtr); if (codePtr != NULL) { Namespace *nsPtr = iPtr->varFramePtr->nsPtr; -- cgit v0.12 From 0d83fc1704c2c77276583d12c60a0c95dcf5c285 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 30 Apr 2016 17:47:40 +0000 Subject: More ByteCode revisions. --- generic/tclDisassemble.c | 30 +++++++++++++++++------------- generic/tclExecute.c | 12 +++++++----- generic/tclProc.c | 34 ++++++++++++++++++++++------------ 3 files changed, 46 insertions(+), 30 deletions(-) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 83e950a..ad4af5c 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -62,12 +62,6 @@ static const Tcl_ObjType instNameType = { (inst) = irPtr->longValue; \ } while (0) -/* - * How to get the bytecode out of a Tcl_Obj. - */ - -#define BYTECODE(objPtr) \ - ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1) /* *---------------------------------------------------------------------- @@ -262,15 +256,19 @@ DisassembleByteCodeObj( Tcl_Interp *interp, Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { - ByteCode *codePtr = BYTECODE(objPtr); + ByteCode *codePtr; unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line; - Interp *iPtr = (Interp *) *codePtr->interpHandle; + Interp *iPtr; Tcl_Obj *bufferObj, *fileObj; char ptrBuf1[20], ptrBuf2[20]; + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); + + iPtr = (Interp *) *codePtr->interpHandle; + TclNewObj(bufferObj); if (codePtr->refCount <= 0) { return bufferObj; /* Already freed. */ @@ -966,13 +964,15 @@ DisassembleByteCodeAsDicts( * procedure, if one exists. */ Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */ { - ByteCode *codePtr = BYTECODE(objPtr); + ByteCode *codePtr; Tcl_Obj *description, *literals, *variables, *instructions, *inst; Tcl_Obj *aux, *exn, *commands, *file; unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr; int codeOffset, codeLength, sourceOffset, sourceLength; int i, val, line; + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); + /* * Get the literals from the bytecode. */ @@ -1308,6 +1308,7 @@ Tcl_DisassembleObjCmd( Proc *procPtr = NULL; Tcl_HashEntry *hPtr; Object *oPtr; + ByteCode *codePtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "type ..."); @@ -1387,8 +1388,9 @@ Tcl_DisassembleObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } - if ((objv[2]->typePtr != &tclByteCodeType) - && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) { + + if ((NULL == Tcl_FetchIntRep(objv[2], &tclByteCodeType)) && (TCL_OK + != TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) { return TCL_ERROR; } codeObjPtr = objv[2]; @@ -1458,7 +1460,7 @@ Tcl_DisassembleObjCmd( "METHODTYPE", NULL); return TCL_ERROR; } - if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { + if (NULL == Tcl_FetchIntRep(procPtr->bodyPtr, &tclByteCodeType)) { Command cmd; /* @@ -1486,7 +1488,9 @@ Tcl_DisassembleObjCmd( * Do the actual disassembly. */ - if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) { + ByteCodeGetIntRep(codeObjPtr, &tclByteCodeType, codePtr); + + if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not disassemble prebuilt bytecode", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 9d8dd25..1afe259 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1644,7 +1644,9 @@ static void FreeExprCodeInternalRep( Tcl_Obj *objPtr) { - ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; + ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr); + assert(codePtr != NULL); TclReleaseByteCode(codePtr); } @@ -1682,7 +1684,8 @@ TclCompileObj( * compilation). Otherwise, check that it is "fresh" enough. */ - if (objPtr->typePtr == &tclByteCodeType) { + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); + if (codePtr != NULL) { /* * Make sure the Bytecode hasn't been invalidated by, e.g., someone * redefining a command with a compile procedure (this might make the @@ -1700,7 +1703,6 @@ TclCompileObj( * here. */ - codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) @@ -1828,7 +1830,7 @@ TclCompileObj( iPtr->invokeWord = word; TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); iPtr->invokeCmdFramePtr = NULL; - codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; @@ -10464,7 +10466,7 @@ EvalStatsCmd( for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { - if (entryPtr->objPtr->typePtr == &tclByteCodeType) { + if (NULL != Tcl_FetchIntRep(entryPtr->objPtr, &tclByteCodeType)) { numByteCodeLits++; } (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length); diff --git a/generic/tclProc.c b/generic/tclProc.c index 6307002..ef7ce13 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1196,10 +1196,10 @@ TclInitCompiledLocals( ByteCode *codePtr; bodyPtr = framePtr->procPtr->bodyPtr; - if (bodyPtr->typePtr != &tclByteCodeType) { + ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr); + if (codePtr == NULL) { Tcl_Panic("body object for proc attached to frame is not a byte code type"); } - codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; if (framePtr->numCompiledLocals) { if (!codePtr->localCachePtr) { @@ -1362,7 +1362,7 @@ InitLocalCache( Proc *procPtr) { Interp *iPtr = procPtr->iPtr; - ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; int localCt = procPtr->numCompiledLocals; int numArgs = procPtr->numArgs, i = 0; @@ -1372,6 +1372,8 @@ InitLocalCache( CompiledLocal *localPtr; int new; + ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); + /* * Cache the names and initial values of local variables; store the * cache in both the framePtr for this execution and in the codePtr @@ -1439,11 +1441,13 @@ InitArgsAndLocals( { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; register Proc *procPtr = framePtr->procPtr; - ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; register Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; + ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); + /* * Make sure that the local cache of variable names and initial values has * been initialised properly . @@ -1614,7 +1618,8 @@ TclPushProcCallFrame( * local variables are found while compiling. */ - if (procPtr->bodyPtr->typePtr == &tclByteCodeType) { + ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); + if (codePtr != NULL) { Interp *iPtr = (Interp *) interp; /* @@ -1626,7 +1631,6 @@ TclPushProcCallFrame( * commands and/or resolver changes are considered). */ - codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) @@ -1824,7 +1828,7 @@ TclNRInterpProcCore( */ procPtr->refCount++; - codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; + ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, NULL, NULL); @@ -1958,7 +1962,9 @@ TclProcCompileProc( { Interp *iPtr = (Interp *) interp; Tcl_CallFrame *framePtr; - ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; + + ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr); /* * If necessary, compile the procedure's body. The compiler will allocate @@ -1974,7 +1980,7 @@ TclProcCompileProc( * are not recompiled, even if things have changed. */ - if (bodyPtr->typePtr == &tclByteCodeType) { + if (codePtr != NULL) { if (((Interp *) *codePtr->interpHandle == iPtr) && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == nsPtr) @@ -1994,10 +2000,11 @@ TclProcCompileProc( codePtr->nsPtr = nsPtr; } else { TclFreeIntRep(bodyPtr); + codePtr = NULL; } } - if (bodyPtr->typePtr != &tclByteCodeType) { + if (codePtr == NULL) { Tcl_HashEntry *hePtr; #ifdef TCL_COMPILE_DEBUG @@ -2374,7 +2381,8 @@ ProcBodyDup( Tcl_Obj *srcPtr, /* Object to copy. */ Tcl_Obj *dupPtr) /* Target object for the duplication. */ { - Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1; + Proc *procPtr; + ProcGetIntRep(srcPtr, procPtr); ProcSetIntRep(dupPtr, procPtr); } @@ -2402,7 +2410,9 @@ static void ProcBodyFree( Tcl_Obj *objPtr) /* The object to clean up. */ { - Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; + Proc *procPtr; + + ProcGetIntRep(objPtr, procPtr); if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); -- cgit v0.12 From 6c3864d50e67e78a0f42fdf677ccba994a66dfe2 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 10 May 2016 17:22:14 +0000 Subject: Revise encodingType to use proposed routines. --- generic/tclEncoding.c | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 32055a3..b3ad1e4 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -279,6 +279,21 @@ static int Iso88591ToUtfProc(ClientData clientData, static const Tcl_ObjType encodingType = { "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL }; +#define EncodingSetIntRep(objPtr, encoding) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (encoding); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &encodingType, &ir); \ + } while (0) + +#define EncodingGetIntRep(objPtr, encoding) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep ((objPtr), &encodingType); \ + (encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + /* *---------------------------------------------------------------------- @@ -305,17 +320,16 @@ Tcl_GetEncodingFromObj( Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr) { + Tcl_Encoding encoding; const char *name = Tcl_GetString(objPtr); - if (objPtr->typePtr != &encodingType) { - Tcl_Encoding encoding = Tcl_GetEncoding(interp, name); - + EncodingGetIntRep(objPtr, encoding); + if (encoding == NULL) { + encoding = Tcl_GetEncoding(interp, name); if (encoding == NULL) { return TCL_ERROR; } - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = encoding; - objPtr->typePtr = &encodingType; + EncodingSetIntRep(objPtr, encoding); } *encodingPtr = Tcl_GetEncoding(NULL, name); return TCL_OK; @@ -335,8 +349,10 @@ static void FreeEncodingIntRep( Tcl_Obj *objPtr) { - Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1); - objPtr->typePtr = NULL; + Tcl_Encoding encoding; + + EncodingGetIntRep(objPtr, encoding); + Tcl_FreeEncoding(encoding); } /* @@ -354,8 +370,8 @@ DupEncodingIntRep( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes); - dupPtr->typePtr = &encodingType; + Tcl_Encoding encoding = Tcl_GetEncoding(NULL, srcPtr->bytes); + EncodingSetIntRep(dupPtr, encoding); } /* -- cgit v0.12 From 99a50b95e536053fe9adf6898ab92e00956e5744 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 28 Jun 2016 15:22:36 +0000 Subject: Unicode rep en Tcl_Obj length: int -> size_t --- generic/tcl.h | 6 ++-- generic/tclExecute.c | 9 +++-- generic/tclHash.c | 2 +- generic/tclObj.c | 2 +- generic/tclStringObj.c | 95 ++++++++++++++++++++++++-------------------------- generic/tclStringRep.h | 6 ++-- generic/tclTest.c | 2 +- generic/tclTestObj.c | 2 +- win/configure | 2 +- win/tcl.m4 | 2 +- 10 files changed, 64 insertions(+), 64 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index d59a378..a88beb1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -610,7 +610,7 @@ typedef struct Tcl_ObjType { */ typedef struct Tcl_Obj { - int refCount; /* When 0 the object will be freed. */ + size_t refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * must be followed by a null byte (i.e., at @@ -622,7 +622,7 @@ typedef struct Tcl_Obj { * should use Tcl_GetStringFromObj or * Tcl_GetString to get a pointer to the byte * array as a readonly value. */ - int length; /* The number of bytes at *bytes, not + size_t length; /* The number of bytes at *bytes, not * including the terminating null. */ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's @@ -1076,7 +1076,7 @@ struct Tcl_HashTable { typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - int nextIndex; /* Index of next bucket to be enumerated after + size_t nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 03ff73b..f69a59c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4877,7 +4877,8 @@ TEBCresume( { int index, numIndices, fromIdx, toIdx; - int nocase, match, length2, cflags, s1len, s2len; + int nocase, match, length2, cflags; + int s1len, s2len; const char *s1, *s2; case INST_LIST: @@ -5176,7 +5177,8 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); + s1 = TclGetString(valuePtr); + s1len = valuePtr->length; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); @@ -5194,7 +5196,8 @@ TEBCresume( do { Tcl_ListObjIndex(NULL, value2Ptr, i, &o); if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); + s2 = TclGetString(o); + s2len = o->length; } else { s2 = ""; s2len = 0; diff --git a/generic/tclHash.c b/generic/tclHash.c index 97a2fc6..b302029 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -432,7 +432,7 @@ Tcl_DeleteHashTable( { register Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - int i; + size_t i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; diff --git a/generic/tclObj.c b/generic/tclObj.c index d062211..4e7a208 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4486,7 +4486,7 @@ Tcl_RepresentationCmd( descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," " object pointer at %s", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", - objv[1]->refCount, ptrBuffer); + (int) objv[1]->refCount, ptrBuffer); if (objv[1]->typePtr) { sprintf(ptrBuffer, "%p:%p", diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c644cf5..bc4b35e 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -54,27 +54,27 @@ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int appendNumChars); + const Tcl_UniChar *unicode, size_t appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, size_t numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, size_t numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, int numBytes, - int numAppendChars); + const char *bytes, size_t numBytes, + size_t numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); -static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); -static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); +static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); +static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); static size_t UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); @@ -131,7 +131,7 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - int needed, + size_t needed, int flag) { /* @@ -143,7 +143,7 @@ GrowStringBuffer( String *stringPtr = GET_STRING(objPtr); char *ptr = NULL; - int attempt; + size_t attempt; if (objPtr->bytes == tclEmptyStringRep) { objPtr->bytes = NULL; @@ -182,7 +182,7 @@ GrowStringBuffer( static void GrowUnicodeBuffer( Tcl_Obj *objPtr, - int needed) + size_t needed) { /* * Pre-conditions: @@ -192,7 +192,7 @@ GrowUnicodeBuffer( */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); - int attempt; + size_t attempt; if (stringPtr->maxChars > 0) { /* @@ -209,10 +209,10 @@ GrowUnicodeBuffer( * overflow into invalid argument values for attempt. */ - unsigned int limit = STRING_MAXCHARS - needed; - unsigned int extra = needed - stringPtr->numChars + size_t limit = STRING_MAXCHARS - needed; + size_t extra = needed - stringPtr->numChars + TCL_MIN_UNICHAR_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); + size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; ptr = stringAttemptRealloc(stringPtr, attempt); @@ -510,7 +510,7 @@ Tcl_GetUniChar( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == (size_t)-1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -644,7 +644,7 @@ Tcl_GetRange( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == (size_t)-1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -990,12 +990,12 @@ SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { String *stringPtr; - if (numChars < 0) { + if (numChars == (size_t)-1) { numChars = UnicodeLength(unicode); } @@ -1071,7 +1071,7 @@ Tcl_AppendLimitedToObj( ellipsis = "..."; } toCopy = (bytes == NULL) ? limit - : Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; + : (size_t)(Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes); } /* @@ -1348,10 +1348,10 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - int appendNumChars) /* Number of chars of "unicode" to append. */ + size_t appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; - int numChars; + size_t numChars; if (appendNumChars < 0) { appendNumChars = UnicodeLength(unicode); @@ -1437,13 +1437,13 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - int numChars) /* Number of chars of "unicode" to convert. */ + size_t numChars) /* Number of chars of "unicode" to convert. */ { String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != -1) { + if (stringPtr->numChars != (size_t)-1) { stringPtr->numChars += numChars; } @@ -1478,7 +1478,7 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - int numBytes) /* Number of bytes of "bytes" to convert. */ + size_t numBytes) /* Number of bytes of "bytes" to convert. */ { String *stringPtr; @@ -1514,10 +1514,10 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - int numBytes) /* Number of bytes of "bytes" to append. */ + size_t numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; - int newLength, oldLength; + size_t newLength, oldLength; if (numBytes == 0) { return; @@ -1533,13 +1533,10 @@ AppendUtfToUtfRep( } oldLength = objPtr->length; newLength = numBytes + oldLength; - if (newLength < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { - int offset = -1; + size_t offset = (size_t)-1; /* * Protect against case where unicode points into the existing @@ -1563,7 +1560,7 @@ AppendUtfToUtfRep( * Relocate bytes if needed; see above. */ - if (offset >= 0) { + if (offset != (size_t)-1) { bytes = objPtr->bytes + offset; } } @@ -1572,7 +1569,7 @@ AppendUtfToUtfRep( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = (size_t)-1; stringPtr->hasUnicode = 0; if (bytes) { @@ -2730,8 +2727,8 @@ TclStringObjReverse( } if (objPtr->bytes) { - int numChars = stringPtr->numChars; - int numBytes = objPtr->length; + size_t numChars = stringPtr->numChars; + size_t numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (Tcl_IsShared(objPtr)) { @@ -2749,8 +2746,8 @@ TclStringObjReverse( * * Pass 1. Reverse the bytes of each multi-byte character. */ - int charCount = 0; - int bytesLeft = numBytes; + size_t charCount = 0; + size_t bytesLeft = numBytes; while (bytesLeft) { /* @@ -2810,17 +2807,17 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - int numBytes, - int numAppendChars) + size_t numBytes, + size_t numAppendChars) { String *stringPtr = GET_STRING(objPtr); - int needed, numOrigChars = 0; + size_t needed, numOrigChars = 0; Tcl_UniChar *dst; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == -1) { + if (numAppendChars == (size_t)-1) { TclNumUtfChars(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; @@ -2872,7 +2869,7 @@ DupStringInternalRep( String *copyStringPtr = NULL; #if COMPAT==0 - if (srcStringPtr->numChars == -1) { + if (srcStringPtr->numChars == (size_t)-1) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to @@ -2922,7 +2919,7 @@ DupStringInternalRep( * the string rep of the new object. */ - if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) { + if (srcStringPtr->hasUnicode && srcStringPtr->numChars+1 > 1) { /* * Copy the full allocation for the Unicode buffer. */ @@ -2991,7 +2988,7 @@ SetStringFromAny( * already in place at objPtr->bytes. */ - stringPtr->numChars = -1; + stringPtr->numChars = (size_t)-1; stringPtr->allocated = objPtr->length; stringPtr->maxChars = 0; stringPtr->hasUnicode = 0; @@ -3037,17 +3034,17 @@ static int ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int numChars) + size_t numChars) { /* * Pre-condition: this is the "string" Tcl_ObjType. */ - int i, origLength, size = 0; + size_t i, origLength, size = 0; char *dst; String *stringPtr = GET_STRING(objPtr); - if (numChars < 0) { + if (numChars == (size_t)-1) { numChars = UnicodeLength(unicode); } diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index db6f7e4..d71eefa 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -47,15 +47,15 @@ */ typedef struct { - int numChars; /* The number of chars in the string. -1 means + size_t numChars; /* The number of chars in the string. -1 means * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or * that the number of UTF bytes == the number * of chars. */ - int allocated; /* The amount of space actually allocated for + size_t allocated; /* The amount of space actually allocated for * the UTF string (minus 1 byte for the * termination char). */ - int maxChars; /* Max number of chars that can fit in the + size_t maxChars; /* Max number of chars that can fit in the * space allocated for the unicode array. */ int hasUnicode; /* Boolean determining whether the string has * a Unicode representation. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 1bb5f96..c83eb52 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6643,7 +6643,7 @@ TestHashSystemHashCmd( Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } - if (hash.numEntries != limit) { + if (hash.numEntries != (size_t)limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index adc6063..bdf20f8 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1242,7 +1242,7 @@ TeststringobjCmd( goto wrongNumArgs; } Tcl_SetLongObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) - ? varPtr[varIndex]->length : -1); + ? varPtr[varIndex]->length : (size_t)-1); break; case 5: /* length2 */ if (objc != 3) { diff --git a/win/configure b/win/configure index e99b1c5..21c60e4 100755 --- a/win/configure +++ b/win/configure @@ -4165,7 +4165,7 @@ $as_echo "using shared flags" >&6; } CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/tcl.m4 b/win/tcl.m4 index 6701b1e..4e9abba 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -727,7 +727,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= -- cgit v0.12 From 4139aa785c96f443c893c26e9d98fe3fa557d3ff Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Jun 2016 12:18:03 +0000 Subject: Make test-cases pass again --- generic/tclStringObj.c | 182 +++++++++++++++---------------------------------- generic/tclStringRep.h | 24 +++---- 2 files changed, 66 insertions(+), 140 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index bc4b35e..d7c4a6b 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -39,43 +39,34 @@ #include "tclStringRep.h" /* - * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5. - * This is an escape hatch in case the changes have some unexpected unwelcome - * impact on performance. If things go well, this mechanism can go away when - * post-8.6 development begins. - */ - -#define COMPAT 0 - -/* * Prototypes for functions defined later in this file: */ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t appendNumChars); + const Tcl_UniChar *unicode, int appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); + const Tcl_UniChar *unicode, int numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes); + const char *bytes, int numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes); + const char *bytes, int numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); + const Tcl_UniChar *unicode, int numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes, - size_t numAppendChars); + const char *bytes, int numBytes, + int numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); -static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); -static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); +static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); +static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); -static size_t UnicodeLength(const Tcl_UniChar *unicode); + const Tcl_UniChar *unicode, int numChars); +static size_t UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* @@ -131,7 +122,7 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - size_t needed, + int needed, int flag) { /* @@ -143,7 +134,7 @@ GrowStringBuffer( String *stringPtr = GET_STRING(objPtr); char *ptr = NULL; - size_t attempt; + int attempt; if (objPtr->bytes == tclEmptyStringRep) { objPtr->bytes = NULL; @@ -182,7 +173,7 @@ GrowStringBuffer( static void GrowUnicodeBuffer( Tcl_Obj *objPtr, - size_t needed) + int needed) { /* * Pre-conditions: @@ -192,7 +183,7 @@ GrowUnicodeBuffer( */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); - size_t attempt; + int attempt; if (stringPtr->maxChars > 0) { /* @@ -200,7 +191,7 @@ GrowUnicodeBuffer( */ attempt = 2 * needed; - if (attempt >= 0 && attempt <= STRING_MAXCHARS) { + if ((size_t)attempt <= STRING_MAXCHARS) { ptr = stringAttemptRealloc(stringPtr, attempt); } if (ptr == NULL) { @@ -209,10 +200,10 @@ GrowUnicodeBuffer( * overflow into invalid argument values for attempt. */ - size_t limit = STRING_MAXCHARS - needed; - size_t extra = needed - stringPtr->numChars + unsigned int limit = STRING_MAXCHARS - needed; + unsigned int extra = needed - stringPtr->numChars + TCL_MIN_UNICHAR_GROWTH; - size_t growth = (extra > limit) ? limit : extra; + int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; ptr = stringAttemptRealloc(stringPtr, attempt); @@ -445,18 +436,6 @@ Tcl_GetCharLength( if (numChars == (size_t)-1) { TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; - -#if COMPAT - if (numChars < objPtr->length) { - /* - * Since we've just computed the number of chars, and not all UTF - * chars are 1-byte long, go ahead and populate the unicode - * string. - */ - - FillUnicodeRep(objPtr); - } -#endif } return numChars; } @@ -510,7 +489,7 @@ Tcl_GetUniChar( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == (size_t)-1) { + if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -644,7 +623,7 @@ Tcl_GetRange( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == (size_t)-1) { + if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -977,7 +956,7 @@ UnicodeLength( size_t numChars = 0; if (unicode) { - while (numChars >= 0 && unicode[numChars] != 0) { + while (numChars <= STRING_MAXCHARS && unicode[numChars] != 0) { numChars++; } } @@ -990,12 +969,12 @@ SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - size_t numChars) /* Number of characters in the unicode + int numChars) /* Number of characters in the unicode * string. */ { String *stringPtr; - if (numChars == (size_t)-1) { + if (numChars < 0) { numChars = UnicodeLength(unicode); } @@ -1071,7 +1050,7 @@ Tcl_AppendLimitedToObj( ellipsis = "..."; } toCopy = (bytes == NULL) ? limit - : (size_t)(Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes); + : Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; } /* @@ -1173,11 +1152,7 @@ Tcl_AppendUnicodeToObj( * objPtr's string rep. */ - if (stringPtr->hasUnicode -#if COMPAT - && stringPtr->numChars > 0 -#endif - ) { + if (stringPtr->hasUnicode) { AppendUnicodeToUnicodeRep(objPtr, unicode, length); } else { AppendUnicodeToUtfRep(objPtr, unicode, length); @@ -1281,11 +1256,7 @@ Tcl_AppendObjToObj( * appendObjPtr and append it. */ - if (stringPtr->hasUnicode -#if COMPAT - && stringPtr->numChars > 0 -#endif - ) { + if (stringPtr->hasUnicode) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ @@ -1318,11 +1289,7 @@ Tcl_AppendObjToObj( AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0 -#if COMPAT - && appendNumChars == length -#endif - ) { + if (numChars >= 0 && appendNumChars >= 0) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1348,10 +1315,10 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - size_t appendNumChars) /* Number of chars of "unicode" to append. */ + int appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; - size_t numChars; + int numChars; if (appendNumChars < 0) { appendNumChars = UnicodeLength(unicode); @@ -1437,23 +1404,15 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - size_t numChars) /* Number of chars of "unicode" to convert. */ + int numChars) /* Number of chars of "unicode" to convert. */ { String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != (size_t)-1) { + if (stringPtr->numChars != -1) { stringPtr->numChars += numChars; } - -#if COMPAT - /* - * Invalidate the unicode rep. - */ - - stringPtr->hasUnicode = 0; -#endif } /* @@ -1478,7 +1437,7 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - size_t numBytes) /* Number of bytes of "bytes" to convert. */ + int numBytes) /* Number of bytes of "bytes" to convert. */ { String *stringPtr; @@ -1514,10 +1473,10 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - size_t numBytes) /* Number of bytes of "bytes" to append. */ + int numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; - size_t newLength, oldLength; + int newLength, oldLength; if (numBytes == 0) { return; @@ -1533,10 +1492,13 @@ AppendUtfToUtfRep( } oldLength = objPtr->length; newLength = numBytes + oldLength; + if (newLength < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { - size_t offset = (size_t)-1; + int offset = -1; /* * Protect against case where unicode points into the existing @@ -1560,7 +1522,7 @@ AppendUtfToUtfRep( * Relocate bytes if needed; see above. */ - if (offset != (size_t)-1) { + if (offset >= 0) { bytes = objPtr->bytes + offset; } } @@ -1569,7 +1531,7 @@ AppendUtfToUtfRep( * Invalidate the unicode data. */ - stringPtr->numChars = (size_t)-1; + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; if (bytes) { @@ -2727,8 +2689,8 @@ TclStringObjReverse( } if (objPtr->bytes) { - size_t numChars = stringPtr->numChars; - size_t numBytes = objPtr->length; + int numChars = stringPtr->numChars; + int numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (Tcl_IsShared(objPtr)) { @@ -2746,8 +2708,8 @@ TclStringObjReverse( * * Pass 1. Reverse the bytes of each multi-byte character. */ - size_t charCount = 0; - size_t bytesLeft = numBytes; + int charCount = 0; + int bytesLeft = numBytes; while (bytesLeft) { /* @@ -2807,17 +2769,17 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - size_t numBytes, - size_t numAppendChars) + int numBytes, + int numAppendChars) { String *stringPtr = GET_STRING(objPtr); - size_t needed, numOrigChars = 0; + int needed, numOrigChars = 0; Tcl_UniChar *dst; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == (size_t)-1) { + if (numAppendChars == -1) { TclNumUtfChars(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; @@ -2868,8 +2830,7 @@ DupStringInternalRep( String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; -#if COMPAT==0 - if (srcStringPtr->numChars == (size_t)-1) { + if (srcStringPtr->numChars == -1) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to @@ -2911,41 +2872,6 @@ DupStringInternalRep( */ copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; -#else /* COMPAT!=0 */ - /* - * If the src obj is a string of 1-byte Utf chars, then copy the string - * rep of the source object and create an "empty" Unicode internal rep for - * the new object. Otherwise, copy Unicode internal rep, and invalidate - * the string rep of the new object. - */ - - if (srcStringPtr->hasUnicode && srcStringPtr->numChars+1 > 1) { - /* - * Copy the full allocation for the Unicode buffer. - */ - - copyStringPtr = stringAlloc(srcStringPtr->maxChars); - copyStringPtr->maxChars = srcStringPtr->maxChars; - memcpy(copyStringPtr->unicode, srcStringPtr->unicode, - srcStringPtr->numChars * sizeof(Tcl_UniChar)); - copyStringPtr->unicode[srcStringPtr->numChars] = 0; - copyStringPtr->allocated = 0; - } else { - copyStringPtr = stringAlloc(0); - copyStringPtr->unicode[0] = 0; - copyStringPtr->maxChars = 0; - - /* - * Tricky point: the string value was copied by generic object - * management code, so it doesn't contain any extra bytes that might - * exist in the source object. - */ - - copyStringPtr->allocated = copyPtr->length; - } - copyStringPtr->numChars = srcStringPtr->numChars; - copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; -#endif /* COMPAT==0 */ SET_STRING(copyPtr, copyStringPtr); copyPtr->typePtr = &tclStringType; @@ -2988,7 +2914,7 @@ SetStringFromAny( * already in place at objPtr->bytes. */ - stringPtr->numChars = (size_t)-1; + stringPtr->numChars = -1; stringPtr->allocated = objPtr->length; stringPtr->maxChars = 0; stringPtr->hasUnicode = 0; @@ -3034,17 +2960,17 @@ static int ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - size_t numChars) + int numChars) { /* * Pre-condition: this is the "string" Tcl_ObjType. */ - size_t i, origLength, size = 0; + int i, origLength, size = 0; char *dst; String *stringPtr = GET_STRING(objPtr); - if (numChars == (size_t)-1) { + if (numChars < 0) { numChars = UnicodeLength(unicode); } diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index d71eefa..a11f25a 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -47,15 +47,15 @@ */ typedef struct { - size_t numChars; /* The number of chars in the string. -1 means + int numChars; /* The number of chars in the string. -1 means * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or * that the number of UTF bytes == the number * of chars. */ - size_t allocated; /* The amount of space actually allocated for + int allocated; /* The amount of space actually allocated for * the UTF string (minus 1 byte for the * termination char). */ - size_t maxChars; /* Max number of chars that can fit in the + int maxChars; /* Max number of chars that can fit in the * space allocated for the unicode array. */ int hasUnicode; /* Boolean determining whether the string has * a Unicode representation. */ @@ -65,24 +65,24 @@ typedef struct { } String; #define STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) + (((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) #define STRING_SIZE(numChars) \ (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar))) #define stringCheckLimits(numChars) \ - do { \ - if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ + do { \ + if ((size_t)(numChars) > STRING_MAXCHARS) { \ Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ - STRING_MAXCHARS); \ - } \ + (int)STRING_MAXCHARS); \ + } \ } while (0) #define stringAttemptAlloc(numChars) \ - (String *) attemptckalloc((unsigned) STRING_SIZE(numChars)) + (String *) attemptckalloc(STRING_SIZE(numChars) ) #define stringAlloc(numChars) \ - (String *) ckalloc((unsigned) STRING_SIZE(numChars)) + (String *) ckalloc(STRING_SIZE(numChars) ) #define stringRealloc(ptr, numChars) \ - (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars)) + (String *) ckrealloc((ptr), STRING_SIZE(numChars) ) #define stringAttemptRealloc(ptr, numChars) \ - (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars)) + (String *) attemptckrealloc((ptr), STRING_SIZE(numChars) ) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ -- cgit v0.12 From 00d621dfe020361619908f37ab7f1f9df5c117cb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Jun 2016 12:33:23 +0000 Subject: Take over tclStringObj.c from trunk (not all changes there landed in novem) --- generic/tclStringObj.c | 87 +++----------------------------------------------- 1 file changed, 5 insertions(+), 82 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index bf67f18..b480735 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -39,15 +39,6 @@ #include "tclStringRep.h" /* - * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5. - * This is an escape hatch in case the changes have some unexpected unwelcome - * impact on performance. If things go well, this mechanism can go away when - * post-8.6 development begins. - */ - -#define COMPAT 0 - -/* * Prototypes for functions defined later in this file: */ @@ -445,18 +436,6 @@ Tcl_GetCharLength( if (numChars == -1) { TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; - -#if COMPAT - if (numChars < objPtr->length) { - /* - * Since we've just computed the number of chars, and not all UTF - * chars are 1-byte long, go ahead and populate the unicode - * string. - */ - - FillUnicodeRep(objPtr); - } -#endif } return numChars; } @@ -1173,11 +1152,7 @@ Tcl_AppendUnicodeToObj( * objPtr's string rep. */ - if (stringPtr->hasUnicode -#if COMPAT - && stringPtr->numChars > 0 -#endif - ) { + if (stringPtr->hasUnicode) { AppendUnicodeToUnicodeRep(objPtr, unicode, length); } else { AppendUnicodeToUtfRep(objPtr, unicode, length); @@ -1281,11 +1256,7 @@ Tcl_AppendObjToObj( * appendObjPtr and append it. */ - if (stringPtr->hasUnicode -#if COMPAT - && stringPtr->numChars > 0 -#endif - ) { + if (stringPtr->hasUnicode) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ @@ -1318,11 +1289,7 @@ Tcl_AppendObjToObj( AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0 -#if COMPAT - && appendNumChars == length -#endif - ) { + if (numChars >= 0 && appendNumChars >= 0) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1446,14 +1413,6 @@ AppendUnicodeToUtfRep( if (stringPtr->numChars != -1) { stringPtr->numChars += numChars; } - -#if COMPAT - /* - * Invalidate the unicode rep. - */ - - stringPtr->hasUnicode = 0; -#endif } /* @@ -2041,7 +2000,7 @@ Tcl_AppendFormatToObj( const char *bytes; if (useShort) { - pure = Tcl_NewLongObj((long) s); + pure = Tcl_NewIntObj((int) s); } else if (useWide) { pure = Tcl_NewWideIntObj(w); } else if (useBig) { @@ -2515,7 +2474,7 @@ AppendPrintfToObjVA( break; case '*': lastNum = (int) va_arg(argList, int); - Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(lastNum)); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum)); p++; break; case '0': case '1': case '2': case '3': case '4': @@ -2871,7 +2830,6 @@ DupStringInternalRep( String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; -#if COMPAT==0 if (srcStringPtr->numChars == -1) { /* * The String struct in the source value holds zero useful data. Don't @@ -2914,41 +2872,6 @@ DupStringInternalRep( */ copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; -#else /* COMPAT!=0 */ - /* - * If the src obj is a string of 1-byte Utf chars, then copy the string - * rep of the source object and create an "empty" Unicode internal rep for - * the new object. Otherwise, copy Unicode internal rep, and invalidate - * the string rep of the new object. - */ - - if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) { - /* - * Copy the full allocation for the Unicode buffer. - */ - - copyStringPtr = stringAlloc(srcStringPtr->maxChars); - copyStringPtr->maxChars = srcStringPtr->maxChars; - memcpy(copyStringPtr->unicode, srcStringPtr->unicode, - srcStringPtr->numChars * sizeof(Tcl_UniChar)); - copyStringPtr->unicode[srcStringPtr->numChars] = 0; - copyStringPtr->allocated = 0; - } else { - copyStringPtr = stringAlloc(0); - copyStringPtr->unicode[0] = 0; - copyStringPtr->maxChars = 0; - - /* - * Tricky point: the string value was copied by generic object - * management code, so it doesn't contain any extra bytes that might - * exist in the source object. - */ - - copyStringPtr->allocated = copyPtr->length; - } - copyStringPtr->numChars = srcStringPtr->numChars; - copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; -#endif /* COMPAT==0 */ SET_STRING(copyPtr, copyStringPtr); copyPtr->typePtr = &tclStringType; -- cgit v0.12 From 4d9fc11c2ffbcc95218111734c64397df0dfcf63 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Jul 2016 10:09:07 +0000 Subject: Make epoch in ProcessGlobalValue a size_t --- generic/tclInt.h | 2 +- generic/tclUtil.c | 9 ++++----- win/configure | 2 +- win/tcl.m4 | 2 +- 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 4d494e3..c232cad 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2538,7 +2538,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, */ typedef struct ProcessGlobalValue { - int epoch; /* Epoch counter to detect changes in the + size_t epoch; /* Epoch counter to detect changes in the * master value. */ size_t numBytes; /* Length of the master string. */ char *value; /* The master string value. */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9523ed6..2cc0fbc 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3835,7 +3835,7 @@ TclSetProcessGlobalValue( Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); - hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); + hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } @@ -3861,7 +3861,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - int epoch = pgvPtr->epoch; + size_t epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -3876,8 +3876,7 @@ TclGetProcessGlobalValue( Tcl_DString native, newValue; Tcl_MutexLock(&pgvPtr->mutex); - pgvPtr->epoch++; - epoch = pgvPtr->epoch; + epoch = ++pgvPtr->epoch; Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value, pgvPtr->numBytes, &native); Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), @@ -3929,7 +3928,7 @@ TclGetProcessGlobalValue( value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, - INT2PTR(pgvPtr->epoch), &dummy); + (void *)(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); diff --git a/win/configure b/win/configure index 21c60e4..e99b1c5 100755 --- a/win/configure +++ b/win/configure @@ -4165,7 +4165,7 @@ $as_echo "using shared flags" >&6; } CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/tcl.m4 b/win/tcl.m4 index 4e9abba..6701b1e 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -727,7 +727,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= -- cgit v0.12 From abd0c671e89b50f8a2a7ecc77e083ebe6dad73e6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Jul 2016 15:10:01 +0000 Subject: Unnecessary #undef and unnecessary type cast. --- generic/tcl.h | 2 -- unix/dltest/pkgua.c | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 03fe564..aaef7c6 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2359,10 +2359,8 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * hash tables: */ -#undef Tcl_FindHashEntry #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) -#undef Tcl_CreateHashEntry #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 9bc78ff..ea5fde5 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -89,7 +89,7 @@ PkguaDeleteTokens( Tcl_Interp *interp) { Tcl_HashEntry *entryPtr = - Tcl_FindHashEntry(&interpTokenMap, (char *) interp); + Tcl_FindHashEntry(&interpTokenMap, interp); if (entryPtr) { Tcl_Free((char *) Tcl_GetHashValue(entryPtr)); -- cgit v0.12 From 276fee0021d4a330665cee2e7d874ee4ffecf35b Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 7 Jul 2016 17:00:01 +0000 Subject: Fully fix old bug [a16752c252] that has been only partially fixed until now to support legacy tclcompiler binaries. That no longer makes sense for Tcl 9. --- generic/tclBasic.c | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8c9b717..456b6ad 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2226,27 +2226,8 @@ Tcl_CreateObjCommand( if (!isNew) { cmdPtr = Tcl_GetHashValue(hPtr); - /* Command already exists. */ - - /* - * [***] This is wrong. See Tcl Bug a16752c252. - * However, this buggy behavior is kept under particular - * circumstances to accommodate deployed binaries of the - * "tclcompiler" program. http://sourceforge.net/projects/tclpro/ - * that crash if the bug is fixed. - */ - - if (cmdPtr->objProc == TclInvokeStringCommand - && cmdPtr->clientData == clientData - && cmdPtr->deleteData == clientData - && cmdPtr->deleteProc == deleteProc) { - cmdPtr->objProc = proc; - cmdPtr->objClientData = clientData; - return (Tcl_Command) cmdPtr; - } - /* - * Otherwise, we delete the old command. Be careful to preserve any + * Command already exists; delete it. Be careful to preserve any * existing import links so we can restore them down below. That way, * you can redefine a command and its import status will remain * intact. -- cgit v0.12 From 26562de08390bae627d1602206683fae653f0c25 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Jul 2016 06:56:17 +0000 Subject: Adapt hash-function and hash-table to allow hash-tables to grow >1Gb on 64-bit platforms. --- doc/Hash.3 | 4 +-- generic/tcl.h | 28 +++++++-------- generic/tclAssembly.c | 2 +- generic/tclDictObj.c | 2 +- generic/tclEnsemble.c | 2 +- generic/tclHash.c | 99 +++++++++++++++++++++++++++------------------------ generic/tclInt.h | 2 +- generic/tclLiteral.c | 8 ++--- generic/tclOOInt.h | 2 +- generic/tclObj.c | 12 +++---- generic/tclTest.c | 4 +-- generic/tclVar.c | 2 +- unix/dltest/pkgua.c | 2 +- 13 files changed, 87 insertions(+), 82 deletions(-) diff --git a/doc/Hash.3 b/doc/Hash.3 index 4dc3623..a7d644f 100644 --- a/doc/Hash.3 +++ b/doc/Hash.3 @@ -259,7 +259,7 @@ typedef struct Tcl_HashKeyType { .PP The \fIversion\fR member is the version of the table. If this structure is extended in future then the version can be used to distinguish between -different structures. It should be set to \fBTCL_HASH_KEY_TYPE_VERSION\fR. +different structures. It should be set to \fBTCL_HASH_KEY_TYPE_VERSION_2\fR. .PP The \fIflags\fR member is 0 or one or more of the following values OR'ed together: @@ -281,7 +281,7 @@ The \fIhashKeyProc\fR member contains the address of a function called to calculate a hash value for the key. .PP .CS -typedef unsigned int \fBTcl_HashKeyProc\fR( +typedef size_t \fBTcl_HashKeyProc\fR( Tcl_HashTable *\fItablePtr\fR, void *\fIkeyPtr\fR); .CE diff --git a/generic/tcl.h b/generic/tcl.h index aaef7c6..cf43ff0 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -940,7 +940,7 @@ typedef struct Tcl_HashKeyType Tcl_HashKeyType; typedef struct Tcl_HashTable Tcl_HashTable; typedef struct Tcl_HashEntry Tcl_HashEntry; -typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr); +typedef size_t (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr); typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr); typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr, void *keyPtr); @@ -955,13 +955,11 @@ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ - void *hash; /* Hash value, stored as pointer to ensure - * that the offsets of the fields in this - * structure are not changed. */ + size_t hash; /* Hash value */ ClientData clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ - char *oneWordValue; /* One-word value for key. */ + const void *oneWordValue; /* One-word value for key. */ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */ int words[1]; /* Multiple integer words for key. The actual * size will be as large as necessary for this @@ -994,6 +992,8 @@ struct Tcl_HashEntry { */ #define TCL_HASH_KEY_TYPE_VERSION 1 +#define TCL_HASH_KEY_TYPE_VERSION_2 2 + struct Tcl_HashKeyType { int version; /* Version of the table. If this structure is * extended in future then the version can be @@ -1046,23 +1046,23 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ + size_t mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ - int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the * number of ints that is the size of the * key. */ - Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key); - Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key, + Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const void *key); + Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); const Tcl_HashKeyType *typePtr; /* Type of the keys used in the @@ -1076,7 +1076,7 @@ struct Tcl_HashTable { typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - int nextIndex; /* Index of next bucket to be enumerated after + size_t nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ @@ -2360,9 +2360,9 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ #define Tcl_FindHashEntry(tablePtr, key) \ - (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) + (*((tablePtr)->findProc))(tablePtr, key) #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ - (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) + (*((tablePtr)->createProc))(tablePtr, key, newPtr) /* *---------------------------------------------------------------------------- diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 8dd23a0..2116f2b 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -2884,7 +2884,7 @@ CheckJumpTableLabels( valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", - (char*) Tcl_GetHashKey(symHash, symEntryPtr), + Tcl_GetHashKey(symHash, symEntryPtr), Tcl_GetString(symbolObj), (valEntryPtr != NULL)); if (valEntryPtr == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index c172df0..e37dcb6 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -179,7 +179,7 @@ const Tcl_ObjType tclDictType = { */ static const Tcl_HashKeyType chainHashType = { - TCL_HASH_KEY_TYPE_VERSION, + TCL_HASH_KEY_TYPE_VERSION_2, 0, TclHashObjKey, TclCompareObjKeys, diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index a829b59..8f31318 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1931,7 +1931,7 @@ NsEnsembleImplementationCmdNR( if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { - int i; + size_t i; for (i=0 ; isubcommandTable.numEntries-1 ; i++) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); diff --git a/generic/tclHash.c b/generic/tclHash.c index 27919c5..f0d71d3 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -36,7 +36,7 @@ static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); +static size_t HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Prototypes for the one word hash key methods. Not actually declared because @@ -48,7 +48,7 @@ static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr); +static size_t HashOneWordKey(Tcl_HashTable *tablePtr, const void *keyPtr); #endif /* @@ -58,22 +58,22 @@ static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr); static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static unsigned int HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); +static size_t HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Function prototypes for static functions in this file: */ -static Tcl_HashEntry * BogusFind(Tcl_HashTable *tablePtr, const char *key); -static Tcl_HashEntry * BogusCreate(Tcl_HashTable *tablePtr, const char *key, +static Tcl_HashEntry * BogusFind(Tcl_HashTable *tablePtr, const void *key); +static Tcl_HashEntry * BogusCreate(Tcl_HashTable *tablePtr, const void *key, int *newPtr); -static Tcl_HashEntry * CreateHashEntry(Tcl_HashTable *tablePtr, const char *key, +static Tcl_HashEntry * CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr); -static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key); +static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const void *key); static void RebuildTable(Tcl_HashTable *tablePtr); const Tcl_HashKeyType tclArrayHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_TYPE_VERSION_2, /* version */ TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ HashArrayKey, /* hashKeyProc */ CompareArrayKeys, /* compareKeysProc */ @@ -82,7 +82,7 @@ const Tcl_HashKeyType tclArrayHashKeyType = { }; const Tcl_HashKeyType tclOneWordHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_TYPE_VERSION_2, /* version */ 0, /* flags */ NULL, /* HashOneWordKey, */ /* hashProc */ NULL, /* CompareOneWordKey, */ /* compareProc */ @@ -91,7 +91,7 @@ const Tcl_HashKeyType tclOneWordHashKeyType = { }; const Tcl_HashKeyType tclStringHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_TYPE_VERSION_2, /* version */ 0, /* flags */ HashStringKey, /* hashKeyProc */ CompareStringKeys, /* compareKeysProc */ @@ -206,7 +206,7 @@ Tcl_InitCustomHashTable( static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key) /* Key to use to find matching entry. */ + const void *key) /* Key to use to find matching entry. */ { return CreateHashEntry(tablePtr, key, NULL); } @@ -236,15 +236,15 @@ FindHashEntry( static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key, /* Key to use to find or create matching + const void *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { register Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; - unsigned int hash; - int index; + size_t hash; + size_t index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -258,14 +258,19 @@ CreateHashEntry( } if (typePtr->hashKeyProc) { - hash = typePtr->hashKeyProc(tablePtr, (void *) key); + if (typePtr->version == TCL_HASH_KEY_TYPE_VERSION) { + hash = ((unsigned int (*)(Tcl_HashTable *, void *)) + typePtr->hashKeyProc)(tablePtr, (void *) key); + } else { + hash = typePtr->hashKeyProc(tablePtr, (void *) key); + } if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hash); } else { index = hash & tablePtr->mask; } } else { - hash = PTR2UINT(key); + hash = (size_t)(key); index = RANDOM_INDEX(tablePtr, hash); } @@ -278,7 +283,7 @@ CreateHashEntry( for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) { @@ -291,7 +296,7 @@ CreateHashEntry( } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (key == hPtr->key.oneWordValue) { @@ -316,12 +321,12 @@ CreateHashEntry( hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); } else { hPtr = ckalloc(sizeof(Tcl_HashEntry)); - hPtr->key.oneWordValue = (char *) key; + hPtr->key.oneWordValue = key; hPtr->clientData = 0; } hPtr->tablePtr = tablePtr; - hPtr->hash = UINT2PTR(hash); + hPtr->hash = hash; hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; tablePtr->numEntries++; @@ -363,7 +368,7 @@ Tcl_DeleteHashEntry( const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; - int index; + size_t index; tablePtr = entryPtr->tablePtr; @@ -380,9 +385,9 @@ Tcl_DeleteHashEntry( if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); + index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -432,7 +437,7 @@ Tcl_DeleteHashTable( { register Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - int i; + size_t i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -581,7 +586,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; register Tcl_HashEntry *hPtr; char *result, *p; @@ -616,16 +621,16 @@ Tcl_HashStats( */ result = ckalloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%d entries in table, %d buckets\n", - tablePtr->numEntries, tablePtr->numBuckets); + sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n", + (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", - i, count[i]); + sprintf(p, "number of buckets with %d entries: %" TCL_LL_MODIFIER "d\n", + (int)i, (Tcl_WideInt)count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %d\n", - NUM_COUNTERS, overflow); + sprintf(p, "number of buckets with %d or more entries: %" TCL_LL_MODIFIER "d\n", + NUM_COUNTERS, (Tcl_WideInt)overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); return result; @@ -656,7 +661,7 @@ AllocArrayEntry( register int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; - unsigned int size; + size_t size; count = tablePtr->keyType; @@ -731,13 +736,13 @@ CompareArrayKeys( *---------------------------------------------------------------------- */ -static unsigned int +static size_t HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { register const int *array = (const int *) keyPtr; - register unsigned int result; + register size_t result; int count; for (result = 0, count = tablePtr->keyType; count > 0; @@ -768,9 +773,9 @@ AllocStringEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { - const char *string = (const char *) keyPtr; + const char *string = keyPtr; Tcl_HashEntry *hPtr; - unsigned int size, allocsize; + size_t size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { @@ -804,8 +809,8 @@ CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register const char *p1 = (const char *) keyPtr; - register const char *p2 = (const char *) hPtr->key.string; + register const char *p1 = keyPtr; + register const char *p2 = hPtr->key.string; return !strcmp(p1, p2); } @@ -827,13 +832,13 @@ CompareStringKeys( *---------------------------------------------------------------------- */ -static unsigned +static size_t HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { register const char *string = keyPtr; - register unsigned int result; + register size_t result; register char c; /* @@ -897,7 +902,7 @@ HashStringKey( static Tcl_HashEntry * BogusFind( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key) /* Key to use to find matching entry. */ + const void *key) /* Key to use to find matching entry. */ { Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry"); return NULL; @@ -924,7 +929,7 @@ BogusFind( static Tcl_HashEntry * BogusCreate( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key, /* Key to use to find or create matching + const void *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ @@ -955,7 +960,7 @@ static void RebuildTable( register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - int oldSize, count, index; + size_t oldSize, count, index; Tcl_HashEntry **oldBuckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; @@ -982,8 +987,8 @@ RebuildTable( tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned) - (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0); + tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc( + tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0); } else { tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); @@ -1005,9 +1010,9 @@ RebuildTable( *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); + index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = PTR2UINT(hPtr->hash) & tablePtr->mask; + index = hPtr->hash & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; diff --git a/generic/tclInt.h b/generic/tclInt.h index 9b01fd8..762943b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3898,7 +3898,7 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); -MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); +MODULE_SCOPE size_t TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 03200ca..306e426 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -31,7 +31,7 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static unsigned HashString(const char *string, int length); +static size_t HashString(const char *string, size_t length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -864,12 +864,12 @@ TclReleaseLiteral( *---------------------------------------------------------------------- */ -static unsigned +static size_t HashString( register const char *string, /* String for which to compute hash value. */ - int length) /* Number of bytes in the string. */ + size_t length) /* Number of bytes in the string. */ { - register unsigned int result = 0; + register size_t result = 0; /* * I tried a zillion different hash functions and asked many other people diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index b75ffdb..cda1826 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -563,7 +563,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); Tcl_HashEntry *hPtr;Tcl_HashSearch search #define FOREACH_HASH(key,val,tablePtr) \ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\ + ((key)=Tcl_GetHashKey((tablePtr),hPtr),\ (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search)) #define FOREACH_HASH_VALUE(val,tablePtr) \ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ diff --git a/generic/tclObj.c b/generic/tclObj.c index 4640725..dde9503 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -293,7 +293,7 @@ const Tcl_ObjType tclBignumType = { */ const Tcl_HashKeyType tclObjHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_TYPE_VERSION_2, /* version */ 0, /* flags */ TclHashObjKey, /* hashKeyProc */ TclCompareObjKeys, /* compareKeysProc */ @@ -4049,15 +4049,15 @@ TclFreeObjEntry( *---------------------------------------------------------------------- */ -unsigned int +size_t TclHashObjKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { - Tcl_Obj *objPtr = keyPtr; - int length; - const char *string = TclGetStringFromObj(objPtr, &length); - unsigned int result = 0; + Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; + const char *string = TclGetString(objPtr); + size_t length = objPtr->length; + size_t result = 0; /* * I tried a zillion different hash functions and asked many other people diff --git a/generic/tclTest.c b/generic/tclTest.c index f2a948a..05383bb 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6611,7 +6611,7 @@ TestHashSystemHashCmd( Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { - TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH, + TCL_HASH_KEY_TYPE_VERSION_2, TCL_HASH_KEY_SYSTEM_HASH, NULL, NULL, NULL, NULL }; Tcl_HashTable hash; @@ -6641,7 +6641,7 @@ TestHashSystemHashCmd( Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } - if (hash.numEntries != limit) { + if (hash.numEntries != (size_t)limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; diff --git a/generic/tclVar.c b/generic/tclVar.c index 87771b2..3031a8a 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -29,7 +29,7 @@ static void FreeVarEntry(Tcl_HashEntry *hPtr); static int CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr); static const Tcl_HashKeyType tclVarHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_TYPE_VERSION_2, /* version */ 0, /* flags */ TclHashObjKey, /* hashKeyProc */ CompareVarKeys, /* compareKeysProc */ diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index ea5fde5..bb2eec1 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -69,7 +69,7 @@ PkguaInterpToTokens( int newEntry; Tcl_Command *cmdTokens; Tcl_HashEntry *entryPtr = - Tcl_CreateHashEntry(&interpTokenMap, (char *) interp, &newEntry); + Tcl_CreateHashEntry(&interpTokenMap, interp, &newEntry); if (newEntry) { cmdTokens = (Tcl_Command *) -- cgit v0.12 From d5259dab0165d9c7445e14676e009bb55213aace Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Jul 2016 09:46:01 +0000 Subject: Use TCL_HASH_TYPE #define for compatibility with Tcl8 in stead of TCL_HASH_KEY_TYPE_VERSION_2 --- generic/tcl.h | 9 ++++++--- generic/tclCompile.h | 2 +- generic/tclDictObj.c | 2 +- generic/tclHash.c | 43 +++++++++++++++++++------------------------ generic/tclInt.h | 2 +- generic/tclLiteral.c | 26 ++++++++++++++------------ generic/tclObj.c | 6 +++--- generic/tclTest.c | 2 +- generic/tclVar.c | 2 +- 9 files changed, 47 insertions(+), 47 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index cf43ff0..dd2848a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -936,11 +936,15 @@ typedef struct Tcl_DString { * Forward declarations of Tcl_HashTable and related types. */ +#ifndef TCL_HASH_TYPE +# define TCL_HASH_TYPE size_t +#endif + typedef struct Tcl_HashKeyType Tcl_HashKeyType; typedef struct Tcl_HashTable Tcl_HashTable; typedef struct Tcl_HashEntry Tcl_HashEntry; -typedef size_t (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr); +typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr); typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr); typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr, void *keyPtr); @@ -992,7 +996,6 @@ struct Tcl_HashEntry { */ #define TCL_HASH_KEY_TYPE_VERSION 1 -#define TCL_HASH_KEY_TYPE_VERSION_2 2 struct Tcl_HashKeyType { int version; /* Version of the table. If this structure is @@ -1052,7 +1055,7 @@ struct Tcl_HashTable { * table. */ size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - size_t mask; /* Mask value used in hashing function. */ + TCL_HASH_TYPE mask1; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ diff --git a/generic/tclCompile.h b/generic/tclCompile.h index db3e764..ab8edf7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1096,7 +1096,7 @@ MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes, - int length, unsigned int hash, int *newPtr, + size_t length, TCL_HASH_TYPE hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index e37dcb6..c172df0 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -179,7 +179,7 @@ const Tcl_ObjType tclDictType = { */ static const Tcl_HashKeyType chainHashType = { - TCL_HASH_KEY_TYPE_VERSION_2, + TCL_HASH_KEY_TYPE_VERSION, 0, TclHashObjKey, TclCompareObjKeys, diff --git a/generic/tclHash.c b/generic/tclHash.c index f0d71d3..fbf5f10 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -28,7 +28,7 @@ */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask1) /* * Prototypes for the array hash key methods. @@ -36,7 +36,7 @@ static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static size_t HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); +static TCL_HASH_TYPE HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Prototypes for the one word hash key methods. Not actually declared because @@ -58,7 +58,7 @@ static size_t HashOneWordKey(Tcl_HashTable *tablePtr, const void *keyPtr); static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static size_t HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); +static TCL_HASH_TYPE HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Function prototypes for static functions in this file: @@ -73,7 +73,7 @@ static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const void *key); static void RebuildTable(Tcl_HashTable *tablePtr); const Tcl_HashKeyType tclArrayHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION_2, /* version */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ HashArrayKey, /* hashKeyProc */ CompareArrayKeys, /* compareKeysProc */ @@ -82,7 +82,7 @@ const Tcl_HashKeyType tclArrayHashKeyType = { }; const Tcl_HashKeyType tclOneWordHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION_2, /* version */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ NULL, /* HashOneWordKey, */ /* hashProc */ NULL, /* CompareOneWordKey, */ /* compareProc */ @@ -91,7 +91,7 @@ const Tcl_HashKeyType tclOneWordHashKeyType = { }; const Tcl_HashKeyType tclStringHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION_2, /* version */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ HashStringKey, /* hashKeyProc */ CompareStringKeys, /* compareKeysProc */ @@ -179,7 +179,7 @@ Tcl_InitCustomHashTable( tablePtr->numEntries = 0; tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER; tablePtr->downShift = 28; - tablePtr->mask = 3; + tablePtr->mask1 = 3; tablePtr->keyType = keyType; tablePtr->findProc = FindHashEntry; tablePtr->createProc = CreateHashEntry; @@ -243,8 +243,7 @@ CreateHashEntry( { register Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; - size_t hash; - size_t index; + TCL_HASH_TYPE hash, index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -258,16 +257,11 @@ CreateHashEntry( } if (typePtr->hashKeyProc) { - if (typePtr->version == TCL_HASH_KEY_TYPE_VERSION) { - hash = ((unsigned int (*)(Tcl_HashTable *, void *)) - typePtr->hashKeyProc)(tablePtr, (void *) key); - } else { - hash = typePtr->hashKeyProc(tablePtr, (void *) key); - } + hash = typePtr->hashKeyProc(tablePtr, (void *) key); if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hash); } else { - index = hash & tablePtr->mask; + index = hash & tablePtr->mask1; } } else { hash = (size_t)(key); @@ -387,7 +381,7 @@ Tcl_DeleteHashEntry( || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = entryPtr->hash & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask1; } bucketPtr = &tablePtr->buckets[index]; @@ -736,13 +730,13 @@ CompareArrayKeys( *---------------------------------------------------------------------- */ -static size_t +static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { register const int *array = (const int *) keyPtr; - register size_t result; + register TCL_HASH_TYPE result; int count; for (result = 0, count = tablePtr->keyType; count > 0; @@ -832,13 +826,13 @@ CompareStringKeys( *---------------------------------------------------------------------- */ -static size_t +static TCL_HASH_TYPE HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { register const char *string = keyPtr; - register size_t result; + register TCL_HASH_TYPE result; register char c; /* @@ -960,7 +954,8 @@ static void RebuildTable( register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - size_t oldSize, count, index; + size_t oldSize, count; + TCL_HASH_TYPE index; Tcl_HashEntry **oldBuckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; @@ -999,7 +994,7 @@ RebuildTable( } tablePtr->rebuildSize *= 4; tablePtr->downShift -= 2; - tablePtr->mask = (tablePtr->mask << 2) + 3; + tablePtr->mask1 = (tablePtr->mask1 << 2) + 3; /* * Rehash all of the existing entries into the new bucket array. @@ -1012,7 +1007,7 @@ RebuildTable( || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = hPtr->hash & tablePtr->mask; + index = hPtr->hash & tablePtr->mask1; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; diff --git a/generic/tclInt.h b/generic/tclInt.h index 762943b..0947afa 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3898,7 +3898,7 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); -MODULE_SCOPE size_t TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); +MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 306e426..e8059f4 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -31,7 +31,7 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static size_t HashString(const char *string, size_t length); +static TCL_HASH_TYPE HashString(const char *string, size_t length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -176,8 +176,8 @@ TclCreateLiteral( Interp *iPtr, char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - int length, /* Number of bytes in the string. */ - unsigned hash, /* The string's hash. If -1, it will be + size_t length, /* Number of bytes in the string. */ + TCL_HASH_TYPE hash, /* The string's hash. If -1, it will be * computed here. */ int *newPtr, Namespace *nsPtr, @@ -193,7 +193,7 @@ TclCreateLiteral( * Is it in the interpreter's global literal table? */ - if (hash == (unsigned) -1) { + if (hash == (TCL_HASH_TYPE) -1) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); @@ -201,9 +201,9 @@ TclCreateLiteral( globalPtr = globalPtr->nextPtr) { objPtr = globalPtr->objPtr; if ((globalPtr->nsPtr == nsPtr) - && (objPtr->length == length) && ((length == 0) + && ((size_t)objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { + && (memcmp(objPtr->bytes, bytes, length) == 0)))) { /* * A literal was found: return it */ @@ -864,12 +864,12 @@ TclReleaseLiteral( *---------------------------------------------------------------------- */ -static size_t +static TCL_HASH_TYPE HashString( register const char *string, /* String for which to compute hash value. */ size_t length) /* Number of bytes in the string. */ { - register size_t result = 0; + register TCL_HASH_TYPE result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -938,8 +938,9 @@ RebuildLiteralTable( register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - unsigned int oldSize; - int count, index, length; + size_t oldSize; + size_t count, length; + TCL_HASH_TYPE index; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -974,8 +975,9 @@ RebuildLiteralTable( for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { - bytes = TclGetStringFromObj(entryPtr->objPtr, &length); - index = (HashString(bytes, length) & tablePtr->mask); + bytes = TclGetString(entryPtr->objPtr); + length = entryPtr->objPtr->length; + index = HashString(bytes, length) & tablePtr->mask; *oldChainPtr = entryPtr->nextPtr; bucketPtr = &tablePtr->buckets[index]; diff --git a/generic/tclObj.c b/generic/tclObj.c index dde9503..74f53cc 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -293,7 +293,7 @@ const Tcl_ObjType tclBignumType = { */ const Tcl_HashKeyType tclObjHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION_2, /* version */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ TclHashObjKey, /* hashKeyProc */ TclCompareObjKeys, /* compareKeysProc */ @@ -4049,7 +4049,7 @@ TclFreeObjEntry( *---------------------------------------------------------------------- */ -size_t +TCL_HASH_TYPE TclHashObjKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ @@ -4057,7 +4057,7 @@ TclHashObjKey( Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; const char *string = TclGetString(objPtr); size_t length = objPtr->length; - size_t result = 0; + TCL_HASH_TYPE result = 0; /* * I tried a zillion different hash functions and asked many other people diff --git a/generic/tclTest.c b/generic/tclTest.c index 05383bb..fb8711a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6611,7 +6611,7 @@ TestHashSystemHashCmd( Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { - TCL_HASH_KEY_TYPE_VERSION_2, TCL_HASH_KEY_SYSTEM_HASH, + TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH, NULL, NULL, NULL, NULL }; Tcl_HashTable hash; diff --git a/generic/tclVar.c b/generic/tclVar.c index 3031a8a..87771b2 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -29,7 +29,7 @@ static void FreeVarEntry(Tcl_HashEntry *hPtr); static int CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr); static const Tcl_HashKeyType tclVarHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION_2, /* version */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ TclHashObjKey, /* hashKeyProc */ CompareVarKeys, /* compareKeysProc */ -- cgit v0.12 From 694ffb74542176b67c5cddf7b421e63bf851411b Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 21:32:25 +0000 Subject: convert ensembleCmdType to new interfaces. --- generic/tclEnsemble.c | 40 +++++++++++++++++++++++++++------------- 1 file changed, 27 insertions(+), 13 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 2766769..de75df3 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -86,6 +86,21 @@ static const Tcl_ObjType ensembleCmdType = { NULL /* setFromAnyProc */ }; +#define ECRSetIntRep(objPtr, ecRepPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (ecRepPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir); \ + } while (0) + +#define ECRGetIntRep(objPtr, ecRepPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &ensembleCmdType); \ + (ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + /* * The internal rep for caching ensemble subcommand lookups and * spell corrections. @@ -1717,10 +1732,10 @@ NsEnsembleImplementationCmdNR( * check here, and if we're still valid, we can jump straight to the * part where we do the invocation of the subcommand. */ + EnsembleCmdRep *ensembleCmd; - if (subObj->typePtr==&ensembleCmdType){ - EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1; - + ECRGetIntRep(subObj, ensembleCmd); + if (ensembleCmd) { if (ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == (Command *)ensemblePtr->token) { prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr); @@ -2346,8 +2361,8 @@ MakeCachedEnsembleCommand( { register EnsembleCmdRep *ensembleCmd; - if (objPtr->typePtr == &ensembleCmdType) { - ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + ECRGetIntRep(objPtr, ensembleCmd); + if (ensembleCmd) { TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); @@ -2358,10 +2373,8 @@ MakeCachedEnsembleCommand( * our own. */ - TclFreeIntRep(objPtr); ensembleCmd = ckalloc(sizeof(EnsembleCmdRep)); - objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd; - objPtr->typePtr = &ensembleCmdType; + ECRSetIntRep(objPtr, ensembleCmd); } /* @@ -2754,14 +2767,14 @@ static void FreeEnsembleCmdRep( Tcl_Obj *objPtr) { - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + EnsembleCmdRep *ensembleCmd; + ECRGetIntRep(objPtr, ensembleCmd); TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } ckfree(ensembleCmd); - objPtr->typePtr = NULL; } /* @@ -2787,11 +2800,12 @@ DupEnsembleCmdRep( Tcl_Obj *objPtr, Tcl_Obj *copyPtr) { - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + EnsembleCmdRep *ensembleCmd; EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep)); - copyPtr->typePtr = &ensembleCmdType; - copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; + ECRGetIntRep(objPtr, ensembleCmd); + ECRSetIntRep(copyPtr, ensembleCopy); + ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; ensembleCopy->token->refCount++; -- cgit v0.12 From ca5093b1ea05fc1e638c182e031710c434bfd30a Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 21:36:13 +0000 Subject: Prefer removal of just known invalid intrep over destruction of all intreps. --- generic/tclAssembly.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 8540b59..1529198 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -867,7 +867,7 @@ CompileAssembleObj( * Not valid, so free it and regenerate. */ - TclFreeIntRep(objPtr); + Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL); } /* -- cgit v0.12 From e2e1132ebacfe2105c78d5104ff9b24aff2290b4 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 21:38:25 +0000 Subject: Prefer removal of just known invalid interp over destruction of all intreps. --- generic/tclCompile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index cdd75d9..a3722f7 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1313,7 +1313,7 @@ CompileSubstObj( || (codePtr->nsEpoch != nsPtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { - TclFreeIntRep(objPtr); + Tcl_StoreIntRep(objPtr, &substCodeType, NULL); codePtr = NULL; } } -- cgit v0.12 From 9a0684671aa9a92a1d8b4037507484c07cdf3a3d Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 21:41:42 +0000 Subject: More of the same. --- generic/tclExecute.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3b23b80..a754474 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1538,7 +1538,7 @@ CompileExprObj( || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { - TclFreeIntRep(objPtr); + Tcl_StoreIntRep(objPtr, &exprCodeType, NULL); codePtr = NULL; } } -- cgit v0.12 From 792e537014155639518f89b8c2e24abb8cd85d5c Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 13 Jul 2016 15:43:44 +0000 Subject: another one --- generic/tclNamesp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 43f2c1a..dd6ba55 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2907,7 +2907,7 @@ GetNamespaceFromObj( *nsPtrPtr = (Tcl_Namespace *) nsPtr; return TCL_OK; } - TclFreeIntRep(objPtr); + Tcl_StoreIntRep(objPtr, &nsNameType, NULL); } if (SetNsNameFromAny(interp, objPtr) == TCL_OK) { NsNameGetIntRep(objPtr, resNamePtr); -- cgit v0.12 From a13a6885072371776b76ca638da45c6d274a79db Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 13 Jul 2016 16:02:04 +0000 Subject: and another --- generic/tclOOCall.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 0a265e5..d660c58 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -966,7 +966,7 @@ TclOOGetCallContext( callPtr->refCount++; goto returnContext; } - Tcl_FreeIntRep(cacheInThisObj); + Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL); } if (oPtr->flags & USE_CLASS_CACHE) { -- cgit v0.12 From 059410842de73f5f43cf23d263880114756fbf20 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 13 Jul 2016 17:02:24 +0000 Subject: another --- generic/tclOOMethod.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 3d9fc35..ce397f8 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -791,6 +791,7 @@ PushMethodCallFrame( register int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; + ByteCode *codePtr; /* * Compute basic information on the basis of the type of method it is. @@ -856,10 +857,8 @@ PushMethodCallFrame( * alternative is *so* slow... */ - if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) { - ByteCode *codePtr = - pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; - + ByteCodeGetIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr); + if (codePtr) { codePtr->nsPtr = nsPtr; } result = TclProcCompileProc(interp, pmPtr->procPtr, @@ -1314,7 +1313,7 @@ CloneProcedureMethod( */ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); - TclFreeIntRep(bodyObj); + Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL); /* * Create the actual copy of the method record, manufacturing a new proc -- cgit v0.12 From 020fdb84f40bbcafa94b79e7d30d84f55ccc3db2 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 13 Jul 2016 17:25:47 +0000 Subject: yup --- generic/tclProc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index a01a314..bc6cc45 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2000,7 +2000,7 @@ TclProcCompileProc( codePtr->compileEpoch = iPtr->compileEpoch; codePtr->nsPtr = nsPtr; } else { - TclFreeIntRep(bodyPtr); + Tcl_StoreIntRep(bodyPtr, &tclByteCodeType, NULL); codePtr = NULL; } } -- cgit v0.12 From df55f87e2d98f6a9a46a12805c38f47b9df8c626 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 18 Jul 2016 20:59:52 +0000 Subject: Half convert "chan" Tcl_ObjType to new interfaces. --- generic/tclIO.c | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 80f6fa4..d7bd4af 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -337,6 +337,13 @@ static const Tcl_ObjType chanObjType = { NULL /* setFromAnyProc */ }; +#define ChanGetIntRep(objPtr, resPtr) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &chanObjType); \ + (resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + #define BUSY_STATE(st, fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) @@ -1501,12 +1508,12 @@ TclGetChannelFromObj( return TCL_ERROR; } - if (objPtr->typePtr == &chanObjType) { + ChanGetIntRep(objPtr, resPtr); + if (resPtr) { /* * Confirm validity of saved lookup results. */ - resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1; statePtr = resPtr->statePtr; if ((resPtr->interp == interp) /* Same interp context */ /* No epoch change in channel since lookup */ @@ -1521,7 +1528,7 @@ TclGetChannelFromObj( if (chan == NULL) { if (resPtr) { - FreeChannelIntRep(objPtr); + Tcl_StoreIntRep(objPtr, &chanObjType, NULL); } return TCL_ERROR; } @@ -11164,7 +11171,10 @@ DupChannelIntRep( register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { - ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; + ResolvedChanName *resPtr; + + ChanGetIntRep(srcPtr, resPtr); + assert(resPtr); resPtr->refCount++; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; @@ -11191,9 +11201,10 @@ static void FreeChannelIntRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; + ResolvedChanName *resPtr; - objPtr->typePtr = NULL; + ChanGetIntRep(objPtr, resPtr); + assert(resPtr); if (--resPtr->refCount) { return; } -- cgit v0.12 From 40d62156ac38bc55dbe904eb9ed2e1a37fb6ba42 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 18 Jul 2016 21:53:51 +0000 Subject: Second half "chan" Tcl_ObjType conversion. Mistake avoided this time. --- generic/tclIO.c | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index d7bd4af..5f479f4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -337,6 +337,15 @@ static const Tcl_ObjType chanObjType = { NULL /* setFromAnyProc */ }; +#define ChanSetIntRep(objPtr, resPtr) \ + do { \ + Tcl_ObjIntRep ir; \ + (resPtr)->refCount++; \ + ir.twoPtrValue.ptr1 = (resPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((objPtr), &chanObjType, &ir); \ + } while (0) + #define ChanGetIntRep(objPtr, resPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ @@ -1536,14 +1545,10 @@ TclGetChannelFromObj( if (resPtr && resPtr->refCount == 1) { /* Re-use the ResolvedCmdName struct */ Tcl_Release((ClientData) resPtr->statePtr); - } else { - TclFreeIntRep(objPtr); - resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); - resPtr->refCount = 1; - objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr; - objPtr->typePtr = &chanObjType; + resPtr->refCount = 0; + ChanSetIntRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; @@ -11175,10 +11180,7 @@ DupChannelIntRep( ChanGetIntRep(srcPtr, resPtr); assert(resPtr); - - resPtr->refCount++; - copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; - copyPtr->typePtr = srcPtr->typePtr; + ChanSetIntRep(copyPtr, resPtr); } /* -- cgit v0.12 From f211f9c476cee29c88e92a8f9415793f6a583203 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jul 2016 15:31:35 +0000 Subject: Convert the "localVarName" type to the proposed interfaces. --- generic/tclVar.c | 89 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 58 insertions(+), 31 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 2248316..2bc2243 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -226,6 +226,24 @@ static const Tcl_ObjType localVarNameType = { FreeLocalVarName, DupLocalVarName, NULL, NULL }; +#define LocalSetIntRep(objPtr, index, namePtr) \ + do { \ + Tcl_ObjIntRep ir; \ + Tcl_Obj *ptr = (namePtr); \ + if (ptr) {Tcl_IncrRefCount(ptr);} \ + ir.twoPtrValue.ptr1 = ptr; \ + ir.twoPtrValue.ptr2 = INT2PTR(index); \ + Tcl_StoreIntRep((objPtr), &localVarNameType, &ir); \ + } while (0) + +#define LocalGetIntRep(objPtr, index, name) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &localVarNameType); \ + (name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \ + } while (0) + static const Tcl_ObjType parsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, NULL, NULL @@ -507,17 +525,19 @@ TclObjLookupVarEx( int index, len1, len2; int parsed = 0; Tcl_Obj *objPtr; - const Tcl_ObjType *typePtr = part1Ptr->typePtr; + const Tcl_ObjType *typePtr; const char *errMsg = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL; - *arrayPtrPtr = NULL; + int localIndex; + Tcl_Obj *namePtr; - if (typePtr == &localVarNameType) { - int localIndex; + *arrayPtrPtr = NULL; - localVarNameTypeHandling: - localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2); + restart: + typePtr = part1Ptr->typePtr; + LocalGetIntRep(part1Ptr, localIndex, namePtr); + if (localIndex >= 0) { if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { @@ -525,7 +545,6 @@ TclObjLookupVarEx( * Use the cached index if the names coincide. */ - Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1; Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex); if ((!namePtr && (checkNamePtr == part1Ptr)) || @@ -543,6 +562,7 @@ TclObjLookupVarEx( */ if (typePtr == &parsedVarNameType) { + parsed = 1; if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { if (part2Ptr != NULL) { /* @@ -559,12 +579,8 @@ TclObjLookupVarEx( } part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2; part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; - typePtr = part1Ptr->typePtr; - if (typePtr == &localVarNameType) { - goto localVarNameTypeHandling; - } + goto restart; } - parsed = 1; } part1 = TclGetStringFromObj(part1Ptr, &len1); @@ -658,18 +674,30 @@ TclObjLookupVarEx( */ Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index); - part1Ptr->typePtr = &localVarNameType; - if (part1Ptr != cachedNamePtr) { - part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr; - Tcl_IncrRefCount(cachedNamePtr); - if (cachedNamePtr->typePtr != &localVarNameType - || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) { - TclFreeIntRep(cachedNamePtr); - } + if (part1Ptr == cachedNamePtr) { + cachedNamePtr = NULL; } else { - part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; + /* + * [80304238ac] Trickiness here. We will store and incr the + * refcount on cachedNamePtr. Trouble is that it's possible + * (see test var-22.1) for cachedNamePtr to have an intrep + * that contains a stored and refcounted part1Ptr. This + * would be a reference cycle which leads to a memory leak. + * + * The solution here is to wipe away all intrep(s) in + * cachedNamePtr and leave it as string only. This is + * radical and destructive, so a better idea would be welcome. + */ + TclFreeIntRep(cachedNamePtr); + + /* + * Now go ahead and convert it the the "localVarName" type, + * since we suspect at least some use of the value as a + * varname and we want to resolve it quickly. + */ + LocalSetIntRep(cachedNamePtr, index, NULL); } - part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index); + LocalSetIntRep(part1Ptr, index, cachedNamePtr); } else { /* * At least mark part1Ptr as already parsed. @@ -5299,12 +5327,14 @@ static void FreeLocalVarName( Tcl_Obj *objPtr) { - Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1; + int index; + Tcl_Obj *namePtr; + + LocalGetIntRep(objPtr, index, namePtr); if (namePtr) { Tcl_DecrRefCount(namePtr); } - objPtr->typePtr = NULL; } static void @@ -5312,17 +5342,14 @@ DupLocalVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1; + int index; + Tcl_Obj *namePtr; + LocalGetIntRep(srcPtr, index, namePtr); if (!namePtr) { namePtr = srcPtr; } - dupPtr->internalRep.twoPtrValue.ptr1 = namePtr; - Tcl_IncrRefCount(namePtr); - - dupPtr->internalRep.twoPtrValue.ptr2 = - srcPtr->internalRep.twoPtrValue.ptr2; - dupPtr->typePtr = &localVarNameType; + LocalSetIntRep(dupPtr, index, namePtr); } /* -- cgit v0.12 From 3e5f21836fec72d9b61ae643ae6fcf903d388b75 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jul 2016 19:47:31 +0000 Subject: Revise "parsedVarName" type to use proposed interfaces. --- generic/tclVar.c | 80 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 39 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index e9f2632..9df1633 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -249,6 +249,27 @@ static const Tcl_ObjType parsedVarNameType = { FreeParsedVarName, DupParsedVarName, NULL, NULL }; +#define ParsedSetIntRep(objPtr, arrayPtr, elem) \ + do { \ + Tcl_ObjIntRep ir; \ + Tcl_Obj *ptr1 = (arrayPtr); \ + Tcl_Obj *ptr2 = (elem); \ + if (ptr1) {Tcl_IncrRefCount(ptr1);} \ + if (ptr2) {Tcl_IncrRefCount(ptr2);} \ + ir.twoPtrValue.ptr1 = ptr1; \ + ir.twoPtrValue.ptr2 = ptr2; \ + Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir); \ + } while (0) + +#define ParsedGetIntRep(objPtr, parsed, array, elem) \ + do { \ + const Tcl_ObjIntRep *irPtr; \ + irPtr = Tcl_FetchIntRep((objPtr), &parsedVarNameType); \ + (parsed) = (irPtr != NULL); \ + (array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ + } while (0) + Var * TclVarHashCreateVar( @@ -435,9 +456,8 @@ TclLookupVar( * * Side effects: * New hashtable entries may be created if createPart1 or createPart2 - * are 1. The object part1Ptr is converted to one of localVarNameType, - * tclNsVarNameType or parsedVarNameType and caches as much of the - * lookup as it can. + * are 1. The object part1Ptr is converted to one of localVarNameType + * or parsedVarNameType and caches as much of the lookup as it can. * When createPart1 is 1, callers must IncrRefCount part1Ptr if they * plan to DecrRefCount it. * @@ -524,15 +544,13 @@ TclObjLookupVarEx( * structure. */ const char *errMsg = NULL; int index, parsed = 0; - const Tcl_ObjType *typePtr; int localIndex; - Tcl_Obj *namePtr; + Tcl_Obj *namePtr, *arrayPtr, *elem; *arrayPtrPtr = NULL; restart: - typePtr = part1Ptr->typePtr; LocalGetIntRep(part1Ptr, localIndex, namePtr); if (localIndex >= 0) { if (HasLocalVars(varFramePtr) @@ -554,13 +572,11 @@ TclObjLookupVarEx( } /* - * If part1Ptr is a parsedVarNameType, separate it into the pre-parsed - * parts. + * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts. */ - if (typePtr == &parsedVarNameType) { - parsed = 1; - if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { + ParsedGetIntRep(part1Ptr, parsed, arrayPtr, elem); + if (parsed && arrayPtr) { if (part2Ptr != NULL) { /* * ERROR: part1Ptr is already an array element, cannot specify @@ -574,10 +590,9 @@ TclObjLookupVarEx( } return NULL; } - part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2; - part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; + part2Ptr = elem; + part1Ptr = arrayPtr; goto restart; - } } if (!parsed) { @@ -594,8 +609,6 @@ TclObjLookupVarEx( const char *part2 = strchr(part1, '('); if (part2) { - Tcl_Obj *arrayPtr; - if (part2Ptr != NULL) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, @@ -609,13 +622,7 @@ TclObjLookupVarEx( arrayPtr = Tcl_NewStringObj(part1, (part2 - part1)); part2Ptr = Tcl_NewStringObj(part2 + 1, len - (part2 - part1) - 2); - TclFreeIntRep(part1Ptr); - - Tcl_IncrRefCount(arrayPtr); - part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr; - Tcl_IncrRefCount(part2Ptr); - part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr; - part1Ptr->typePtr = &parsedVarNameType; + ParsedSetIntRep(part1Ptr, arrayPtr, part2Ptr); part1Ptr = arrayPtr; } @@ -643,7 +650,6 @@ TclObjLookupVarEx( * Cache the newly found variable if possible. */ - TclFreeIntRep(part1Ptr); if (index >= 0) { /* * An indexed local variable. @@ -679,9 +685,7 @@ TclObjLookupVarEx( * At least mark part1Ptr as already parsed. */ - part1Ptr->typePtr = &parsedVarNameType; - part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; - part1Ptr->internalRep.twoPtrValue.ptr2 = NULL; + ParsedSetIntRep(part1Ptr, NULL, NULL); } donePart1: @@ -5342,14 +5346,16 @@ static void FreeParsedVarName( Tcl_Obj *objPtr) { - register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1; - register Tcl_Obj *elem = objPtr->internalRep.twoPtrValue.ptr2; + register Tcl_Obj *arrayPtr, *elem; + int parsed; + + ParsedGetIntRep(objPtr, parsed, arrayPtr, elem); + parsed++; /* Silence compiler. */ if (arrayPtr != NULL) { TclDecrRefCount(arrayPtr); TclDecrRefCount(elem); } - objPtr->typePtr = NULL; } static void @@ -5357,17 +5363,13 @@ DupParsedVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1; - register Tcl_Obj *elem = srcPtr->internalRep.twoPtrValue.ptr2; + register Tcl_Obj *arrayPtr, *elem; + int parsed; - if (arrayPtr != NULL) { - Tcl_IncrRefCount(arrayPtr); - Tcl_IncrRefCount(elem); - } + ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem); - dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr; - dupPtr->internalRep.twoPtrValue.ptr2 = elem; - dupPtr->typePtr = &parsedVarNameType; + parsed++; /* Silence compiler. */ + ParsedSetIntRep(dupPtr, arrayPtr, elem); } /* -- cgit v0.12 From 33ceb4704632778490a21ecef6fb2340df770114 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Sep 2016 20:04:51 +0000 Subject: compiler warning --- generic/tclTest.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 214f154..5aef8dc 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7211,7 +7211,7 @@ InterpCmdResolver( */ CallFrame *parentFramePtr = varFramePtr->callerPtr; - char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; + const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); -- cgit v0.12 From 824b71f9590840c9ff84285235c46b111cee31a5 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 14 Sep 2016 13:33:32 +0000 Subject: Beginning work in earnest on Tip#430 and Tip#453 Renamed zipfs.c to tclZipfs.c. Eliminated tclZipfs.h. Removed the bootstrap introduced by Odie/Androwish. With zipfs in the core one only needs to specify the TclPreInitScript The project at least builds on OSX. Working on Windows under MSYS/MinGW next Added a local snapshot of practcl. --- generic/tclBasic.c | 3 + generic/tclIOUtil.c | 34 - generic/tclInt.h | 4 + generic/tclZipfs.c | 3915 ++++++++++++++++++++++++++++++++++++++ generic/tclZipfs.h | 48 - generic/zipfs.c | 4229 ------------------------------------------ library/practcl/pkgIndex.tcl | 11 + library/practcl/practcl.tcl | 4000 +++++++++++++++++++++++++++++++++++++++ unix/Makefile.in | 8 +- unix/tclAppInit.c | 18 +- win/Makefile.in | 15 +- win/makefile.vc | 2 +- win/tclAppInit.c | 17 +- 13 files changed, 7954 insertions(+), 4350 deletions(-) create mode 100644 generic/tclZipfs.c delete mode 100644 generic/tclZipfs.h delete mode 100644 generic/zipfs.c create mode 100644 library/practcl/pkgIndex.tcl create mode 100644 library/practcl/practcl.tcl diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 53023d8..3550d93 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -982,6 +982,9 @@ Tcl_CreateInterp(void) if (TclZlibInit(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } + if (TclZipfsInit(interp) != TCL_OK) { + Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + } #endif TOP_CB(iPtr) = NULL; diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index e8fce01..397c3b1 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -190,8 +190,6 @@ const Tcl_Filesystem tclNativeFilesystem = { TclpObjChdir }; -MODULE_SCOPE Tcl_Filesystem zipfsFilesystem; - /* * Define the tail of the linked list. Note that for unconventional uses of * Tcl without a native filesystem, we may in the future wish to modify the @@ -1412,22 +1410,6 @@ TclFSNormalizeToUniquePath( Claim(); for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { - if (fsRecPtr->fsPtr == &zipfsFilesystem) { - ClientData clientData = NULL; - /* - * Allow mounted zipfs filesystem to overtake entire normalisation. - * This is needed on unix for mounts on symlinks right below root. - */ - - if (fsRecPtr->fsPtr->pathInFilesystemProc != NULL) { - if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, - &clientData)!=-1) { - TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); - break; - } - } - continue; - } if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; } @@ -1452,9 +1434,6 @@ TclFSNormalizeToUniquePath( if (fsRecPtr->fsPtr == &tclNativeFilesystem) { continue; } - if (fsRecPtr->fsPtr == &zipfsFilesystem) { - continue; - } if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, @@ -2935,19 +2914,6 @@ Tcl_FSChdir( } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); - - if ((fsPtr != NULL) && (fsPtr != &tclNativeFilesystem)) { - /* - * Watch out for tilde substitution. - * Only valid in native filesystem. - */ - char *name = Tcl_GetString(pathPtr); - - if ((name != NULL) && (*name == '~')) { - fsPtr = &tclNativeFilesystem; - } - } - if (fsPtr != NULL) { if (fsPtr->chdirProc != NULL) { /* diff --git a/generic/tclInt.h b/generic/tclInt.h index da1b5c5..aaffd34 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3177,6 +3177,10 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); #endif MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); +MODULE_SCOPE int TclZipfsInit(Tcl_Interp *interp); +MODULE_SCOPE int TclZipfsMount(Tcl_Interp *interp, const char *zipname, + const char *mntpt, const char *passwd); +MODULE_SCOPE int TclZipfsUnmount(Tcl_Interp *interp, const char *zipname); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c new file mode 100644 index 0000000..01d46c6 --- /dev/null +++ b/generic/tclZipfs.c @@ -0,0 +1,3915 @@ +/* + * tclZipfs.c -- + * + * Implementation of the ZIP filesystem used in TIP 430 + * Adapted from the implentation for AndroWish. + * + * Coptright (c) 2016 Sean Woods + * Copyright (c) 2013-2015 Christian Werner + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclFileSystem.h" + +#if !defined(_WIN32) && !defined(_WIN64) +#include +#endif +#include +#include +#include +#include +#include +#include + +#ifdef HAVE_ZLIB +#include "zlib.h" +#include "zcrypt.h" + +#define ZIPFS_VOLUME "zipfs:/" +#define ZIPFS_VOLUME_LEN 7 + +/* + * Various constants and offsets found in ZIP archive files + */ + +#define ZIP_SIG_LEN 4 + +/* Local header of ZIP archive member (at very beginning of each member). */ +#define ZIP_LOCAL_HEADER_SIG 0x04034b50 +#define ZIP_LOCAL_HEADER_LEN 30 +#define ZIP_LOCAL_SIG_OFFS 0 +#define ZIP_LOCAL_VERSION_OFFS 4 +#define ZIP_LOCAL_FLAGS_OFFS 6 +#define ZIP_LOCAL_COMPMETH_OFFS 8 +#define ZIP_LOCAL_MTIME_OFFS 10 +#define ZIP_LOCAL_MDATE_OFFS 12 +#define ZIP_LOCAL_CRC32_OFFS 14 +#define ZIP_LOCAL_COMPLEN_OFFS 18 +#define ZIP_LOCAL_UNCOMPLEN_OFFS 22 +#define ZIP_LOCAL_PATHLEN_OFFS 26 +#define ZIP_LOCAL_EXTRALEN_OFFS 28 + +/* Central header of ZIP archive member at end of ZIP file. */ +#define ZIP_CENTRAL_HEADER_SIG 0x02014b50 +#define ZIP_CENTRAL_HEADER_LEN 46 +#define ZIP_CENTRAL_SIG_OFFS 0 +#define ZIP_CENTRAL_VERSIONMADE_OFFS 4 +#define ZIP_CENTRAL_VERSION_OFFS 6 +#define ZIP_CENTRAL_FLAGS_OFFS 8 +#define ZIP_CENTRAL_COMPMETH_OFFS 10 +#define ZIP_CENTRAL_MTIME_OFFS 12 +#define ZIP_CENTRAL_MDATE_OFFS 14 +#define ZIP_CENTRAL_CRC32_OFFS 16 +#define ZIP_CENTRAL_COMPLEN_OFFS 20 +#define ZIP_CENTRAL_UNCOMPLEN_OFFS 24 +#define ZIP_CENTRAL_PATHLEN_OFFS 28 +#define ZIP_CENTRAL_EXTRALEN_OFFS 30 +#define ZIP_CENTRAL_FCOMMENTLEN_OFFS 32 +#define ZIP_CENTRAL_DISKFILE_OFFS 34 +#define ZIP_CENTRAL_IATTR_OFFS 36 +#define ZIP_CENTRAL_EATTR_OFFS 38 +#define ZIP_CENTRAL_LOCALHDR_OFFS 42 + +/* Central end signature at very end of ZIP file. */ +#define ZIP_CENTRAL_END_SIG 0x06054b50 +#define ZIP_CENTRAL_END_LEN 22 +#define ZIP_CENTRAL_END_SIG_OFFS 0 +#define ZIP_CENTRAL_DISKNO_OFFS 4 +#define ZIP_CENTRAL_DISKDIR_OFFS 6 +#define ZIP_CENTRAL_ENTS_OFFS 8 +#define ZIP_CENTRAL_TOTALENTS_OFFS 10 +#define ZIP_CENTRAL_DIRSIZE_OFFS 12 +#define ZIP_CENTRAL_DIRSTART_OFFS 16 +#define ZIP_CENTRAL_COMMENTLEN_OFFS 20 + +#define ZIP_MIN_VERSION 20 +#define ZIP_COMPMETH_STORED 0 +#define ZIP_COMPMETH_DEFLATED 8 + +#define ZIP_PASSWORD_END_SIG 0x5a5a4b50 + +/* + * Macros to read and write 16 and 32 bit integers from/to ZIP archives. + */ + +#define zip_read_int(p) \ + ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24)) +#define zip_read_short(p) \ + ((p)[0] | ((p)[1] << 8)) + +#define zip_write_int(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ + (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff; +#define zip_write_short(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; + +/* + * Windows drive letters. + */ + +#if defined(_WIN32) || defined(_WIN64) +#define HAS_DRIVES 1 +static const char drvletters[] = + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; +#else +#define HAS_DRIVES 0 +#endif + +/* + * Mutex to protect localtime(3) when no reentrant version available. + */ + +#if !defined(_WIN32) && !defined(_WIN64) +#ifndef HAVE_LOCALTIME_R +#ifdef TCL_THREADS +TCL_DECLARE_MUTEX(localtimeMutex) +#endif +#endif +#endif + +/* + * In-core description of mounted ZIP archive file. + */ + +typedef struct ZipFile { + char *name; /* Archive name */ + Tcl_Channel chan; /* Channel handle or NULL */ + unsigned char *data; /* Memory mapped or malloc'ed file */ + long length; /* Length of memory mapped file */ + unsigned char *tofree; /* Non-NULL if malloc'ed file */ + int nfiles; /* Number of files in archive */ + int baseoffs; /* Archive start */ + int baseoffsp; /* Password start */ + int centoffs; /* Archive directory start */ + char pwbuf[264]; /* Password buffer */ +#if defined(_WIN32) || defined(_WIN64) + HANDLE mh; +#endif + int nopen; /* Number of open files on archive */ + struct ZipEntry *entries; /* List of files in archive */ + struct ZipEntry *topents; /* List of top-level dirs in archive */ +#if HAS_DRIVES + int mntdrv; /* Drive letter of mount point */ +#endif + int mntptlen; /* Length of mount point */ + char mntpt[1]; /* Mount point */ +} ZipFile; + +/* + * In-core description of file contained in mounted ZIP archive. + */ + +typedef struct ZipEntry { + char *name; /* The full pathname of the virtual file */ + ZipFile *zipfile; /* The ZIP file holding this virtual file */ + long offset; /* Data offset into memory mapped ZIP file */ + int nbyte; /* Uncompressed size of the virtual file */ + int nbytecompr; /* Compressed size of the virtual file */ + int cmeth; /* Compress method */ + int isdir; /* Set to 1 if directory */ + int depth; /* Number of slashes in path. */ + int crc32; /* CRC-32 */ + int timestamp; /* Modification time */ + int isenc; /* True if data is encrypted */ + unsigned char *data; /* File data if written */ + struct ZipEntry *next; /* Next file in the same archive */ + struct ZipEntry *tnext; /* Next top-level dir in archive */ +} ZipEntry; + +/* + * File channel for file contained in mounted ZIP archive. + */ + +typedef struct ZipChannel { + ZipFile *zipfile; /* The ZIP file holding this channel */ + ZipEntry *zipentry; /* Pointer back to virtual file */ + unsigned long nmax; /* Max. size for write */ + unsigned long nbyte; /* Number of bytes of uncompressed data */ + unsigned long nread; /* Pos of next byte to be read from the channel */ + unsigned char *ubuf; /* Pointer to the uncompressed data */ + int iscompr; /* True if data is compressed */ + int isdir; /* Set to 1 if directory */ + int isenc; /* True if data is encrypted */ + int iswr; /* True if open for writing */ + unsigned long keys[3]; /* Key for decryption */ +} ZipChannel; + +/* + * Global variables. + * + * Most are kept in single ZipFS struct. When build with threading + * support this struct is protected by the ZipFSMutex (see below). + * + * The "fileHash" component is the process wide global table of all known + * ZIP archive members in all mounted ZIP archives. + * + * The "zipHash" components is the process wide global table of all mounted + * ZIP archive files. + */ + +static struct { + int initialized; /* True when initialized */ + int lock; /* RW lock, see below */ + int waiters; /* RW lock, see below */ + int wrmax; /* Maximum write size of a file */ + int idCount; /* Counter for channel names */ + Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ + Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ +} ZipFS = { + 0, 0, 0, 0, 0, +}; + +/* + * For password rotation. + */ + +static const char pwrot[16] = { + 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, + 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 +}; + +/* + * Table to compute CRC32. + */ + +static const unsigned int crc32tab[256] = { + 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, + 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, + 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, + 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de, + 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856, + 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9, + 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4, + 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b, + 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3, + 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a, + 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599, + 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924, + 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190, + 0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f, + 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e, + 0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01, + 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed, + 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950, + 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3, + 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2, + 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a, + 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5, + 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010, + 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f, + 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17, + 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6, + 0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615, + 0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8, + 0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344, + 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb, + 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a, + 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5, + 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1, + 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c, + 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef, + 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236, + 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe, + 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31, + 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c, + 0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713, + 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b, + 0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242, + 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1, + 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c, + 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278, + 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7, + 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66, + 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9, + 0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605, + 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8, + 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, + 0x2d02ef8d, +}; + +/* + *------------------------------------------------------------------------- + * + * ReadLock, WriteLock, Unlock -- + * + * POSIX like rwlock functions to support multiple readers + * and single writer on internal structs. + * + * Limitations: + * - a read lock cannot be promoted to a write lock + * - a write lock may not be nested + * + *------------------------------------------------------------------------- + */ + +TCL_DECLARE_MUTEX(ZipFSMutex) + +#ifdef TCL_THREADS + +static Tcl_Condition ZipFSCond; + +static void +ReadLock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + while (ZipFS.lock < 0) { + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; + } + ZipFS.lock++; + Tcl_MutexUnlock(&ZipFSMutex); +} + +static void +WriteLock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + while (ZipFS.lock != 0) { + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; + } + ZipFS.lock = -1; + Tcl_MutexUnlock(&ZipFSMutex); +} + +static void +Unlock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + if (ZipFS.lock > 0) { + --ZipFS.lock; + } else if (ZipFS.lock < 0) { + ZipFS.lock = 0; + } + if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) { + Tcl_ConditionNotify(&ZipFSCond); + } + Tcl_MutexUnlock(&ZipFSMutex); +} + +#else + +#define ReadLock() do {} while (0) +#define WriteLock() do {} while (0) +#define Unlock() do {} while (0) + +#endif + +/* + *------------------------------------------------------------------------- + * + * DosTimeDate, ToDosTime, ToDosDate -- + * + * Functions to perform conversions between DOS time stamps + * and POSIX time_t. + * + *------------------------------------------------------------------------- + */ + +static time_t +DosTimeDate(int dosDate, int dosTime) +{ + struct tm tm; + time_t ret; + + memset(&tm, 0, sizeof (tm)); + tm.tm_year = (((dosDate & 0xfe00) >> 9) + 80); + tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1; + tm.tm_mday = dosDate & 0x1f; + tm.tm_hour = (dosTime & 0xf800) >> 11; + tm.tm_min = (dosTime & 0x7e) >> 5; + tm.tm_sec = (dosTime & 0x1f) << 1; + ret = mktime(&tm); + if (ret == (time_t) -1) { + /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */ + ret = (time_t) 315532800; + } + return ret; +} + +static int +ToDosTime(time_t when) +{ + struct tm *tmp, tm; + +#ifdef TCL_THREADS +#if defined(_WIN32) || defined(_WIN64) + /* Win32 uses thread local storage */ + tmp = localtime(&when); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&when, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&when); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif +#else + tmp = localtime(&when); + tm = *tmp; +#endif + return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1); +} + +static int +ToDosDate(time_t when) +{ + struct tm *tmp, tm; + +#ifdef TCL_THREADS +#if defined(_WIN32) || defined(_WIN64) + /* Win32 uses thread local storage */ + tmp = localtime(&when); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&when, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&when); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif +#else + tmp = localtime(&when); + tm = *tmp; +#endif + return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday; +} + +/* + *------------------------------------------------------------------------- + * + * CountSlashes -- + * + * This function counts the number of slashes in a pathname string. + * + * Results: + * Number of slashes found in string. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +CountSlashes(const char *string) +{ + int count = 0; + const char *p = string; + + while (*p != '\0') { + if (*p == '/') { + count++; + } + p++; + } + return count; +} + +/* + *------------------------------------------------------------------------- + * + * CanonicalPath -- + * + * This function computes the canonical path from a directory + * and file name components into the specified Tcl_DString. + * + * Results: + * Returns the pointer to the canonical path contained in the + * specified Tcl_DString. + * + * Side effects: + * Modifies the specified Tcl_DString. + * + *------------------------------------------------------------------------- + */ + +static char * +CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPATH) +{ + char *path; + char *result; + int i, j, c, isunc = 0, isvfs=0, n=0; +#if HAS_DRIVES + int zipfspath=1; + if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && + (tail[1] == ':')) { + tail += 2; + zipfspath=0; + } + /* UNC style path */ + if (tail[0] == '\\') { + root = ""; + ++tail; + zipfspath=0; + } + if (tail[0] == '\\') { + root = "/"; + ++tail; + zipfspath=0; + } + if(zipfspath) { +#endif + /* UNC style path */ + if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) { + isvfs=1; + } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) { + isvfs=2; + } + if(isvfs!=1) { + if ((root[0] == '/') && (root[1] == '/')) { + isunc = 1; + } + } +#if HAS_DRIVES + } +#endif + if(isvfs!=2) { + if (tail[0] == '/') { + if(isvfs!=1) { + root = ""; + } + ++tail; + isunc = 0; + } + if (tail[0] == '/') { + if(isvfs!=1) { + root = "/"; + } + ++tail; + isunc = 1; + } + } + i = strlen(root); + j = strlen(tail); + if(isvfs==1) { + if(i>ZIPFS_VOLUME_LEN) { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + memcpy(path + i, tail, j); + } + } else if(isvfs==2) { + Tcl_DStringSetLength(dsPtr, j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, tail, j); + } else { + if (ZIPFSPATH) { + Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); + path = Tcl_DStringValue(dsPtr); + memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN); + memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } + } +#if HAS_DRIVES + for (i = 0; path[i] != '\0'; i++) { + if (path[i] == '\\') { + path[i] = '/'; + } + } +#endif + if(ZIPFSPATH) { + n=ZIPFS_VOLUME_LEN; + } else { + n=0; + } + for (i = j = n; (c = path[i]) != '\0'; i++) { + if (c == '/') { + int c2 = path[i + 1]; + if (c2 == '/') { + continue; + } + if (c2 == '.') { + int c3 = path[i + 2]; + if ((c3 == '/') || (c3 == '\0')) { + i++; + continue; + } + if ((c3 == '.') && + ((path[i + 3] == '/') || (path [i + 3] == '\0'))) { + i += 2; + while ((j > 0) && (path[j - 1] != '/')) { + j--; + } + if (j > isunc) { + --j; + while ((j > 1 + isunc) && (path[j - 2] == '/')) { + j--; + } + } + continue; + } + } + } + path[j++] = c; + } + if (j == 0) { + path[j++] = '/'; + } + path[j] = 0; + Tcl_DStringSetLength(dsPtr, j); + result=Tcl_DStringValue(dsPtr); + return result; +} + + + +/* + *------------------------------------------------------------------------- + * + * AbsolutePath -- + * + * This function computes the absolute path from a given + * (relative) path name into the specified Tcl_DString. + * + * Results: + * Returns the pointer to the absolute path contained in the + * specified Tcl_DString. + * + * Side effects: + * Modifies the specified Tcl_DString. + * + *------------------------------------------------------------------------- + */ + +static char * +AbsolutePath(const char *path, + Tcl_DString *dsPtr, + int ZIPFSPATH) +{ + char *result; + if (*path == '~') { + Tcl_DStringAppend(dsPtr, path, -1); + return Tcl_DStringValue(dsPtr); + } + if (*path != '/') { + Tcl_DString pwd; + + /* relative path */ + Tcl_DStringInit(&pwd); + Tcl_GetCwd(NULL, &pwd); + result = Tcl_DStringValue(&pwd); + result = CanonicalPath(result, path, dsPtr,ZIPFSPATH); + Tcl_DStringFree(&pwd); + } else { + /* absolute path */ + result = CanonicalPath("", path, dsPtr,ZIPFSPATH); + } + return result; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSLookup -- + * + * This function returns the ZIP entry struct corresponding to + * the ZIP archive member of the given file name. + * + * Results: + * Returns the pointer to ZIP entry struct or NULL if the + * the given file name could not be found in the global list + * of ZIP archive members. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static ZipEntry * +ZipFSLookup(char *filename) +{ + char *realname; + + Tcl_HashEntry *hPtr; + ZipEntry *z; + Tcl_DString ds; + Tcl_DStringInit(&ds); + realname = AbsolutePath(filename, &ds, 1); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, realname); + z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; + Tcl_DStringFree(&ds); + return z; +} + +#ifdef NEVER_USED + +/* + *------------------------------------------------------------------------- + * + * ZipFSLookupMount -- + * + * This function returns an indication if the given file name + * corresponds to a mounted ZIP archive file. + * + * Results: + * Returns true, if the given file name is a mounted ZIP archive file. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSLookupMount(char *filename) +{ + char *realname; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + Tcl_DString ds; + int match = 0; + Tcl_DStringInit(&ds); + realname = AbsolutePath(filename, &ds, 1); + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (strcmp(zf->mntpt, realname) == 0) { + match = 1; + break; + } + } + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_DStringFree(&ds); + return match; +} +#endif + +/* + *------------------------------------------------------------------------- + * + * ZipFSCloseArchive -- + * + * This function closes a mounted ZIP archive file. + * + * Results: + * None. + * + * Side effects: + * A memory mapped ZIP archive is unmapped, allocated memory is + * released. + * + *------------------------------------------------------------------------- + */ + +static void +ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) +{ +#if defined(_WIN32) || defined(_WIN64) + if ((zf->data != NULL) && (zf->tofree == NULL)) { + UnmapViewOfFile(zf->data); + zf->data = NULL; + } + if (zf->mh != INVALID_HANDLE_VALUE) { + CloseHandle(zf->mh); + } +#else + if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) { + munmap(zf->data, zf->length); + zf->data = MAP_FAILED; + } +#endif + if (zf->tofree != NULL) { + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; + } + Tcl_Close(interp, zf->chan); + zf->chan = NULL; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSOpenArchive -- + * + * This function opens a ZIP archive file for reading. An attempt + * is made to memory map that file. Otherwise it is read into + * an allocated memory buffer. The ZIP archive header is verified + * and must be valid for the function to succeed. When "needZip" + * is zero an embedded ZIP archive in an executable file is accepted. + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. + * + * Side effects: + * ZIP archive is memory mapped or read into allocated memory, + * the given ZipFile struct is filled with information about + * the ZIP archive file. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, + ZipFile *zf) +{ + int i; + ClientData handle; + unsigned char *p, *q; + +#if defined(_WIN32) || defined(_WIN64) + zf->data = NULL; + zf->mh = INVALID_HANDLE_VALUE; +#else + zf->data = MAP_FAILED; +#endif + zf->length = 0; + zf->nfiles = 0; + zf->baseoffs = zf->baseoffsp = 0; + zf->tofree = NULL; + zf->pwbuf[0] = 0; + zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0); + if (zf->chan == NULL) { + return TCL_ERROR; + } + if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { + if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") + != TCL_OK) { + goto error; + } + if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") + != TCL_OK) { + goto error; + } + zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); + if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal file size", -1)); + } + goto error; + } + Tcl_Seek(zf->chan, 0, SEEK_SET); + zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); + if (zf->tofree == NULL) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } + i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); + if (i != zf->length) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file read error", -1)); + } + goto error; + } + Tcl_Close(interp, zf->chan); + zf->chan = NULL; + } else { +#if defined(_WIN32) || defined(_WIN64) + zf->length = GetFileSize((HANDLE) handle, 0); + if ((zf->length == INVALID_FILE_SIZE) || + (zf->length < ZIP_CENTRAL_END_LEN)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid file size", -1)); + } + goto error; + } + zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0, + zf->length, 0); + if (zf->mh == INVALID_HANDLE_VALUE) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file mapping failed", -1)); + } + goto error; + } + zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length); + if (zf->data == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file mapping failed", -1)); + } + goto error; + } +#else + zf->length = lseek((int) (long) handle, 0, SEEK_END); + if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid file size", -1)); + } + goto error; + } + lseek((int) (long) handle, 0, SEEK_SET); + zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, + MAP_FILE | MAP_PRIVATE, + (int) (long) handle, 0); + if (zf->data == MAP_FAILED) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file mapping failed", -1)); + } + goto error; + } +#endif + } + p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; + while (p >= zf->data) { + if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { + if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { + break; + } + p -= ZIP_SIG_LEN; + } else { + --p; + } + } + if (p < zf->data) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong end signature", -1)); + } + goto error; + } + zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); + if (zf->nfiles == 0) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("empty archive", -1)); + } + goto error; + } + q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); + p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); + if ((p < zf->data) || (p > (zf->data + zf->length)) || + (q < zf->data) || (q > (zf->data + zf->length))) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("archive directory not found", -1)); + } + goto error; + } + zf->baseoffs = zf->baseoffsp = p - q; + zf->centoffs = p - zf->data; + q = p; + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra; + + if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong header length", -1)); + } + goto error; + } + if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong header signature", -1)); + } + goto error; + } + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + q = zf->data + zf->baseoffs; + if ((zf->baseoffs >= 6) && + (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { + i = q[-5]; + if (q - 5 - i > zf->data) { + zf->pwbuf[0] = i; + memcpy(zf->pwbuf + 1, q - 5 - i, i); + zf->baseoffsp -= i ? (5 + i) : 0; + } + } + return TCL_OK; + +error: + ZipFSCloseArchive(interp, zf); + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------- + * + * TclZipfsMount -- + * + * This procedure is invoked to mount a given ZIP archive file on + * a given mountpoint with optional ZIP password. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is read, analyzed and mounted, resources are + * allocated. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfsMount(Tcl_Interp *interp, const char *zipname, const char *mntpt, + const char *passwd) +{ + char *realname, *p; + int i, pwlen, isNew; + ZipFile *zf, zf0; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_DString ds, dsm, fpBuf; + unsigned char *q; + + ReadLock(); + if (!ZipFS.initialized) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("not initialized", -1)); + } + Unlock(); + return TCL_ERROR; + } + if (zipname == NULL) { + Tcl_HashSearch search; + int ret = TCL_OK; + + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + if (mntpt == NULL) { + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + Tcl_DStringInit(&ds); + p = AbsolutePath(zipname, &ds, 0); + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, p); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } + } + Unlock(); + Tcl_DStringFree(&ds); + return TCL_OK; + } + Unlock(); + pwlen = 0; + if (passwd != NULL) { + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; + } + } + if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { + return TCL_ERROR; + } + Tcl_DStringInit(&ds); + realname = AbsolutePath(zipname, &ds, 0); + /* + * Mount point can come from Tcl_GetNameOfExecutable() + * which sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ + Tcl_DStringInit(&dsm); + mntpt = CanonicalPath("", mntpt, &dsm, 1); + WriteLock(); + hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, realname, &isNew); + Tcl_DStringSetLength(&ds, 0); + if (!isNew) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (interp != NULL) { + Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? + zf->mntpt : "/", "\"", (char *) NULL); + } + Unlock(); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsm); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + if (strcmp(mntpt, "/") == 0) { + mntpt = ""; + } + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + Unlock(); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsm); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + *zf = zf0; + zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + strcpy(zf->mntpt, mntpt); + zf->mntptlen = strlen(zf->mntpt); + zf->entries = NULL; + zf->topents = NULL; + zf->nopen = 0; + Tcl_SetHashValue(hPtr, (ClientData) zf); + if ((zf->pwbuf[0] == 0) && pwlen) { + int k = 0; + i = pwlen; + zf->pwbuf[k++] = i; + while (i > 0) { + zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | + pwrot[(passwd[i - 1] >> 4) & 0x0f]; + k++; + i--; + } + zf->pwbuf[k] = '\0'; + } + if (mntpt[0] != '\0') { + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(mntpt); + z->zipfile = zf; + z->isdir = 1; + z->isenc = 0; + z->offset = zf->baseoffs; + z->crc32 = 0; + z->timestamp = 0; + z->nbyte = z->nbytecompr = 0; + z->cmeth = ZIP_COMPMETH_STORED; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); + if (!isNew) { + /* skip it */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + } + } + q = zf->data + zf->centoffs; + Tcl_DStringInit(&fpBuf); + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; + unsigned char *lq, *gq = NULL; + char *fullpath, *path; + + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); + path = Tcl_DStringValue(&ds); + if ((pathlen > 0) && (path[pathlen - 1] == '/')) { + Tcl_DStringSetLength(&ds, pathlen - 1); + path = Tcl_DStringValue(&ds); + isdir = 1; + } + if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { + goto nextent; + } + lq = zf->data + zf->baseoffs + + zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); + if ((lq < zf->data) || (lq > (zf->data + zf->length))) { + goto nextent; + } + nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); + if (!isdir && (nbcompr == 0) && + (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && + (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { + gq = q; + nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); + } + offs = (lq - zf->data) + + ZIP_LOCAL_HEADER_LEN + + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) + + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); + if ((offs + nbcompr) > zf->length) { + goto nextent; + } + if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { +#ifdef ANDROID + /* + * When mounting the ZIP archive on the root directory try + * to remap top level regular files of the archive to + * /assets/.root/... since this directory should not be + * in a valid APK due to the leading dot in the file name + * component. This trick should make the files + * AndroidManifest.xml, resources.arsc, and classes.dex + * visible to Tcl. + */ + Tcl_DString ds2; + + Tcl_DStringInit(&ds2); + Tcl_DStringAppend(&ds2, "assets/.root/", -1); + Tcl_DStringAppend(&ds2, path, -1); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2)); + if (hPtr != NULL) { + /* should not happen but skip it anyway */ + Tcl_DStringFree(&ds2); + goto nextent; + } + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), + Tcl_DStringLength(&ds2)); + path = Tcl_DStringValue(&ds); + Tcl_DStringFree(&ds2); +#else + /* + * Regular files skipped when mounting on root. + */ + goto nextent; +#endif + } + Tcl_DStringSetLength(&fpBuf, 0); + fullpath = CanonicalPath(mntpt, path, &fpBuf, 1); + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(fullpath); + z->zipfile = zf; + z->isdir = isdir; + z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) + && (nbcompr > 12); + z->offset = offs; + if (gq != NULL) { + z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); + dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); + dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); + } else { + z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); + dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); + dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); + } + z->nbytecompr = nbcompr; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { + z->tnext = zf->topents; + zf->topents = z; + } + if (!z->isdir && (z->depth > 1)) { + char *dir, *end; + ZipEntry *zd; + + Tcl_DStringSetLength(&ds, strlen(z->name) + 8); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, z->name, -1); + dir = Tcl_DStringValue(&ds); + end = strrchr(dir, '/'); + while ((end != NULL) && (end != dir)) { + Tcl_DStringSetLength(&ds, end - dir); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); + if (hPtr != NULL) { + break; + } + zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); + zd->name = NULL; + zd->tnext = NULL; + zd->depth = CountSlashes(dir); + zd->zipfile = zf; + zd->isdir = 1; + zd->isenc = 0; + zd->offset = z->offset; + zd->crc32 = 0; + zd->timestamp = z->timestamp; + zd->nbyte = zd->nbytecompr = 0; + zd->cmeth = ZIP_COMPMETH_STORED; + zd->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) zd); + } else { + Tcl_SetHashValue(hPtr, (ClientData) zd); + zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + zd->next = zf->entries; + zf->entries = zd; + if ((mntpt[0] == '\0') && (zd->depth == 1)) { + zd->tnext = zf->topents; + zf->topents = zd; + } + } + end = strrchr(dir, '/'); + } + } + } +nextent: + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + Unlock(); + Tcl_DStringFree(&fpBuf); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsm); + Tcl_FSMountsChanged(NULL); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * TclZipfsUnmount -- + * + * This procedure is invoked to unmount a given ZIP archive. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A mounted ZIP archive file is unmounted, resources are free'd. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfsUnmount(Tcl_Interp *interp, const char *zipname) +{ + char *realname; + ZipFile *zf; + ZipEntry *z, *znext; + Tcl_HashEntry *hPtr; + Tcl_DString ds; + int ret = TCL_OK, unmounted = 0; + + Tcl_DStringInit(&ds); + realname = AbsolutePath(zipname, &ds, 0); + WriteLock(); + if (!ZipFS.initialized) { + goto done; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, realname); + if (hPtr == NULL) { + /* don't report error */ + goto done; + } + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->nopen > 0) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("filesystem is busy", -1)); + } + ret = TCL_ERROR; + goto done; + } + Tcl_DeleteHashEntry(hPtr); + for (z = zf->entries; z; z = znext) { + znext = z->next; + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + Tcl_Free((char *) z); + } + ZipFSCloseArchive(interp, zf); + Tcl_Free((char *) zf); + unmounted = 1; +done: + Unlock(); + Tcl_DStringFree(&ds); + if (unmounted) { + Tcl_FSMountsChanged(NULL); + } + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMountObjCmd -- + * + * This procedure is invoked to process the "zipfs::mount" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is mounted, resources are allocated. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + if (objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "?zipfile? ?mountpoint? ?password?"); + return TCL_ERROR; + } + return TclZipfsMount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, + (objc > 2) ? Tcl_GetString(objv[2]) : NULL, + (objc > 3) ? Tcl_GetString(objv[3]) : NULL); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSUnmountObjCmd -- + * + * This procedure is invoked to process the "zipfs::unmount" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A mounted ZIP archive file is unmounted, resources are free'd. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); + return TCL_ERROR; + } + return TclZipfsUnmount(interp, Tcl_GetString(objv[1])); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkKeyObjCmd -- + * + * This procedure is invoked to process the "zipfs::mkkey" command. + * It produces a rotated password to be embedded into an image file. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkKeyObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + int len, i = 0; + char *pw, pwbuf[264]; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "password"); + return TCL_ERROR; + } + pw = Tcl_GetString(objv[1]); + len = strlen(pw); + if (len == 0) { + return TCL_OK; + } + if ((len > 255) || (strchr(pw, 0xff) != NULL)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; + } + while (len > 0) { + int ch = pw[len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + Tcl_AppendResult(interp, pwbuf, (char *) NULL); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipAddFile -- + * + * This procedure is used by ZipFSMkZipOrImgCmd() to add a single + * file to the output ZIP archive file being written. A ZipEntry + * struct about the input file is added to the given fileHash table + * for later creation of the central ZIP directory. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Input file is read and (compressed and) written to the output + * ZIP archive file. + * + *------------------------------------------------------------------------- + */ + +static int +ZipAddFile(Tcl_Interp *interp, const char *path, const char *name, + Tcl_Channel out, const char *passwd, + char *buf, int bufsize, Tcl_HashTable *fileHash) +{ + Tcl_Channel in; + Tcl_HashEntry *hPtr; + ZipEntry *z; + z_stream stream; + const char *zpath; + int nbyte, nbytecompr, len, crc, flush, pos[3], zpathlen, olen; + int mtime = 0, isNew, align = 0, cmeth; + unsigned long keys[3], keys0[3]; + char obuf[4096]; + + zpath = name; + while (zpath != NULL && zpath[0] == '/') { + zpath++; + } + if ((zpath == NULL) || (zpath[0] == '\0')) { + return TCL_OK; + } + zpathlen = strlen(zpath); + if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { + Tcl_AppendResult(interp, "path too long for \"", path, "\"", + (char *) NULL); + return TCL_ERROR; + } + in = Tcl_OpenFileChannel(interp, path, "r", 0); + if ((in == NULL) || + (Tcl_SetChannelOption(interp, in, "-translation", "binary") + != TCL_OK) || + (Tcl_SetChannelOption(interp, in, "-encoding", "binary") + != TCL_OK)) { +#if defined(_WIN32) || defined(_WIN64) + /* hopefully a directory */ + if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } +#endif + Tcl_Close(interp, in); + return TCL_ERROR; + } else { + Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); + Tcl_StatBuf statBuf; + + Tcl_IncrRefCount(pathObj); + if (Tcl_FSStat(pathObj, &statBuf) != -1) { + mtime = statBuf.st_mtime; + } + Tcl_DecrRefCount(pathObj); + } + Tcl_ResetResult(interp); + crc = 0; + nbyte = nbytecompr = 0; + while ((len = Tcl_Read(in, buf, bufsize)) > 0) { + crc = crc32(crc, (unsigned char *) buf, len); + nbyte += len; + } + if (len == -1) { + if (nbyte == 0) { + if (strcmp("illegal operation on a directory", + Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } + } + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + if (Tcl_Seek(in, 0, SEEK_SET) == -1) { + Tcl_AppendResult(interp, "seek error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + pos[0] = Tcl_Tell(out); + memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); + memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); + len = zpathlen + ZIP_LOCAL_HEADER_LEN; + if (Tcl_Write(out, buf, len) != len) { +wrerr: + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + if ((len + pos[0]) & 3) { + char abuf[8]; + + /* + * Align payload to next 4-byte boundary using a dummy extra + * entry similar to the zipalign tool from Android's SDK. + */ + align = 4 + ((len + pos[0]) & 3); + zip_write_short(abuf, 0xffff); + zip_write_short(abuf + 2, align - 4); + zip_write_int(abuf + 4, 0x03020100); + if (Tcl_Write(out, abuf, align) != align) { + goto wrerr; + } + } + if (passwd != NULL) { + int i, ch, tmp; + unsigned char kvbuf[24]; + Tcl_Obj *ret; + + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) { + Tcl_AppendResult(interp, "PRNG error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + ret = Tcl_GetObjResult(interp); + if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) { + Tcl_Close(interp, in); + return TCL_ERROR; + } + kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); + } + Tcl_ResetResult(interp); + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + kvbuf[i] = (unsigned char) zencode(keys, crc32tab, + kvbuf[i + 12], tmp); + } + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); + len = Tcl_Write(out, (char *) kvbuf, 12); + memset(kvbuf, 0, 24); + if (len != 12) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + memcpy(keys0, keys, sizeof (keys0)); + nbytecompr += 12; + } + Tcl_Flush(out); + pos[2] = Tcl_Tell(out); + cmeth = ZIP_COMPMETH_DEFLATED; + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) + != Z_OK) { + Tcl_AppendResult(interp, "compression init error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + do { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + stream.avail_in = len; + stream.next_in = (unsigned char *) buf; + flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; + do { + stream.avail_out = sizeof (obuf); + stream.next_out = (unsigned char *) obuf; + len = deflate(&stream, flush); + if (len == Z_STREAM_ERROR) { + Tcl_AppendResult(interp, "deflate error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + olen = sizeof (obuf) - stream.avail_out; + if (passwd != NULL) { + int i, tmp; + + for (i = 0; i < olen; i++) { + obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); + } + } + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += olen; + } while (stream.avail_out == 0); + } while (flush != Z_FINISH); + deflateEnd(&stream); + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + if (nbyte - nbytecompr <= 0) { + /* + * Compressed file larger than input, + * write it again uncompressed. + */ + if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { + goto seekErr; + } + if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { +seekErr: + Tcl_Close(interp, in); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + nbytecompr = (passwd != NULL) ? 12 : 0; + while (1) { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } else if (len == 0) { + break; + } + if (passwd != NULL) { + int i, tmp; + + for (i = 0; i < len; i++) { + buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); + } + } + if (Tcl_Write(out, buf, len) != len) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += len; + } + cmeth = ZIP_COMPMETH_STORED; + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + Tcl_TruncateChannel(out, pos[1]); + } + Tcl_Close(interp, in); + + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = 0; + z->zipfile = NULL; + z->isdir = 0; + z->isenc = (passwd != NULL) ? 1 : 0; + z->offset = pos[0]; + z->crc32 = crc; + z->timestamp = mtime; + z->nbyte = nbyte; + z->nbytecompr = nbytecompr; + z->cmeth = cmeth; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew); + if (!isNew) { + Tcl_AppendResult(interp, "non-unique path name \"", path, "\"", + (char *) NULL); + Tcl_Free((char *) z); + return TCL_ERROR; + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(fileHash, hPtr); + z->next = NULL; + } + + /* + * Write final local header information. + */ + zip_write_int(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG); + zip_write_short(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_LOCAL_FLAGS_OFFS, z->isenc); + zip_write_short(buf + ZIP_LOCAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_LOCAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen); + zip_write_short(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); + if ((int) Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "write error", (char *) NULL); + return TCL_ERROR; + } + Tcl_Flush(out); + if ((int) Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkZipOrImgObjCmd -- + * + * This procedure is creates a new ZIP archive file or image file + * given output filename, input directory of files to be archived, + * optional password, and optional image to be prepended to the + * output ZIP archive file. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A new ZIP archive file or image file is written. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int isImg, int isList, int objc, Tcl_Obj *const objv[]) +{ + Tcl_Channel out; + int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3]; + Tcl_Obj **lobjv, *list = NULL; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_HashTable fileHash; + char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096]; + + if (isList) { + if ((objc < 3) || (objc > (isImg ? 5 : 4))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile inlist ?password infile?" : + "outfile inlist ?password?"); + return TCL_ERROR; + } + } else { + if ((objc < 3) || (objc > (isImg ? 6 : 5))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile indir ?strip? ?password? ?infile?" : + "outfile indir ?strip? ?password?"); + return TCL_ERROR; + } + } + pwbuf[0] = 0; + if (objc > (isList ? 3 : 4)) { + pw = Tcl_GetString(objv[isList ? 3 : 4]); + pwlen = strlen(pw); + if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; + } + } + if (isList) { + list = objv[2]; + Tcl_IncrRefCount(list); + } else { + Tcl_Obj *cmd[3]; + + cmd[1] = Tcl_NewStringObj("::zipfs::find", -1); + cmd[2] = objv[2]; + cmd[0] = Tcl_NewListObj(2, cmd + 1); + Tcl_IncrRefCount(cmd[0]); + if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { + Tcl_DecrRefCount(cmd[0]); + return TCL_ERROR; + } + Tcl_DecrRefCount(cmd[0]); + list = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(list); + } + if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { + Tcl_DecrRefCount(list); + return TCL_ERROR; + } + if (isList && (lobjc % 2)) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("need even number of elements", -1)); + return TCL_ERROR; + } + if (lobjc == 0) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); + return TCL_ERROR; + } + out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755); + if ((out == NULL) || + (Tcl_SetChannelOption(interp, out, "-translation", "binary") + != TCL_OK) || + (Tcl_SetChannelOption(interp, out, "-encoding", "binary") + != TCL_OK)) { + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + if (isImg) { + ZipFile zf0; + const char *imgName; + + if (isList) { + imgName = (objc > 4) ? Tcl_GetString(objv[4]) : + Tcl_GetNameOfExecutable(); + } else { + imgName = (objc > 5) ? Tcl_GetString(objv[5]) : + Tcl_GetNameOfExecutable(); + } + if (ZipFSOpenArchive(interp, imgName, 0, &zf0) != TCL_OK) { + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + if ((pw != NULL) && pwlen) { + i = 0; + len = pwlen; + while (len > 0) { + int ch = pw[len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + } + i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); + if (i != zf0.baseoffsp) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + ZipFSCloseArchive(interp, &zf0); + len = strlen(pwbuf); + if (len > 0) { + i = Tcl_Write(out, pwbuf, len); + if (i != len) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + return TCL_ERROR; + } + } + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_Flush(out); + } + Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); + pos[0] = Tcl_Tell(out); + if (!isList && (objc > 3)) { + strip = Tcl_GetString(objv[3]); + slen = strlen(strip); + } + for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { + const char *path, *name; + + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; + } + } + while (name[0] == '/') { + ++name; + } + if (name[0] == '\0') { + continue; + } + if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), + &fileHash) != TCL_OK) { + goto done; + } + } + pos[1] = Tcl_Tell(out); + count = 0; + for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { + const char *path, *name; + + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; + } + } + while (name[0] == '/') { + ++name; + } + if (name[0] == '\0') { + continue; + } + hPtr = Tcl_FindHashEntry(&fileHash, name); + if (hPtr == NULL) { + continue; + } + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + len = strlen(z->name); + zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); + zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0); + zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len); + zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); + if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != + ZIP_CENTRAL_HEADER_LEN) || + (Tcl_Write(out, z->name, len) != len)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + goto done; + } + count++; + } + Tcl_Flush(out); + pos[2] = Tcl_Tell(out); + zip_write_int(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG); + zip_write_short(buf + ZIP_CENTRAL_DISKNO_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_ENTS_OFFS, count); + zip_write_short(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count); + zip_write_int(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]); + zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]); + zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); + if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + goto done; + } + Tcl_Flush(out); + ret = TCL_OK; +done: + if (ret == TCL_OK) { + ret = Tcl_Close(interp, out); + } else { + Tcl_Close(interp, out); + } + Tcl_DecrRefCount(list); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); + while (hPtr != NULL) { + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + Tcl_Free((char *) z); + Tcl_DeleteHashEntry(hPtr); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); + } + Tcl_DeleteHashTable(&fileHash); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkZipObjCmd -- + * + * This procedure is invoked to process the "zipfs::mkzip" command. + * See description of ZipFSMkZipOrImgCmd(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See description of ZipFSMkZipOrImgCmd(). + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv); +} + +static int +ZipFSLMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkImgObjCmd -- + * + * This procedure is invoked to process the "zipfs::mkimg" command. + * See description of ZipFSMkZipOrImgCmd(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See description of ZipFSMkZipOrImgCmd(). + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv); +} + +static int +ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSExistsObjCmd -- + * + * This procedure is invoked to process the "zipfs::exists" command. + * It tests for the existence of a file in the ZIP filesystem and + * places a boolean into the interp's result. + * + * Results: + * Always TCL_OK. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSCanonicalObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + char *mntpoint=NULL; + char *filename=NULL; + char *result; + Tcl_DString dPath; + + if (objc != 2 && objc != 3 && objc!=4) { + Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?"); + return TCL_ERROR; + } + Tcl_DStringInit(&dPath); + if(objc==2) { + filename = Tcl_GetString(objv[1]); + result=CanonicalPath("",filename,&dPath,1); + } else if (objc==3) { + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,1); + } else { + int zipfs=0; + if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) { + return TCL_ERROR; + } + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,zipfs); + } + Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1)); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSExistsObjCmd -- + * + * This procedure is invoked to process the "zipfs::exists" command. + * It tests for the existence of a file in the ZIP filesystem and + * places a boolean into the interp's result. + * + * Results: + * Always TCL_OK. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + char *filename; + int exists; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; + } + filename = Tcl_GetStringFromObj(objv[1], 0); + ReadLock(); + exists = ZipFSLookup(filename) != NULL; + Unlock(); + Tcl_SetObjResult(interp,Tcl_NewBooleanObj(exists)); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSInfoObjCmd -- + * + * This procedure is invoked to process the "zipfs::info" command. + * On success, it returns a Tcl list made up of name of ZIP archive + * file, size uncompressed, size compressed, and archive offset of + * a file in the ZIP filesystem. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + char *filename; + ZipEntry *z; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; + } + filename = Tcl_GetStringFromObj(objv[1], 0); + ReadLock(); + z = ZipFSLookup(filename); + if (z != NULL) { + Tcl_Obj *result = Tcl_GetObjResult(interp); + + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->zipfile->name, -1)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset)); + } + Unlock(); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSListObjCmd -- + * + * This procedure is invoked to process the "zipfs::list" command. + * On success, it returns a Tcl list of files of the ZIP filesystem + * which match a search pattern (glob or regexp). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + char *pattern = NULL; + Tcl_RegExp regexp = NULL; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *result = Tcl_GetObjResult(interp); + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); + return TCL_ERROR; + } + if (objc == 3) { + int n; + char *what = Tcl_GetStringFromObj(objv[1], &n); + + if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { + pattern = Tcl_GetString(objv[2]); + } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { + regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + if (regexp == NULL) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "unknown option \"", what, + "\"", (char *) NULL); + return TCL_ERROR; + } + } else if (objc == 2) { + pattern = Tcl_GetStringFromObj(objv[1], 0); + } + ReadLock(); + if (pattern != NULL) { + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if (Tcl_StringMatch(z->name, pattern)) { + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } else if (regexp != NULL) { + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } else { + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->name, -1)); + } + } + Unlock(); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelClose -- + * + * This function is called to close a channel. + * + * Results: + * Always TCL_OK. + * + * Side effects: + * Resources are free'd. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) +{ + ZipChannel *info = (ZipChannel *) instanceData; + + if (info->iscompr && (info->ubuf != NULL)) { + Tcl_Free((char *) info->ubuf); + info->ubuf = NULL; + } + if (info->isenc) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + } + if (info->iswr) { + ZipEntry *z = info->zipentry; + unsigned char *newdata; + + newdata = (unsigned char *) + Tcl_AttemptRealloc((char *) info->ubuf, info->nread); + if (newdata != NULL) { + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + z->data = newdata; + z->nbyte = z->nbytecompr = info->nbyte; + z->cmeth = ZIP_COMPMETH_STORED; + z->timestamp = time(NULL); + z->isdir = 0; + z->isenc = 0; + z->offset = 0; + z->crc32 = 0; + } else { + Tcl_Free((char *) info->ubuf); + } + } + WriteLock(); + info->zipfile->nopen--; + Unlock(); + Tcl_Free((char *) info); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelRead -- + * + * This function is called to read data from channel. + * + * Results: + * Number of bytes read or -1 on error with error number set. + * + * Side effects: + * Data is read and file pointer is advanced. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long nextpos; + + if (info->isdir) { + *errloc = EISDIR; + return -1; + } + nextpos = info->nread + toRead; + if (nextpos > info->nbyte) { + toRead = info->nbyte - info->nread; + nextpos = info->nbyte; + } + if (toRead == 0) { + return 0; + } + if (info->isenc) { + int i, ch; + + for (i = 0; i < toRead; i++) { + ch = info->ubuf[i + info->nread]; + buf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(buf, info->ubuf + info->nread, toRead); + } + info->nread = nextpos; + *errloc = 0; + return toRead; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelWrite -- + * + * This function is called to write data into channel. + * + * Results: + * Number of bytes written or -1 on error with error number set. + * + * Side effects: + * Data is written and file pointer is advanced. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelWrite(ClientData instanceData, const char *buf, + int toWrite, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long nextpos; + + if (!info->iswr) { + *errloc = EINVAL; + return -1; + } + nextpos = info->nread + toWrite; + if (nextpos > info->nmax) { + toWrite = info->nmax - info->nread; + nextpos = info->nmax; + } + if (toWrite == 0) { + return 0; + } + memcpy(info->ubuf + info->nread, buf, toWrite); + info->nread = nextpos; + if (info->nread > info->nbyte) { + info->nbyte = info->nread; + } + *errloc = 0; + return toWrite; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelSeek -- + * + * This function is called to position file pointer of channel. + * + * Results: + * New file position or -1 on error with error number set. + * + * Side effects: + * File pointer is repositioned according to offset and mode. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + + if (info->isdir) { + *errloc = EINVAL; + return -1; + } + switch (mode) { + case SEEK_CUR: + offset += info->nread; + break; + case SEEK_END: + offset += info->nbyte; + break; + case SEEK_SET: + break; + default: + *errloc = EINVAL; + return -1; + } + if (offset < 0) { + *errloc = EINVAL; + return -1; + } + if (info->iswr) { + if ((unsigned long) offset > info->nmax) { + *errloc = EINVAL; + return -1; + } + if ((unsigned long) offset > info->nbyte) { + info->nbyte = offset; + } + } else if ((unsigned long) offset > info->nbyte) { + *errloc = EINVAL; + return -1; + } + info->nread = (unsigned long) offset; + return info->nread; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelWatchChannel -- + * + * This function is called for event notifications on channel. + * + * Results: + * None. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +ZipChannelWatchChannel(ClientData instanceData, int mask) +{ + return; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelGetFile -- + * + * This function is called to retrieve OS handle for channel. + * + * Results: + * Always TCL_ERROR since there's never an OS handle for a + * file within a ZIP archive. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelGetFile(ClientData instanceData, int direction, + ClientData *handlePtr) +{ + return TCL_ERROR; +} + +/* + * The channel type/driver definition used for ZIP archive members. + */ + +static Tcl_ChannelType ZipChannelType = { + "zip", /* Type name. */ +#ifdef TCL_CHANNEL_VERSION_4 + TCL_CHANNEL_VERSION_4, + ZipChannelClose, /* Close channel, clean instance data */ + ZipChannelRead, /* Handle read request */ + ZipChannelWrite, /* Handle write request */ + ZipChannelSeek, /* Move location of access point, NULL'able */ + NULL, /* Set options, NULL'able */ + NULL, /* Get options, NULL'able */ + ZipChannelWatchChannel, /* Initialize notifier */ + ZipChannelGetFile, /* Get OS handle from the channel */ + NULL, /* 2nd version of close channel, NULL'able */ + NULL, /* Set blocking mode for raw channel, NULL'able */ + NULL, /* Function to flush channel, NULL'able */ + NULL, /* Function to handle event, NULL'able */ + NULL, /* Wide seek function, NULL'able */ + NULL, /* Thread action function, NULL'able */ +#else + NULL, /* Set blocking/nonblocking behaviour, NULL'able */ + ZipChannelClose, /* Close channel, clean instance data */ + ZipChannelRead, /* Handle read request */ + ZipChannelWrite, /* Handle write request */ + ZipChannelSeek, /* Move location of access point, NULL'able */ + NULL, /* Set options, NULL'able */ + NULL, /* Get options, NULL'able */ + ZipChannelWatchChannel, /* Initialize notifier */ + ZipChannelGetFile, /* Get OS handle from the channel */ +#endif +}; + +/* + *------------------------------------------------------------------------- + * + * ZipChannelOpen -- + * + * This function opens a Tcl_Channel on a file from a mounted ZIP + * archive according to given open mode. + * + * Results: + * Tcl_Channel on success, or NULL on error. + * + * Side effects: + * Memory is allocated, the file from the ZIP archive is uncompressed. + * + *------------------------------------------------------------------------- + */ + +static Tcl_Channel +ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) +{ + ZipEntry *z; + ZipChannel *info; + int i, ch, trunc, wr, flags = 0; + char cname[128]; + + if ((mode & O_APPEND) || + ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); + } + return NULL; + } + WriteLock(); + z = ZipFSLookup(filename); + if (z == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + } + goto error; + } + trunc = (mode & O_TRUNC) != 0; + wr = (mode & (O_WRONLY | O_RDWR)) != 0; + if ((z->cmeth != ZIP_COMPMETH_STORED) && + (z->cmeth != ZIP_COMPMETH_DEFLATED)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unsupported compression method", -1)); + } + goto error; + } + if (wr && z->isdir) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unsupported file type", -1)); + } + goto error; + } + if (!trunc) { + flags |= TCL_READABLE; + if (z->isenc && (z->zipfile->pwbuf[0] == 0)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("decryption failed", -1)); + } + goto error; + } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("file too large", -1)); + } + goto error; + } + } else { + flags = TCL_WRITABLE; + } + info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info)); + if (info == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } + info->zipfile = z->zipfile; + info->zipentry = z; + info->nread = 0; + if (wr) { + flags |= TCL_WRITABLE; + info->iswr = 1; + info->isdir = 0; + info->nmax = ZipFS.wrmax; + info->iscompr = 0; + info->isenc = 0; + info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax); + if (info->ubuf == NULL) { +merror0: + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } + memset(info->ubuf, 0, info->nmax); + if (trunc) { + info->nbyte = 0; + } else { + if (z->data != NULL) { + unsigned int j = z->nbyte; + + if (j > info->nmax) { + j = info->nmax; + } + memcpy(info->ubuf, z->data, j); + info->nbyte = j; + } else { + unsigned char *zbuf = z->zipfile->data + z->offset; + + if (z->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + zbuf += i; + } + if (z->cmeth == ZIP_COMPMETH_DEFLATED) { + z_stream stream; + int err; + unsigned char *cbuf = NULL; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (z->isenc) { + unsigned int j; + + stream.avail_in -= 12; + cbuf = (unsigned char *) + Tcl_AttemptAlloc(stream.avail_in); + if (cbuf == NULL) { + goto merror0; + } + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + cbuf[j] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = cbuf; + } else { + stream.next_in = zbuf; + } + stream.next_out = info->ubuf; + stream.avail_out = info->nmax; + if (inflateInit2(&stream, -15) != Z_OK) { + goto cerror0; + } + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || + ((err == Z_OK) && (stream.avail_in == 0))) { + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + goto wrapchan; + } +cerror0: + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("decompression error", -1)); + } + goto error; + } else if (z->isenc) { + for (i = 0; i < z->nbyte - 12; i++) { + ch = zbuf[i]; + info->ubuf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(info->ubuf, zbuf, z->nbyte); + } + memset(info->keys, 0, sizeof (info->keys)); + goto wrapchan; + } + } + } else if (z->data != NULL) { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = 0; + info->isdir = 0; + info->isenc = 0; + info->nbyte = z->nbyte; + info->nmax = 0; + info->ubuf = z->data; + } else { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED; + info->ubuf = z->zipfile->data + z->offset; + info->isdir = z->isdir; + info->isenc = z->isenc; + info->nbyte = z->nbyte; + info->nmax = 0; + if (info->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + info->ubuf += i; + } + if (info->iscompr) { + z_stream stream; + int err; + unsigned char *ubuf = NULL; + unsigned int j; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (info->isenc) { + stream.avail_in -= 12; + ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); + if (ubuf == NULL) { + info->ubuf = NULL; + goto merror; + } + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + ubuf[j] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = ubuf; + } else { + stream.next_in = info->ubuf; + } + stream.next_out = info->ubuf = + (unsigned char *) Tcl_AttemptAlloc(info->nbyte); + if (info->ubuf == NULL) { +merror: + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } + stream.avail_out = info->nbyte; + if (inflateInit2(&stream, -15) != Z_OK) { + goto cerror; + } + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || + ((err == Z_OK) && (stream.avail_in == 0))) { + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + goto wrapchan; + } +cerror: + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("decompression error", -1)); + } + goto error; + } + } +wrapchan: + sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, ZipFS.idCount++); + z->zipfile->nopen++; + Unlock(); + return Tcl_CreateChannel(&ZipChannelType, cname, (ClientData) info, flags); + +error: + Unlock(); + return NULL; +} + +/* + *------------------------------------------------------------------------- + * + * ZipEntryStat -- + * + * This function implements the ZIP filesystem specific version + * of the library version of stat. + * + * Results: + * See stat documentation. + * + * Side effects: + * See stat documentation. + * + *------------------------------------------------------------------------- + */ + +static int +ZipEntryStat(char *path, Tcl_StatBuf *buf) +{ + ZipEntry *z; + int ret = -1; + + ReadLock(); + z = ZipFSLookup(path); + if (z == NULL) { + goto done; + } + memset(buf, 0, sizeof (Tcl_StatBuf)); + if (z->isdir) { + buf->st_mode = S_IFDIR | 0555; + } else { + buf->st_mode = S_IFREG | 0555; + } + buf->st_size = z->nbyte; + buf->st_mtime = z->timestamp; + buf->st_ctime = z->timestamp; + buf->st_atime = z->timestamp; + ret = 0; +done: + Unlock(); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * ZipEntryAccess -- + * + * This function implements the ZIP filesystem specific version + * of the library version of access. + * + * Results: + * See access documentation. + * + * Side effects: + * See access documentation. + * + *------------------------------------------------------------------------- + */ + +static int +ZipEntryAccess(char *path, int mode) +{ + ZipEntry *z; + + if (mode & 3) { + return -1; + } + ReadLock(); + z = ZipFSLookup(path); + Unlock(); + return (z != NULL) ? 0 : -1; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSOpenFileChannelProc -- + * + * Results: + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static Tcl_Channel +Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode, int permissions) +{ + int len; + + return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), + mode, permissions); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSStatProc -- + * + * This function implements the ZIP filesystem specific version + * of the library version of stat. + * + * Results: + * See stat documentation. + * + * Side effects: + * See stat documentation. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) +{ + int len; + + return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSAccessProc -- + * + * This function implements the ZIP filesystem specific version + * of the library version of access. + * + * Results: + * See access documentation. + * + * Side effects: + * See access documentation. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) +{ + int len; + + return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFilesystemSeparatorProc -- + * + * This function returns the separator to be used for a given path. The + * object returned should have a refCount of zero + * + * Results: + * A Tcl object, with a refCount of zero. If the caller needs to retain a + * reference to the object, it should call Tcl_IncrRefCount, and should + * otherwise free the object. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static Tcl_Obj * +Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) +{ + return Tcl_NewStringObj("/", -1); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSMatchInDirectoryProc -- + * + * This routine is used by the globbing code to search a directory for + * all files which match a given pattern. + * + * Results: + * The return value is a standard Tcl result indicating whether an + * error occurred in globbing. Errors are left in interp, good + * results are lappend'ed to resultPtr (which must be a valid object). + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ +static int +Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, + Tcl_Obj *pathPtr, const char *pattern, + Tcl_GlobTypeData *types) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; + char *pat, *prefix, *path; + Tcl_DString ds, dsPref; + if (types != NULL) { + dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; + } + Tcl_DStringInit(&ds); + Tcl_DStringInit(&dsPref); + prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); + Tcl_DStringAppend(&dsPref, prefix, prefixLen); + prefix = Tcl_DStringValue(&dsPref); + path = AbsolutePath(prefix, &ds, 1); + len = Tcl_DStringLength(&ds); + if (strcmp(prefix, path) == 0) { + prefix = NULL; + } else { + strip = len + 1; + } + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, "/", 1); + prefixLen++; + prefix = Tcl_DStringValue(&dsPref); + } + ReadLock(); + if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { + l = CountSlashes(path); + if (path[len - 1] == '/') { + len--; + } else { + l++; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + pattern = "*"; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); + + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + if ((lenz > len + 1) && + (strncmp(z->name, path, len) == 0) && + (z->name[len] == '/') && + (CountSlashes(z->name) == l) && + Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, lenz); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, lenz)); + } + } + z = z->tnext; + } + } else if ((zf->mntptlen > len + 1) && + (strncmp(zf->mntpt, path, len) == 0) && + (zf->mntpt[len] == '/') && + (CountSlashes(zf->mntpt) == l) && + Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } + } + hPtr = Tcl_NextHashEntry(&search); + } + goto end; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if ((dirOnly < 0) || + (!dirOnly && !z->isdir) || + (dirOnly && z->isdir)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } + goto end; + } + l = strlen(pattern); + pat = Tcl_Alloc(len + l + 2); + memcpy(pat, path, len); + while ((len > 1) && (pat[len - 1] == '/')) { + --len; + } + if ((len > 1) || (pat[0] != '/')) { + pat[len] = '/'; + ++len; + } + memcpy(pat + len, pattern, l + 1); + scnt = CountSlashes(pat); + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + if ((dirOnly >= 0) && + ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) { + continue; + } + if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name + strip, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name + strip, -1)); + } + } + } + Tcl_Free(pat); +end: + Unlock(); + Tcl_DStringFree(&dsPref); + Tcl_DStringFree(&ds); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSPathInFilesystemProc -- + * + * This function determines if the given path object is in the + * ZIP filesystem. + * + * Results: + * TCL_OK when the path object is in the ZIP filesystem, -1 otherwise. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + int ret = -1, len; + char *path; + Tcl_DString ds; + + path = Tcl_GetStringFromObj(pathPtr, &len); + if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) { + return -1; + } + + Tcl_DStringInit(&ds); + path = CanonicalPath("",path, &ds, 1); + len = Tcl_DStringLength(&ds); + ReadLock(); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ret = TCL_OK; + goto endloop; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + + if ((len >= lenz) && + (strncmp(path, z->name, lenz) == 0)) { + ret = TCL_OK; + goto endloop; + } + z = z->tnext; + } + } else if ((len >= zf->mntptlen) && + (strncmp(path, zf->mntpt, zf->mntptlen) == 0)) { + ret = TCL_OK; + goto endloop; + } + hPtr = Tcl_NextHashEntry(&search); + } +endloop: + Unlock(); + Tcl_DStringFree(&ds); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSListVolumesProc -- + * + * Lists the currently mounted ZIP filesystem volumes. + * + * Results: + * The list of volumes. + * + * Side effects: + * None + * + *------------------------------------------------------------------------- + */ +static Tcl_Obj * +Zip_FSListVolumesProc(void) { + return Tcl_NewStringObj(ZIPFS_VOLUME, -1); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFileAttrStringsProc -- + * + * This function implements the ZIP filesystem dependent 'file attributes' + * subcommand, for listing the set of possible attribute strings. + * + * Results: + * An array of strings + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static const char *const * +Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) +{ + static const char *const attrs[] = { + "-uncompsize", + "-compsize", + "-offset", + "-mount", + "-archive", + "-permissions", + NULL, + }; + + return attrs; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFileAttrsGetProc -- + * + * This function implements the ZIP filesystem specific + * 'file attributes' subcommand, for 'get' operations. + * + * Results: + * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK + * was returned) is likely to have a refCount of zero. Either way we must + * either store it somewhere (e.g. the Tcl result), or Incr/Decr its + * refCount to ensure it is properly freed. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef) +{ + int len, ret = TCL_OK; + char *path; + ZipEntry *z; + + path = Tcl_GetStringFromObj(pathPtr, &len); + ReadLock(); + z = ZipFSLookup(path); + if (z == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + } + ret = TCL_ERROR; + goto done; + } + switch (index) { + case 0: + *objPtrRef = Tcl_NewIntObj(z->nbyte); + goto done; + case 1: + *objPtrRef= Tcl_NewIntObj(z->nbytecompr); + goto done; + case 2: + *objPtrRef= Tcl_NewLongObj(z->offset); + goto done; + case 3: + *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1); + goto done; + case 4: + *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); + goto done; + case 5: + *objPtrRef= Tcl_NewStringObj("0555", -1); + goto done; + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown attribute", -1)); + } + ret = TCL_ERROR; +done: + Unlock(); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFileAttrsSetProc -- + * + * This function implements the ZIP filesystem specific + * 'file attributes' subcommand, for 'set' operations. + * + * Results: + * Standard Tcl return code. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj *objPtr) +{ + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); + } + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFilesystemPathTypeProc -- + * + * Results: + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static Tcl_Obj * +Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) +{ + return Tcl_NewStringObj("zip", -1); +} + + +/* + *------------------------------------------------------------------------- + * + * Zip_FSLoadFile -- + * + * This functions deals with loading native object code. If + * the given path object refers to a file within the ZIP + * filesystem, an approriate error code is returned to delegate + * loading to the caller (by copying the file to temp store + * and loading from there). As fallback when the file refers + * to the ZIP file system but is not present, it is looked up + * relative to the executable and loaded from there when available. + * + * Results: + * TCL_OK on success, -1 otherwise with error number set. + * + * Side effects: + * Loads native code into the process address space. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, + Tcl_FSUnloadFileProc **unloadProcPtr, int flags) +{ + Tcl_FSLoadFileProc2 *loadFileProc; +#ifdef ANDROID + /* + * Force loadFileProc to native implementation since the + * package manger already extracted the shared libraries + * from the APK at install time. + */ + + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + if (loadFileProc != NULL) { + return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + } + Tcl_SetErrno(ENOENT); + return -1; +#else + Tcl_Obj *altPath = NULL; + int ret = -1; + + if (Tcl_FSAccess(path, R_OK) == 0) { + /* + * EXDEV should trigger loading by copying to temp store. + */ + Tcl_SetErrno(EXDEV); + return ret; + } else { + Tcl_Obj *objs[2] = { NULL, NULL }; + + objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); + if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { + const char *execName = Tcl_GetNameOfExecutable(); + + /* + * Shared object is not in ZIP but its path prefix is, + * thus try to load from directory where the executable + * came from. + */ + TclDecrRefCount(objs[1]); + objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); + /* + * Get directory name of executable manually to deal + * with cases where [file dirname [info nameofexecutable]] + * is equal to [info nameofexecutable] due to VFS effects. + */ + if (execName != NULL) { + const char *p = strrchr(execName, '/'); + + if (p > execName + 1) { + --p; + objs[0] = Tcl_NewStringObj(execName, p - execName); + } + } + if (objs[0] == NULL) { + objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), + TCL_PATH_DIRNAME); + } + if (objs[0] != NULL) { + altPath = TclJoinPath(2, objs); + if (altPath != NULL) { + Tcl_IncrRefCount(altPath); + if (Tcl_FSAccess(altPath, R_OK) == 0) { + path = altPath; + } + } + } + } + if (objs[0] != NULL) { + Tcl_DecrRefCount(objs[0]); + } + if (objs[1] != NULL) { + Tcl_DecrRefCount(objs[1]); + } + } + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + if (loadFileProc != NULL) { + ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + } else { + Tcl_SetErrno(ENOENT); + } + if (altPath != NULL) { + Tcl_DecrRefCount(altPath); + } + return ret; +#endif +} + + +/* + * Define the ZIP filesystem dispatch table. + */ + +MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; + +const Tcl_Filesystem zipfsFilesystem = { + "zipfs", + sizeof (Tcl_Filesystem), + TCL_FILESYSTEM_VERSION_2, + Zip_FSPathInFilesystemProc, + NULL, /* dupInternalRepProc */ + NULL, /* freeInternalRepProc */ + NULL, /* internalToNormalizedProc */ + NULL, /* createInternalRepProc */ + NULL, /* normalizePathProc */ + Zip_FSFilesystemPathTypeProc, + Zip_FSFilesystemSeparatorProc, + Zip_FSStatProc, + Zip_FSAccessProc, + Zip_FSOpenFileChannelProc, + Zip_FSMatchInDirectoryProc, + NULL, /* utimeProc */ + NULL, /* linkProc */ + Zip_FSListVolumesProc, + Zip_FSFileAttrStringsProc, + Zip_FSFileAttrsGetProc, + Zip_FSFileAttrsSetProc, + NULL, /* createDirectoryProc */ + NULL, /* removeDirectoryProc */ + NULL, /* deleteFileProc */ + NULL, /* copyFileProc */ + NULL, /* renameFileProc */ + NULL, /* copyDirectoryProc */ + NULL, /* lstatProc */ + (Tcl_FSLoadFileProc *) Zip_FSLoadFile, + NULL, /* getCwdProc */ + NULL, /* chdirProc*/ +}; + +#endif /* HAVE_ZLIB */ + + + +/* + *------------------------------------------------------------------------- + * + * TclZipfsInit -- + * + * Perform per interpreter initialization of this module. + * + * Results: + * The return value is a standard Tcl result. + * + * Side effects: + * Initializes this module if not already initialized, and adds + * module related commands to the given interpreter. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfsInit(Tcl_Interp *interp) +{ +#ifdef HAVE_ZLIB + /* one-time initialization */ + WriteLock(); + if (!ZipFS.initialized) { +#ifdef TCL_THREADS + static const Tcl_Time t = { 0, 0 }; + /* + * Inflate condition variable. + */ + Tcl_MutexLock(&ZipFSMutex); + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); + Tcl_MutexUnlock(&ZipFSMutex); +#endif + Tcl_FSRegister(NULL, &zipfsFilesystem); + Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); + ZipFS.initialized = ZipFS.idCount = 1; + } + Unlock(); + if(interp != NULL) { + static const EnsembleImplMap initMap[] = { + {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, + {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, + {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, + {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, + {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, + {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, + {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, + {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, + {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, + {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, + {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1}, + {NULL, NULL, NULL, NULL, NULL, 0} + }; + static const char findproc[] = + "namespace eval zipfs {}\n" + "proc ::zipfs::find dir {\n" + " set result {}\n" + " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n" + " return $result\n" + " }\n" + " foreach file $list {\n" + " if {$file eq \".\" || $file eq \"..\"} {\n" + " continue\n" + " }\n" + " set file [file join $dir $file]\n" + " lappend result $file\n" + " foreach file [::zipfs::find $file] {\n" + " lappend result $file\n" + " }\n" + " }\n" + " return [lsort $result]\n" + "}\n"; + Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); + Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, + TCL_LINK_INT); + TclMakeEnsemble(interp, "zipfs", initMap); + Tcl_PkgProvide(interp, "zipfs", "1.0"); + } + return TCL_OK; +#else + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("no zlib available", -1)); + } + return TCL_ERROR; +#endif +} + + +#ifndef HAVE_ZLIB + +/* + *------------------------------------------------------------------------- + * + * TclZipfsMount, TclZipfsUnmount -- + * + * Dummy version when no ZLIB support available. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfsMount(Tcl_Interp *interp, const char *zipname, const char *mntpt, + const char *passwd) +{ + return TclZipFsInit(interp, 1); +} + +int +TclZipfsUnmount(Tcl_Interp *interp, const char *zipname) +{ + return TclZipFsInit(interp, 1); +} + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h deleted file mode 100644 index 01c9e96..0000000 --- a/generic/tclZipfs.h +++ /dev/null @@ -1,48 +0,0 @@ -/* - * tclZipfs.h -- - * - * This header file describes the interface of the ZIPFS filesystem - * - * Copyright (c) 2013-2015 Christian Werner - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#ifndef _ZIPFS_H -#define _ZIPFS_H - -#include "tcl.h" - -#ifdef __cplusplus -extern "C" { -#endif - -#ifndef ZIPFSAPI -# define ZIPFSAPI extern -#endif - -#ifdef BUILD_tcl -# undef ZIPFSAPI -# define ZIPFSAPI DLLEXPORT -#endif - -ZIPFSAPI int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, - const char *mntpt, const char *passwd); -ZIPFSAPI int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname); -ZIPFSAPI int Tclzipfs_Init(Tcl_Interp *interp); -ZIPFSAPI int Tclzipfs_SafeInit(Tcl_Interp *interp); - -#ifdef __cplusplus -} -#endif - -#endif /* _ZIPFS_H */ - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/generic/zipfs.c b/generic/zipfs.c deleted file mode 100644 index 70a8d6e..0000000 --- a/generic/zipfs.c +++ /dev/null @@ -1,4229 +0,0 @@ -/* - * zipfs.c -- - * - * Implementation of the ZIP filesystem used in AndroWish. - * - * Copyright (c) 2013-2015 Christian Werner - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include "tclInt.h" -#include "tclFileSystem.h" -#include "tclZipfs.h" - -#if !defined(_WIN32) && !defined(_WIN64) -#include -#endif -#include -#include -#include -#include -#include -#include - -#ifdef HAVE_ZLIB -#include "zlib.h" -#include "zcrypt.h" - -/* - * Various constants and offsets found in ZIP archive files. - */ - -#define ZIP_SIG_LEN 4 - -/* Local header of ZIP archive member (at very beginning of each member). */ -#define ZIP_LOCAL_HEADER_SIG 0x04034b50 -#define ZIP_LOCAL_HEADER_LEN 30 -#define ZIP_LOCAL_SIG_OFFS 0 -#define ZIP_LOCAL_VERSION_OFFS 4 -#define ZIP_LOCAL_FLAGS_OFFS 6 -#define ZIP_LOCAL_COMPMETH_OFFS 8 -#define ZIP_LOCAL_MTIME_OFFS 10 -#define ZIP_LOCAL_MDATE_OFFS 12 -#define ZIP_LOCAL_CRC32_OFFS 14 -#define ZIP_LOCAL_COMPLEN_OFFS 18 -#define ZIP_LOCAL_UNCOMPLEN_OFFS 22 -#define ZIP_LOCAL_PATHLEN_OFFS 26 -#define ZIP_LOCAL_EXTRALEN_OFFS 28 - -/* Central header of ZIP archive member at end of ZIP file. */ -#define ZIP_CENTRAL_HEADER_SIG 0x02014b50 -#define ZIP_CENTRAL_HEADER_LEN 46 -#define ZIP_CENTRAL_SIG_OFFS 0 -#define ZIP_CENTRAL_VERSIONMADE_OFFS 4 -#define ZIP_CENTRAL_VERSION_OFFS 6 -#define ZIP_CENTRAL_FLAGS_OFFS 8 -#define ZIP_CENTRAL_COMPMETH_OFFS 10 -#define ZIP_CENTRAL_MTIME_OFFS 12 -#define ZIP_CENTRAL_MDATE_OFFS 14 -#define ZIP_CENTRAL_CRC32_OFFS 16 -#define ZIP_CENTRAL_COMPLEN_OFFS 20 -#define ZIP_CENTRAL_UNCOMPLEN_OFFS 24 -#define ZIP_CENTRAL_PATHLEN_OFFS 28 -#define ZIP_CENTRAL_EXTRALEN_OFFS 30 -#define ZIP_CENTRAL_FCOMMENTLEN_OFFS 32 -#define ZIP_CENTRAL_DISKFILE_OFFS 34 -#define ZIP_CENTRAL_IATTR_OFFS 36 -#define ZIP_CENTRAL_EATTR_OFFS 38 -#define ZIP_CENTRAL_LOCALHDR_OFFS 42 - -/* Central end signature at very end of ZIP file. */ -#define ZIP_CENTRAL_END_SIG 0x06054b50 -#define ZIP_CENTRAL_END_LEN 22 -#define ZIP_CENTRAL_END_SIG_OFFS 0 -#define ZIP_CENTRAL_DISKNO_OFFS 4 -#define ZIP_CENTRAL_DISKDIR_OFFS 6 -#define ZIP_CENTRAL_ENTS_OFFS 8 -#define ZIP_CENTRAL_TOTALENTS_OFFS 10 -#define ZIP_CENTRAL_DIRSIZE_OFFS 12 -#define ZIP_CENTRAL_DIRSTART_OFFS 16 -#define ZIP_CENTRAL_COMMENTLEN_OFFS 20 - -#define ZIP_MIN_VERSION 20 -#define ZIP_COMPMETH_STORED 0 -#define ZIP_COMPMETH_DEFLATED 8 - -#define ZIP_PASSWORD_END_SIG 0x5a5a4b50 - -/* - * Macros to read and write 16 and 32 bit integers from/to ZIP archives. - */ - -#define zip_read_int(p) \ - ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24)) -#define zip_read_short(p) \ - ((p)[0] | ((p)[1] << 8)) - -#define zip_write_int(p, v) \ - (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ - (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff; -#define zip_write_short(p, v) \ - (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; - -/* - * Windows drive letters. - */ - -#if defined(_WIN32) || defined(_WIN64) -#define HAS_DRIVES 1 -static const char drvletters[] = - "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; -#else -#define HAS_DRIVES 0 -#endif - -/* - * Mutex to protect localtime(3) when no reentrant version available. - */ - -#if !defined(_WIN32) && !defined(_WIN64) -#ifndef HAVE_LOCALTIME_R -#ifdef TCL_THREADS -TCL_DECLARE_MUTEX(localtimeMutex) -#endif -#endif -#endif - -/* - * In-core description of mounted ZIP archive file. - */ - -typedef struct ZipFile { - char *name; /* Archive name */ - Tcl_Channel chan; /* Channel handle or NULL */ - unsigned char *data; /* Memory mapped or malloc'ed file */ - long length; /* Length of memory mapped file */ - unsigned char *tofree; /* Non-NULL if malloc'ed file */ - int nfiles; /* Number of files in archive */ - int baseoffs; /* Archive start */ - int baseoffsp; /* Password start */ - int centoffs; /* Archive directory start */ - char pwbuf[264]; /* Password buffer */ -#if defined(_WIN32) || defined(_WIN64) - HANDLE mh; -#endif - int nopen; /* Number of open files on archive */ - struct ZipEntry *entries; /* List of files in archive */ - struct ZipEntry *topents; /* List of top-level dirs in archive */ -#if HAS_DRIVES - int mntdrv; /* Drive letter of mount point */ -#endif - int mntptlen; /* Length of mount point */ - char mntpt[1]; /* Mount point */ -} ZipFile; - -/* - * In-core description of file contained in mounted ZIP archive. - */ - -typedef struct ZipEntry { - char *name; /* The full pathname of the virtual file */ - ZipFile *zipfile; /* The ZIP file holding this virtual file */ - long offset; /* Data offset into memory mapped ZIP file */ - int nbyte; /* Uncompressed size of the virtual file */ - int nbytecompr; /* Compressed size of the virtual file */ - int cmeth; /* Compress method */ - int isdir; /* Set to 1 if directory */ - int depth; /* Number of slashes in path. */ - int crc32; /* CRC-32 */ - int timestamp; /* Modification time */ - int isenc; /* True if data is encrypted */ - unsigned char *data; /* File data if written */ - struct ZipEntry *next; /* Next file in the same archive */ - struct ZipEntry *tnext; /* Next top-level dir in archive */ -} ZipEntry; - -/* - * File channel for file contained in mounted ZIP archive. - */ - -typedef struct ZipChannel { - ZipFile *zipfile; /* The ZIP file holding this channel */ - ZipEntry *zipentry; /* Pointer back to virtual file */ - unsigned long nmax; /* Max. size for write */ - unsigned long nbyte; /* Number of bytes of uncompressed data */ - unsigned long nread; /* Pos of next byte to be read from the channel */ - unsigned char *ubuf; /* Pointer to the uncompressed data */ - int iscompr; /* True if data is compressed */ - int isdir; /* Set to 1 if directory */ - int isenc; /* True if data is encrypted */ - int iswr; /* True if open for writing */ - unsigned long keys[3]; /* Key for decryption */ -} ZipChannel; - -/* - * Global variables. - * - * Most are kept in single ZipFS struct. When build with threading - * support this struct is protected by the ZipFSMutex (see below). - * - * The "fileHash" component is the process wide global table of all known - * ZIP archive members in all mounted ZIP archives. - * - * The "zipHash" components is the process wide global table of all mounted - * ZIP archive files. - */ - -static struct { - int initialized; /* True when initialized */ - int lock; /* RW lock, see below */ - int waiters; /* RW lock, see below */ - int wrmax; /* Maximum write size of a file */ - int idCount; /* Counter for channel names */ - Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ - Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ -} ZipFS = { - 0, 0, 0, 0, 0, -}; - -/* - * For password rotation. - */ - -static const char pwrot[16] = { - 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, - 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 -}; - -/* - * Table to compute CRC32. - */ - -static const unsigned int crc32tab[256] = { - 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, - 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, - 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, - 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de, - 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856, - 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9, - 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4, - 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b, - 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3, - 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a, - 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599, - 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924, - 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190, - 0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f, - 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e, - 0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01, - 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed, - 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950, - 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3, - 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2, - 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a, - 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5, - 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010, - 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f, - 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17, - 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6, - 0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615, - 0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8, - 0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344, - 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb, - 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a, - 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5, - 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1, - 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c, - 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef, - 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236, - 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe, - 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31, - 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c, - 0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713, - 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b, - 0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242, - 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1, - 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c, - 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278, - 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7, - 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66, - 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9, - 0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605, - 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8, - 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, - 0x2d02ef8d, -}; - -/* - *------------------------------------------------------------------------- - * - * ReadLock, WriteLock, Unlock -- - * - * POSIX like rwlock functions to support multiple readers - * and single writer on internal structs. - * - * Limitations: - * - a read lock cannot be promoted to a write lock - * - a write lock may not be nested - * - *------------------------------------------------------------------------- - */ - -TCL_DECLARE_MUTEX(ZipFSMutex) - -#ifdef TCL_THREADS - -static Tcl_Condition ZipFSCond; - -static void -ReadLock(void) -{ - Tcl_MutexLock(&ZipFSMutex); - while (ZipFS.lock < 0) { - ZipFS.waiters++; - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); - ZipFS.waiters--; - } - ZipFS.lock++; - Tcl_MutexUnlock(&ZipFSMutex); -} - -static void -WriteLock(void) -{ - Tcl_MutexLock(&ZipFSMutex); - while (ZipFS.lock != 0) { - ZipFS.waiters++; - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); - ZipFS.waiters--; - } - ZipFS.lock = -1; - Tcl_MutexUnlock(&ZipFSMutex); -} - -static void -Unlock(void) -{ - Tcl_MutexLock(&ZipFSMutex); - if (ZipFS.lock > 0) { - --ZipFS.lock; - } else if (ZipFS.lock < 0) { - ZipFS.lock = 0; - } - if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) { - Tcl_ConditionNotify(&ZipFSCond); - } - Tcl_MutexUnlock(&ZipFSMutex); -} - -#else - -#define ReadLock() do {} while (0) -#define WriteLock() do {} while (0) -#define Unlock() do {} while (0) - -#endif - -/* - *------------------------------------------------------------------------- - * - * DosTimeDate, ToDosTime, ToDosDate -- - * - * Functions to perform conversions between DOS time stamps - * and POSIX time_t. - * - *------------------------------------------------------------------------- - */ - -static time_t -DosTimeDate(int dosDate, int dosTime) -{ - struct tm tm; - time_t ret; - - memset(&tm, 0, sizeof (tm)); - tm.tm_year = (((dosDate & 0xfe00) >> 9) + 80); - tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1; - tm.tm_mday = dosDate & 0x1f; - tm.tm_hour = (dosTime & 0xf800) >> 11; - tm.tm_min = (dosTime & 0x7e) >> 5; - tm.tm_sec = (dosTime & 0x1f) << 1; - ret = mktime(&tm); - if (ret == (time_t) -1) { - /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */ - ret = (time_t) 315532800; - } - return ret; -} - -static int -ToDosTime(time_t when) -{ - struct tm *tmp, tm; - -#ifdef TCL_THREADS -#if defined(_WIN32) || defined(_WIN64) - /* Win32 uses thread local storage */ - tmp = localtime(&when); - tm = *tmp; -#else -#ifdef HAVE_LOCALTIME_R - tmp = &tm; - localtime_r(&when, tmp); -#else - Tcl_MutexLock(&localtimeMutex); - tmp = localtime(&when); - tm = *tmp; - Tcl_MutexUnlock(&localtimeMutex); -#endif -#endif -#else - tmp = localtime(&when); - tm = *tmp; -#endif - return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1); -} - -static int -ToDosDate(time_t when) -{ - struct tm *tmp, tm; - -#ifdef TCL_THREADS -#if defined(_WIN32) || defined(_WIN64) - /* Win32 uses thread local storage */ - tmp = localtime(&when); - tm = *tmp; -#else -#ifdef HAVE_LOCALTIME_R - tmp = &tm; - localtime_r(&when, tmp); -#else - Tcl_MutexLock(&localtimeMutex); - tmp = localtime(&when); - tm = *tmp; - Tcl_MutexUnlock(&localtimeMutex); -#endif -#endif -#else - tmp = localtime(&when); - tm = *tmp; -#endif - return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday; -} - -/* - *------------------------------------------------------------------------- - * - * CountSlashes -- - * - * This function counts the number of slashes in a pathname string. - * - * Results: - * Number of slashes found in string. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -CountSlashes(const char *string) -{ - int count = 0; - const char *p = string; - - while (*p != '\0') { - if (*p == '/') { - count++; - } - p++; - } - return count; -} - -/* - *------------------------------------------------------------------------- - * - * CanonicalPath -- - * - * This function computes the canonical path from a directory - * and file name components into the specified Tcl_DString. - * - * Results: - * Returns the pointer to the canonical path contained in the - * specified Tcl_DString. - * - * Side effects: - * Modifies the specified Tcl_DString. - * - *------------------------------------------------------------------------- - */ - -static char * -CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr) -{ - char *path; - int i, j, c, isunc = 0; - -#if HAS_DRIVES - if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && - (tail[1] == ':')) { - tail += 2; - } - /* UNC style path */ - if (tail[0] == '\\') { - root = ""; - ++tail; - } - if (tail[0] == '\\') { - root = "/"; - ++tail; - } -#endif - /* UNC style path */ - if ((root[0] == '/') && (root[1] == '/')) { - isunc = 1; - } - if (tail[0] == '/') { - root = ""; - ++tail; - isunc = 0; - } - if (tail[0] == '/') { - root = "/"; - ++tail; - isunc = 1; - } - i = strlen(root); - j = strlen(tail); - Tcl_DStringSetLength(dsPtr, i + j + 1); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - path[i++] = '/'; - memcpy(path + i, tail, j); -#if HAS_DRIVES - for (i = 0; path[i] != '\0'; i++) { - if (path[i] == '\\') { - path[i] = '/'; - } - } -#endif - for (i = j = 0; (c = path[i]) != '\0'; i++) { - if (c == '/') { - int c2 = path[i + 1]; - - if (c2 == '/') { - continue; - } - if (c2 == '.') { - int c3 = path[i + 2]; - - if ((c3 == '/') || (c3 == '\0')) { - i++; - continue; - } - if ((c3 == '.') && - ((path[i + 3] == '/') || (path [i + 3] == '\0'))) { - i += 2; - while ((j > 0) && (path[j - 1] != '/')) { - j--; - } - if (j > isunc) { - --j; - while ((j > 1 + isunc) && (path[j - 2] == '/')) { - j--; - } - } - continue; - } - } - } - path[j++] = c; - } - if (j == 0) { - path[j++] = '/'; - } - path[j] = 0; - Tcl_DStringSetLength(dsPtr, j); - return Tcl_DStringValue(dsPtr); -} - -/* - *------------------------------------------------------------------------- - * - * AbsolutePath -- - * - * This function computes the absolute path from a given - * (relative) path name into the specified Tcl_DString. - * - * Results: - * Returns the pointer to the absolute path contained in the - * specified Tcl_DString. - * - * Side effects: - * Modifies the specified Tcl_DString. - * - *------------------------------------------------------------------------- - */ - -static char * -AbsolutePath(const char *path, -#if HAS_DRIVES - int *drvPtr, -#endif - Tcl_DString *dsPtr) -{ - char *result; - -#if HAS_DRIVES - if (drvPtr != NULL) { - *drvPtr = 0; - } -#endif - if (*path == '~') { - Tcl_DStringAppend(dsPtr, path, -1); - return Tcl_DStringValue(dsPtr); - } - if ((*path != '/') -#if HAS_DRIVES - && (*path != '\\') && - (((*path != '\0') && (strchr(drvletters, *path) == NULL)) || - (path[1] != ':')) -#endif - ) { - Tcl_DString pwd; - - /* relative path */ - Tcl_DStringInit(&pwd); - Tcl_GetCwd(NULL, &pwd); - result = Tcl_DStringValue(&pwd); -#if HAS_DRIVES - if ((result[0] != '\0') && (strchr(drvletters, result[0]) != NULL) && - (result[1] == ':')) { - if (drvPtr != NULL) { - drvPtr[0] = result[0]; - if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) { - drvPtr[0] -= 'a' - 'A'; - } - } - result += 2; - } -#endif - result = CanonicalPath(result, path, dsPtr); - Tcl_DStringFree(&pwd); - } else { - /* absolute path */ -#if HAS_DRIVES - if ((path[0] != '\0') && (strchr(drvletters, path[0]) != NULL) && - (path[1] == ':')) { - if (drvPtr != NULL) { - drvPtr[0] = path[0]; - if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) { - drvPtr[0] -= 'a' - 'A'; - } - } - } -#endif - result = CanonicalPath("", path, dsPtr); - } - return result; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSLookup -- - * - * This function returns the ZIP entry struct corresponding to - * the ZIP archive member of the given file name. - * - * Results: - * Returns the pointer to ZIP entry struct or NULL if the - * the given file name could not be found in the global list - * of ZIP archive members. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static ZipEntry * -ZipFSLookup(char *filename) -{ - char *realname; - Tcl_HashEntry *hPtr; - ZipEntry *z; - Tcl_DString ds; -#if HAS_DRIVES - int drive = 0; -#endif - - Tcl_DStringInit(&ds); -#if HAS_DRIVES - realname = AbsolutePath(filename, &drive, &ds); -#else - realname = AbsolutePath(filename, &ds); -#endif - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, realname); - z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; - Tcl_DStringFree(&ds); -#if HAS_DRIVES - if ((z != NULL) && drive && (drive != z->zipfile->mntdrv)) { - z = NULL; - } -#endif - return z; -} - -#ifdef NEVER_USED - -/* - *------------------------------------------------------------------------- - * - * ZipFSLookupMount -- - * - * This function returns an indication if the given file name - * corresponds to a mounted ZIP archive file. - * - * Results: - * Returns true, if the given file name is a mounted ZIP archive file. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSLookupMount(char *filename) -{ - char *realname; - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - ZipFile *zf; - Tcl_DString ds; - int match = 0; -#if HAS_DRIVES - int drive = 0; -#endif - - Tcl_DStringInit(&ds); -#if HAS_DRIVES - realname = AbsolutePath(filename, &drive, &ds); -#else - realname = AbsolutePath(filename, &ds); -#endif - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { -#if HAS_DRIVES - if (drive && (drive != zf->mntdrv)) { - hPtr = Tcl_NextHashEntry(&search); - continue; - } -#endif - if (strcmp(zf->mntpt, realname) == 0) { - match = 1; - break; - } - } - hPtr = Tcl_NextHashEntry(&search); - } - Tcl_DStringFree(&ds); - return match; -} -#endif - -/* - *------------------------------------------------------------------------- - * - * ZipFSCloseArchive -- - * - * This function closes a mounted ZIP archive file. - * - * Results: - * None. - * - * Side effects: - * A memory mapped ZIP archive is unmapped, allocated memory is - * released. - * - *------------------------------------------------------------------------- - */ - -static void -ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) -{ -#if defined(_WIN32) || defined(_WIN64) - if ((zf->data != NULL) && (zf->tofree == NULL)) { - UnmapViewOfFile(zf->data); - zf->data = NULL; - } - if (zf->mh != INVALID_HANDLE_VALUE) { - CloseHandle(zf->mh); - } -#else - if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) { - munmap(zf->data, zf->length); - zf->data = MAP_FAILED; - } -#endif - if (zf->tofree != NULL) { - Tcl_Free((char *) zf->tofree); - zf->tofree = NULL; - } - Tcl_Close(interp, zf->chan); - zf->chan = NULL; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSOpenArchive -- - * - * This function opens a ZIP archive file for reading. An attempt - * is made to memory map that file. Otherwise it is read into - * an allocated memory buffer. The ZIP archive header is verified - * and must be valid for the function to succeed. When "needZip" - * is zero an embedded ZIP archive in an executable file is accepted. - * - * Results: - * TCL_OK on success, TCL_ERROR otherwise with an error message - * placed into the given "interp" if it is not NULL. - * - * Side effects: - * ZIP archive is memory mapped or read into allocated memory, - * the given ZipFile struct is filled with information about - * the ZIP archive file. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, - ZipFile *zf) -{ - int i; - ClientData handle; - unsigned char *p, *q; - -#if defined(_WIN32) || defined(_WIN64) - zf->data = NULL; - zf->mh = INVALID_HANDLE_VALUE; -#else - zf->data = MAP_FAILED; -#endif - zf->length = 0; - zf->nfiles = 0; - zf->baseoffs = zf->baseoffsp = 0; - zf->tofree = NULL; - zf->pwbuf[0] = 0; - zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0); - if (zf->chan == NULL) { - return TCL_ERROR; - } - if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { - if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") - != TCL_OK) { - goto error; - } - if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") - != TCL_OK) { - goto error; - } - zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal file size", -1)); - } - goto error; - } - Tcl_Seek(zf->chan, 0, SEEK_SET); - zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); - if (zf->tofree == NULL) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); - if (i != zf->length) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file read error", -1)); - } - goto error; - } - Tcl_Close(interp, zf->chan); - zf->chan = NULL; - } else { -#if defined(_WIN32) || defined(_WIN64) - zf->length = GetFileSize((HANDLE) handle, 0); - if ((zf->length == INVALID_FILE_SIZE) || - (zf->length < ZIP_CENTRAL_END_LEN)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid file size", -1)); - } - goto error; - } - zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0, - zf->length, 0); - if (zf->mh == INVALID_HANDLE_VALUE) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file mapping failed", -1)); - } - goto error; - } - zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length); - if (zf->data == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file mapping failed", -1)); - } - goto error; - } -#else - zf->length = lseek((int) (long) handle, 0, SEEK_END); - if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid file size", -1)); - } - goto error; - } - lseek((int) (long) handle, 0, SEEK_SET); - zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, - MAP_FILE | MAP_PRIVATE, - (int) (long) handle, 0); - if (zf->data == MAP_FAILED) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file mapping failed", -1)); - } - goto error; - } -#endif - } - p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; - while (p >= zf->data) { - if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { - if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { - break; - } - p -= ZIP_SIG_LEN; - } else { - --p; - } - } - if (p < zf->data) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong end signature", -1)); - } - goto error; - } - zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); - if (zf->nfiles == 0) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("empty archive", -1)); - } - goto error; - } - q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); - p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); - if ((p < zf->data) || (p > (zf->data + zf->length)) || - (q < zf->data) || (q > (zf->data + zf->length))) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("archive directory not found", -1)); - } - goto error; - } - zf->baseoffs = zf->baseoffsp = p - q; - zf->centoffs = p - zf->data; - q = p; - for (i = 0; i < zf->nfiles; i++) { - int pathlen, comlen, extra; - - if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong header length", -1)); - } - goto error; - } - if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong header signature", -1)); - } - goto error; - } - pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); - comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); - extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); - q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; - } - q = zf->data + zf->baseoffs; - if ((zf->baseoffs >= 6) && - (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { - i = q[-5]; - if (q - 5 - i > zf->data) { - zf->pwbuf[0] = i; - memcpy(zf->pwbuf + 1, q - 5 - i, i); - zf->baseoffsp -= i ? (5 + i) : 0; - } - } - return TCL_OK; - -error: - ZipFSCloseArchive(interp, zf); - return TCL_ERROR; -} - -/* - *------------------------------------------------------------------------- - * - * Tclzipfs_Mount -- - * - * This procedure is invoked to mount a given ZIP archive file on - * a given mountpoint with optional ZIP password. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * A ZIP archive file is read, analyzed and mounted, resources are - * allocated. - * - *------------------------------------------------------------------------- - */ - -int -Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, - const char *passwd) -{ - char *realname, *p; - int i, pwlen, isNew; - ZipFile *zf, zf0; - ZipEntry *z; - Tcl_HashEntry *hPtr; - Tcl_DString ds, dsm, fpBuf; - unsigned char *q; -#if HAS_DRIVES - int drive = 0; -#endif - - ReadLock(); - if (!ZipFS.initialized) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("not initialized", -1)); - } - Unlock(); - return TCL_ERROR; - } - if (zipname == NULL) { - Tcl_HashSearch search; - int ret = TCL_OK; - - i = 0; - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (interp != NULL) { - Tcl_AppendElement(interp, zf->mntpt); - Tcl_AppendElement(interp, zf->name); - } - ++i; - } - hPtr = Tcl_NextHashEntry(&search); - } - if (interp == NULL) { - ret = (i > 0) ? TCL_OK : TCL_BREAK; - } - Unlock(); - return ret; - } - if (mntpt == NULL) { - if (interp == NULL) { - Unlock(); - return TCL_OK; - } - Tcl_DStringInit(&ds); -#if HAS_DRIVES - p = AbsolutePath(zipname, &drive, &ds); -#else - p = AbsolutePath(zipname, &ds); -#endif - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, p); - if (hPtr != NULL) { - if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { -#if HAS_DRIVES - if (drive == zf->mntdrv) { - Tcl_Obj *string; - char drvbuf[3]; - - drvbuf[0] = zf->mntdrv; - drvbuf[1] = ':'; - drvbuf[2] = '\0'; - string = Tcl_NewStringObj(drvbuf, 2); - Tcl_AppendToObj(string, zf->mntpt, zf->mntptlen); - Tcl_SetObjResult(interp, string); - } -#else - Tcl_SetObjResult(interp, - Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); -#endif - } - } - Unlock(); - Tcl_DStringFree(&ds); - return TCL_OK; - } - Unlock(); - pwlen = 0; - if (passwd != NULL) { - pwlen = strlen(passwd); - if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); - } - return TCL_ERROR; - } - } - if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { - return TCL_ERROR; - } - Tcl_DStringInit(&ds); -#if HAS_DRIVES - realname = AbsolutePath(zipname, NULL, &ds); -#else - realname = AbsolutePath(zipname, &ds); -#endif - /* - * Mount point can come from Tcl_GetNameOfExecutable() - * which sometimes is a relative or otherwise denormalized path. - * But an absolute name is needed as mount point here. - */ - Tcl_DStringInit(&dsm); -#if HAS_DRIVES - mntpt = AbsolutePath(mntpt, &drive, &dsm); -#else - mntpt = AbsolutePath(mntpt, &dsm); -#endif - WriteLock(); - hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, realname, &isNew); - Tcl_DStringSetLength(&ds, 0); - if (!isNew) { - zf = (ZipFile *) Tcl_GetHashValue(hPtr); - if (interp != NULL) { - Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? - zf->mntpt : "/", "\"", (char *) NULL); - } - Unlock(); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsm); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; - } - if (strcmp(mntpt, "/") == 0) { - mntpt = ""; - } - zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); - if (zf == NULL) { - if (interp != NULL) { - Tcl_AppendResult(interp, "out of memory", (char *) NULL); - } - Unlock(); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsm); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; - } - *zf = zf0; - zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); - strcpy(zf->mntpt, mntpt); - zf->mntptlen = strlen(zf->mntpt); -#if HAS_DRIVES - for (p = zf->mntpt; *p != '\0'; p++) { - if (*p == '\\') { - *p = '/'; - } - } - zf->mntdrv = drive; -#endif - zf->entries = NULL; - zf->topents = NULL; - zf->nopen = 0; - Tcl_SetHashValue(hPtr, (ClientData) zf); - if ((zf->pwbuf[0] == 0) && pwlen) { - int k = 0; - - i = pwlen; - zf->pwbuf[k++] = i; - while (i > 0) { - zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | - pwrot[(passwd[i - 1] >> 4) & 0x0f]; - k++; - i--; - } - zf->pwbuf[k] = '\0'; - } - if (mntpt[0] != '\0') { - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = CountSlashes(mntpt); - z->zipfile = zf; - z->isdir = 1; - z->isenc = 0; - z->offset = zf->baseoffs; - z->crc32 = 0; - z->timestamp = 0; - z->nbyte = z->nbytecompr = 0; - z->cmeth = ZIP_COMPMETH_STORED; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); - if (!isNew) { - /* skip it */ - Tcl_Free((char *) z); - } else { - Tcl_SetHashValue(hPtr, (ClientData) z); - z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - z->next = zf->entries; - zf->entries = z; - } - } - q = zf->data + zf->centoffs; - Tcl_DStringInit(&fpBuf); - for (i = 0; i < zf->nfiles; i++) { - int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; - unsigned char *lq, *gq = NULL; - char *fullpath, *path; - - pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); - comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); - extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); - path = Tcl_DStringValue(&ds); - if ((pathlen > 0) && (path[pathlen - 1] == '/')) { - Tcl_DStringSetLength(&ds, pathlen - 1); - path = Tcl_DStringValue(&ds); - isdir = 1; - } - if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { - goto nextent; - } - lq = zf->data + zf->baseoffs + - zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); - if ((lq < zf->data) || (lq > (zf->data + zf->length))) { - goto nextent; - } - nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); - if (!isdir && (nbcompr == 0) && - (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && - (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { - gq = q; - nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); - } - offs = (lq - zf->data) - + ZIP_LOCAL_HEADER_LEN - + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) - + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); - if ((offs + nbcompr) > zf->length) { - goto nextent; - } - if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { -#ifdef ANDROID - /* - * When mounting the ZIP archive on the root directory try - * to remap top level regular files of the archive to - * /assets/.root/... since this directory should not be - * in a valid APK due to the leading dot in the file name - * component. This trick should make the files - * AndroidManifest.xml, resources.arsc, and classes.dex - * visible to Tcl. - */ - Tcl_DString ds2; - - Tcl_DStringInit(&ds2); - Tcl_DStringAppend(&ds2, "assets/.root/", -1); - Tcl_DStringAppend(&ds2, path, -1); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2)); - if (hPtr != NULL) { - /* should not happen but skip it anyway */ - Tcl_DStringFree(&ds2); - goto nextent; - } - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), - Tcl_DStringLength(&ds2)); - path = Tcl_DStringValue(&ds); - Tcl_DStringFree(&ds2); -#else - /* - * Regular files skipped when mounting on root. - */ - goto nextent; -#endif - } - Tcl_DStringSetLength(&fpBuf, 0); - fullpath = CanonicalPath(mntpt, path, &fpBuf); - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = CountSlashes(fullpath); - z->zipfile = zf; - z->isdir = isdir; - z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) - && (nbcompr > 12); - z->offset = offs; - if (gq != NULL) { - z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); - dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); - dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); - z->timestamp = DosTimeDate(dosDate, dosTime); - z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); - z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); - } else { - z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); - dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); - dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); - z->timestamp = DosTimeDate(dosDate, dosTime); - z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); - z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); - } - z->nbytecompr = nbcompr; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); - if (!isNew) { - /* should not happen but skip it anyway */ - Tcl_Free((char *) z); - } else { - Tcl_SetHashValue(hPtr, (ClientData) z); - z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - z->next = zf->entries; - zf->entries = z; - if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { - z->tnext = zf->topents; - zf->topents = z; - } - if (!z->isdir && (z->depth > 1)) { - char *dir, *end; - ZipEntry *zd; - - Tcl_DStringSetLength(&ds, strlen(z->name) + 8); - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, z->name, -1); - dir = Tcl_DStringValue(&ds); - end = strrchr(dir, '/'); - while ((end != NULL) && (end != dir)) { - Tcl_DStringSetLength(&ds, end - dir); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); - if (hPtr != NULL) { - break; - } - zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); - zd->name = NULL; - zd->tnext = NULL; - zd->depth = CountSlashes(dir); - zd->zipfile = zf; - zd->isdir = 1; - zd->isenc = 0; - zd->offset = z->offset; - zd->crc32 = 0; - zd->timestamp = z->timestamp; - zd->nbyte = zd->nbytecompr = 0; - zd->cmeth = ZIP_COMPMETH_STORED; - zd->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); - if (!isNew) { - /* should not happen but skip it anyway */ - Tcl_Free((char *) zd); - } else { - Tcl_SetHashValue(hPtr, (ClientData) zd); - zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - zd->next = zf->entries; - zf->entries = zd; - if ((mntpt[0] == '\0') && (zd->depth == 1)) { - zd->tnext = zf->topents; - zf->topents = zd; - } - } - end = strrchr(dir, '/'); - } - } - } -nextent: - q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; - } - Unlock(); - Tcl_DStringFree(&fpBuf); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsm); - Tcl_FSMountsChanged(NULL); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * Tclzipfs_Unmount -- - * - * This procedure is invoked to unmount a given ZIP archive. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * A mounted ZIP archive file is unmounted, resources are free'd. - * - *------------------------------------------------------------------------- - */ - -int -Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) -{ - char *realname; - ZipFile *zf; - ZipEntry *z, *znext; - Tcl_HashEntry *hPtr; - Tcl_DString ds; - int ret = TCL_OK, unmounted = 0; -#if HAS_DRIVES - int drive = 0; -#endif - - Tcl_DStringInit(&ds); -#if HAS_DRIVES - realname = AbsolutePath(zipname, &drive, &ds); -#else - realname = AbsolutePath(zipname, &ds); -#endif - WriteLock(); - if (!ZipFS.initialized) { - goto done; - } - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, realname); - if (hPtr == NULL) { - /* don't report error */ - goto done; - } - zf = (ZipFile *) Tcl_GetHashValue(hPtr); -#if HAS_DRIVES - if (drive != zf->mntdrv) { - /* don't report error */ - goto done; - } -#endif - if (zf->nopen > 0) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("filesystem is busy", -1)); - } - ret = TCL_ERROR; - goto done; - } - Tcl_DeleteHashEntry(hPtr); - for (z = zf->entries; z; z = znext) { - znext = z->next; - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); - if (hPtr) { - Tcl_DeleteHashEntry(hPtr); - } - if (z->data != NULL) { - Tcl_Free((char *) z->data); - } - Tcl_Free((char *) z); - } - ZipFSCloseArchive(interp, zf); - Tcl_Free((char *) zf); - unmounted = 1; -done: - Unlock(); - Tcl_DStringFree(&ds); - if (unmounted) { - Tcl_FSMountsChanged(NULL); - } - return ret; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSMountObjCmd -- - * - * This procedure is invoked to process the "zipfs::mount" command. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * A ZIP archive file is mounted, resources are allocated. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - if (objc > 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "?zipfile? ?mountpoint? ?password?"); - return TCL_ERROR; - } - return Tclzipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, - (objc > 2) ? Tcl_GetString(objv[2]) : NULL, - (objc > 3) ? Tcl_GetString(objv[3]) : NULL); -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSUnmountObjCmd -- - * - * This procedure is invoked to process the "zipfs::unmount" command. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * A mounted ZIP archive file is unmounted, resources are free'd. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); - return TCL_ERROR; - } - return Tclzipfs_Unmount(interp, Tcl_GetString(objv[1])); -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSMkKeyObjCmd -- - * - * This procedure is invoked to process the "zipfs::mkkey" command. - * It produces a rotated password to be embedded into an image file. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSMkKeyObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - int len, i = 0; - char *pw, pwbuf[264]; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "password"); - return TCL_ERROR; - } - pw = Tcl_GetString(objv[1]); - len = strlen(pw); - if (len == 0) { - return TCL_OK; - } - if ((len > 255) || (strchr(pw, 0xff) != NULL)) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); - return TCL_ERROR; - } - while (len > 0) { - int ch = pw[len - 1]; - - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - i++; - len--; - } - pwbuf[i] = i; - ++i; - pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); - pwbuf[i] = '\0'; - Tcl_AppendResult(interp, pwbuf, (char *) NULL); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * ZipAddFile -- - * - * This procedure is used by ZipFSMkZipOrImgCmd() to add a single - * file to the output ZIP archive file being written. A ZipEntry - * struct about the input file is added to the given fileHash table - * for later creation of the central ZIP directory. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Input file is read and (compressed and) written to the output - * ZIP archive file. - * - *------------------------------------------------------------------------- - */ - -static int -ZipAddFile(Tcl_Interp *interp, const char *path, const char *name, - Tcl_Channel out, const char *passwd, - char *buf, int bufsize, Tcl_HashTable *fileHash) -{ - Tcl_Channel in; - Tcl_HashEntry *hPtr; - ZipEntry *z; - z_stream stream; - const char *zpath; - int nbyte, nbytecompr, len, crc, flush, pos[3], zpathlen, olen; - int mtime = 0, isNew, align = 0, cmeth; - unsigned long keys[3], keys0[3]; - char obuf[4096]; - - zpath = name; - while (zpath != NULL && zpath[0] == '/') { - zpath++; - } - if ((zpath == NULL) || (zpath[0] == '\0')) { - return TCL_OK; - } - zpathlen = strlen(zpath); - if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { - Tcl_AppendResult(interp, "path too long for \"", path, "\"", - (char *) NULL); - return TCL_ERROR; - } - in = Tcl_OpenFileChannel(interp, path, "r", 0); - if ((in == NULL) || - (Tcl_SetChannelOption(interp, in, "-translation", "binary") - != TCL_OK) || - (Tcl_SetChannelOption(interp, in, "-encoding", "binary") - != TCL_OK)) { -#if defined(_WIN32) || defined(_WIN64) - /* hopefully a directory */ - if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { - Tcl_Close(interp, in); - return TCL_OK; - } -#endif - Tcl_Close(interp, in); - return TCL_ERROR; - } else { - Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); - Tcl_StatBuf statBuf; - - Tcl_IncrRefCount(pathObj); - if (Tcl_FSStat(pathObj, &statBuf) != -1) { - mtime = statBuf.st_mtime; - } - Tcl_DecrRefCount(pathObj); - } - Tcl_ResetResult(interp); - crc = 0; - nbyte = nbytecompr = 0; - while ((len = Tcl_Read(in, buf, bufsize)) > 0) { - crc = crc32(crc, (unsigned char *) buf, len); - nbyte += len; - } - if (len == -1) { - if (nbyte == 0) { - if (strcmp("illegal operation on a directory", - Tcl_PosixError(interp)) == 0) { - Tcl_Close(interp, in); - return TCL_OK; - } - } - Tcl_AppendResult(interp, "read error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - if (Tcl_Seek(in, 0, SEEK_SET) == -1) { - Tcl_AppendResult(interp, "seek error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - pos[0] = Tcl_Tell(out); - memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); - memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); - len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if (Tcl_Write(out, buf, len) != len) { -wrerr: - Tcl_AppendResult(interp, "write error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - if ((len + pos[0]) & 3) { - char abuf[8]; - - /* - * Align payload to next 4-byte boundary using a dummy extra - * entry similar to the zipalign tool from Android's SDK. - */ - align = 4 + ((len + pos[0]) & 3); - zip_write_short(abuf, 0xffff); - zip_write_short(abuf + 2, align - 4); - zip_write_int(abuf + 4, 0x03020100); - if (Tcl_Write(out, abuf, align) != align) { - goto wrerr; - } - } - if (passwd != NULL) { - int i, ch, tmp; - unsigned char kvbuf[24]; - Tcl_Obj *ret; - - init_keys(passwd, keys, crc32tab); - for (i = 0; i < 12 - 2; i++) { - if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) { - Tcl_AppendResult(interp, "PRNG error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - ret = Tcl_GetObjResult(interp); - if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) { - Tcl_Close(interp, in); - return TCL_ERROR; - } - kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); - } - Tcl_ResetResult(interp); - init_keys(passwd, keys, crc32tab); - for (i = 0; i < 12 - 2; i++) { - kvbuf[i] = (unsigned char) zencode(keys, crc32tab, - kvbuf[i + 12], tmp); - } - kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); - kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); - len = Tcl_Write(out, (char *) kvbuf, 12); - memset(kvbuf, 0, 24); - if (len != 12) { - Tcl_AppendResult(interp, "write error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - memcpy(keys0, keys, sizeof (keys0)); - nbytecompr += 12; - } - Tcl_Flush(out); - pos[2] = Tcl_Tell(out); - cmeth = ZIP_COMPMETH_DEFLATED; - memset(&stream, 0, sizeof (stream)); - stream.zalloc = Z_NULL; - stream.zfree = Z_NULL; - stream.opaque = Z_NULL; - if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) - != Z_OK) { - Tcl_AppendResult(interp, "compression init error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - do { - len = Tcl_Read(in, buf, bufsize); - if (len == -1) { - Tcl_AppendResult(interp, "read error on \"", path, "\"", - (char *) NULL); - deflateEnd(&stream); - Tcl_Close(interp, in); - return TCL_ERROR; - } - stream.avail_in = len; - stream.next_in = (unsigned char *) buf; - flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; - do { - stream.avail_out = sizeof (obuf); - stream.next_out = (unsigned char *) obuf; - len = deflate(&stream, flush); - if (len == Z_STREAM_ERROR) { - Tcl_AppendResult(interp, "deflate error on \"", path, "\"", - (char *) NULL); - deflateEnd(&stream); - Tcl_Close(interp, in); - return TCL_ERROR; - } - olen = sizeof (obuf) - stream.avail_out; - if (passwd != NULL) { - int i, tmp; - - for (i = 0; i < olen; i++) { - obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); - } - } - if (olen && (Tcl_Write(out, obuf, olen) != olen)) { - Tcl_AppendResult(interp, "write error", (char *) NULL); - deflateEnd(&stream); - Tcl_Close(interp, in); - return TCL_ERROR; - } - nbytecompr += olen; - } while (stream.avail_out == 0); - } while (flush != Z_FINISH); - deflateEnd(&stream); - Tcl_Flush(out); - pos[1] = Tcl_Tell(out); - if (nbyte - nbytecompr <= 0) { - /* - * Compressed file larger than input, - * write it again uncompressed. - */ - if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { - goto seekErr; - } - if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { -seekErr: - Tcl_Close(interp, in); - Tcl_AppendResult(interp, "seek error", (char *) NULL); - return TCL_ERROR; - } - nbytecompr = (passwd != NULL) ? 12 : 0; - while (1) { - len = Tcl_Read(in, buf, bufsize); - if (len == -1) { - Tcl_AppendResult(interp, "read error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } else if (len == 0) { - break; - } - if (passwd != NULL) { - int i, tmp; - - for (i = 0; i < len; i++) { - buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); - } - } - if (Tcl_Write(out, buf, len) != len) { - Tcl_AppendResult(interp, "write error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - nbytecompr += len; - } - cmeth = ZIP_COMPMETH_STORED; - Tcl_Flush(out); - pos[1] = Tcl_Tell(out); - Tcl_TruncateChannel(out, pos[1]); - } - Tcl_Close(interp, in); - - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = 0; - z->zipfile = NULL; - z->isdir = 0; - z->isenc = (passwd != NULL) ? 1 : 0; - z->offset = pos[0]; - z->crc32 = crc; - z->timestamp = mtime; - z->nbyte = nbyte; - z->nbytecompr = nbytecompr; - z->cmeth = cmeth; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew); - if (!isNew) { - Tcl_AppendResult(interp, "non-unique path name \"", path, "\"", - (char *) NULL); - Tcl_Free((char *) z); - return TCL_ERROR; - } else { - Tcl_SetHashValue(hPtr, (ClientData) z); - z->name = Tcl_GetHashKey(fileHash, hPtr); - z->next = NULL; - } - - /* - * Write final local header information. - */ - zip_write_int(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG); - zip_write_short(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION); - zip_write_short(buf + ZIP_LOCAL_FLAGS_OFFS, z->isenc); - zip_write_short(buf + ZIP_LOCAL_COMPMETH_OFFS, z->cmeth); - zip_write_short(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp)); - zip_write_short(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp)); - zip_write_int(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32); - zip_write_int(buf + ZIP_LOCAL_COMPLEN_OFFS, z->nbytecompr); - zip_write_int(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->nbyte); - zip_write_short(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen); - zip_write_short(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); - if ((int) Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { - Tcl_DeleteHashEntry(hPtr); - Tcl_Free((char *) z); - Tcl_AppendResult(interp, "seek error", (char *) NULL); - return TCL_ERROR; - } - if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { - Tcl_DeleteHashEntry(hPtr); - Tcl_Free((char *) z); - Tcl_AppendResult(interp, "write error", (char *) NULL); - return TCL_ERROR; - } - Tcl_Flush(out); - if ((int) Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { - Tcl_DeleteHashEntry(hPtr); - Tcl_Free((char *) z); - Tcl_AppendResult(interp, "seek error", (char *) NULL); - return TCL_ERROR; - } - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSMkZipOrImgObjCmd -- - * - * This procedure is creates a new ZIP archive file or image file - * given output filename, input directory of files to be archived, - * optional password, and optional image to be prepended to the - * output ZIP archive file. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * A new ZIP archive file or image file is written. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, - int isImg, int isList, int objc, Tcl_Obj *const objv[]) -{ - Tcl_Channel out; - int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3]; - Tcl_Obj **lobjv, *list = NULL; - ZipEntry *z; - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - Tcl_HashTable fileHash; - char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096]; - - if (isList) { - if ((objc < 3) || (objc > (isImg ? 5 : 4))) { - Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile inlist ?password infile?" : - "outfile inlist ?password?"); - return TCL_ERROR; - } - } else { - if ((objc < 3) || (objc > (isImg ? 6 : 5))) { - Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile indir ?strip? ?password? ?infile?" : - "outfile indir ?strip? ?password?"); - return TCL_ERROR; - } - } - pwbuf[0] = 0; - if (objc > (isList ? 3 : 4)) { - pw = Tcl_GetString(objv[isList ? 3 : 4]); - pwlen = strlen(pw); - if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); - return TCL_ERROR; - } - } - if (isList) { - list = objv[2]; - Tcl_IncrRefCount(list); - } else { - Tcl_Obj *cmd[3]; - - cmd[1] = Tcl_NewStringObj("::zipfs::find", -1); - cmd[2] = objv[2]; - cmd[0] = Tcl_NewListObj(2, cmd + 1); - Tcl_IncrRefCount(cmd[0]); - if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_DecrRefCount(cmd[0]); - return TCL_ERROR; - } - Tcl_DecrRefCount(cmd[0]); - list = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(list); - } - if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { - Tcl_DecrRefCount(list); - return TCL_ERROR; - } - if (isList && (lobjc % 2)) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, - Tcl_NewStringObj("need even number of elements", -1)); - return TCL_ERROR; - } - if (lobjc == 0) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); - return TCL_ERROR; - } - out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755); - if ((out == NULL) || - (Tcl_SetChannelOption(interp, out, "-translation", "binary") - != TCL_OK) || - (Tcl_SetChannelOption(interp, out, "-encoding", "binary") - != TCL_OK)) { - Tcl_DecrRefCount(list); - Tcl_Close(interp, out); - return TCL_ERROR; - } - if (isImg) { - ZipFile zf0; - const char *imgName; - - if (isList) { - imgName = (objc > 4) ? Tcl_GetString(objv[4]) : - Tcl_GetNameOfExecutable(); - } else { - imgName = (objc > 5) ? Tcl_GetString(objv[5]) : - Tcl_GetNameOfExecutable(); - } - if (ZipFSOpenArchive(interp, imgName, 0, &zf0) != TCL_OK) { - Tcl_DecrRefCount(list); - Tcl_Close(interp, out); - return TCL_ERROR; - } - if ((pw != NULL) && pwlen) { - i = 0; - len = pwlen; - while (len > 0) { - int ch = pw[len - 1]; - - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - i++; - len--; - } - pwbuf[i] = i; - ++i; - pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); - pwbuf[i] = '\0'; - } - i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); - if (i != zf0.baseoffsp) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - Tcl_Close(interp, out); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; - } - ZipFSCloseArchive(interp, &zf0); - len = strlen(pwbuf); - if (len > 0) { - i = Tcl_Write(out, pwbuf, len); - if (i != len) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - Tcl_Close(interp, out); - return TCL_ERROR; - } - } - memset(pwbuf, 0, sizeof (pwbuf)); - Tcl_Flush(out); - } - Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); - pos[0] = Tcl_Tell(out); - if (!isList && (objc > 3)) { - strip = Tcl_GetString(objv[3]); - slen = strlen(strip); - } - for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { - const char *path, *name; - - path = Tcl_GetString(lobjv[i]); - if (isList) { - name = Tcl_GetString(lobjv[i + 1]); - } else { - name = path; - if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { - continue; - } - name += slen; - } - } - while (name[0] == '/') { - ++name; - } - if (name[0] == '\0') { - continue; - } - if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), - &fileHash) != TCL_OK) { - goto done; - } - } - pos[1] = Tcl_Tell(out); - count = 0; - for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { - const char *path, *name; - - path = Tcl_GetString(lobjv[i]); - if (isList) { - name = Tcl_GetString(lobjv[i + 1]); - } else { - name = path; - if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { - continue; - } - name += slen; - } - } - while (name[0] == '/') { - ++name; - } - if (name[0] == '\0') { - continue; - } - hPtr = Tcl_FindHashEntry(&fileHash, name); - if (hPtr == NULL) { - continue; - } - z = (ZipEntry *) Tcl_GetHashValue(hPtr); - len = strlen(z->name); - zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); - zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); - zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); - zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0); - zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth); - zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); - zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); - zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); - zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr); - zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte); - zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len); - zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); - zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); - zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); - if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != - ZIP_CENTRAL_HEADER_LEN) || - (Tcl_Write(out, z->name, len) != len)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - goto done; - } - count++; - } - Tcl_Flush(out); - pos[2] = Tcl_Tell(out); - zip_write_int(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG); - zip_write_short(buf + ZIP_CENTRAL_DISKNO_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_ENTS_OFFS, count); - zip_write_short(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count); - zip_write_int(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]); - zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]); - zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); - if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - goto done; - } - Tcl_Flush(out); - ret = TCL_OK; -done: - if (ret == TCL_OK) { - ret = Tcl_Close(interp, out); - } else { - Tcl_Close(interp, out); - } - Tcl_DecrRefCount(list); - hPtr = Tcl_FirstHashEntry(&fileHash, &search); - while (hPtr != NULL) { - z = (ZipEntry *) Tcl_GetHashValue(hPtr); - Tcl_Free((char *) z); - Tcl_DeleteHashEntry(hPtr); - hPtr = Tcl_FirstHashEntry(&fileHash, &search); - } - Tcl_DeleteHashTable(&fileHash); - return ret; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSMkZipObjCmd -- - * - * This procedure is invoked to process the "zipfs::mkzip" command. - * See description of ZipFSMkZipOrImgCmd(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See description of ZipFSMkZipOrImgCmd(). - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv); -} - -static int -ZipFSLMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv); -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSMkImgObjCmd -- - * - * This procedure is invoked to process the "zipfs::mkimg" command. - * See description of ZipFSMkZipOrImgCmd(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See description of ZipFSMkZipOrImgCmd(). - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv); -} - -static int -ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv); -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSExistsObjCmd -- - * - * This procedure is invoked to process the "zipfs::exists" command. - * It tests for the existence of a file in the ZIP filesystem and - * places a boolean into the interp's result. - * - * Results: - * Always TCL_OK. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - char *filename; - int exists; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "filename"); - return TCL_ERROR; - } - filename = Tcl_GetStringFromObj(objv[1], 0); - ReadLock(); - exists = ZipFSLookup(filename) != NULL; - Unlock(); - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), exists); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSInfoObjCmd -- - * - * This procedure is invoked to process the "zipfs::info" command. - * On success, it returns a Tcl list made up of name of ZIP archive - * file, size uncompressed, size compressed, and archive offset of - * a file in the ZIP filesystem. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - char *filename; - ZipEntry *z; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "filename"); - return TCL_ERROR; - } - filename = Tcl_GetStringFromObj(objv[1], 0); - ReadLock(); - z = ZipFSLookup(filename); - if (z != NULL) { - Tcl_Obj *result = Tcl_GetObjResult(interp); - - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->zipfile->name, -1)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset)); - } - Unlock(); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * ZipFSListObjCmd -- - * - * This procedure is invoked to process the "zipfs::list" command. - * On success, it returns a Tcl list of files of the ZIP filesystem - * which match a search pattern (glob or regexp). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ - char *pattern = NULL; - Tcl_RegExp regexp = NULL; - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - Tcl_Obj *result = Tcl_GetObjResult(interp); - - if (objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); - return TCL_ERROR; - } - if (objc == 3) { - int n; - char *what = Tcl_GetStringFromObj(objv[1], &n); - - if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { - pattern = Tcl_GetString(objv[2]); - } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { - regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); - if (regexp == NULL) { - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "unknown option \"", what, - "\"", (char *) NULL); - return TCL_ERROR; - } - } else if (objc == 2) { - pattern = Tcl_GetStringFromObj(objv[1], 0); - } - ReadLock(); - if (pattern != NULL) { - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if (Tcl_StringMatch(z->name, pattern)) { - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, -1)); - } - } - } else if (regexp != NULL) { - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, -1)); - } - } - } else { - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, -1)); - } - } - Unlock(); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * ZipChannelClose -- - * - * This function is called to close a channel. - * - * Results: - * Always TCL_OK. - * - * Side effects: - * Resources are free'd. - * - *------------------------------------------------------------------------- - */ - -static int -ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) -{ - ZipChannel *info = (ZipChannel *) instanceData; - - if (info->iscompr && (info->ubuf != NULL)) { - Tcl_Free((char *) info->ubuf); - info->ubuf = NULL; - } - if (info->isenc) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - } - if (info->iswr) { - ZipEntry *z = info->zipentry; - unsigned char *newdata; - - newdata = (unsigned char *) - Tcl_AttemptRealloc((char *) info->ubuf, info->nread); - if (newdata != NULL) { - if (z->data != NULL) { - Tcl_Free((char *) z->data); - } - z->data = newdata; - z->nbyte = z->nbytecompr = info->nbyte; - z->cmeth = ZIP_COMPMETH_STORED; - z->timestamp = time(NULL); - z->isdir = 0; - z->isenc = 0; - z->offset = 0; - z->crc32 = 0; - } else { - Tcl_Free((char *) info->ubuf); - } - } - WriteLock(); - info->zipfile->nopen--; - Unlock(); - Tcl_Free((char *) info); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * ZipChannelRead -- - * - * This function is called to read data from channel. - * - * Results: - * Number of bytes read or -1 on error with error number set. - * - * Side effects: - * Data is read and file pointer is advanced. - * - *------------------------------------------------------------------------- - */ - -static int -ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) -{ - ZipChannel *info = (ZipChannel *) instanceData; - unsigned long nextpos; - - if (info->isdir) { - *errloc = EISDIR; - return -1; - } - nextpos = info->nread + toRead; - if (nextpos > info->nbyte) { - toRead = info->nbyte - info->nread; - nextpos = info->nbyte; - } - if (toRead == 0) { - return 0; - } - if (info->isenc) { - int i, ch; - - for (i = 0; i < toRead; i++) { - ch = info->ubuf[i + info->nread]; - buf[i] = zdecode(info->keys, crc32tab, ch); - } - } else { - memcpy(buf, info->ubuf + info->nread, toRead); - } - info->nread = nextpos; - *errloc = 0; - return toRead; -} - -/* - *------------------------------------------------------------------------- - * - * ZipChannelWrite -- - * - * This function is called to write data into channel. - * - * Results: - * Number of bytes written or -1 on error with error number set. - * - * Side effects: - * Data is written and file pointer is advanced. - * - *------------------------------------------------------------------------- - */ - -static int -ZipChannelWrite(ClientData instanceData, const char *buf, - int toWrite, int *errloc) -{ - ZipChannel *info = (ZipChannel *) instanceData; - unsigned long nextpos; - - if (!info->iswr) { - *errloc = EINVAL; - return -1; - } - nextpos = info->nread + toWrite; - if (nextpos > info->nmax) { - toWrite = info->nmax - info->nread; - nextpos = info->nmax; - } - if (toWrite == 0) { - return 0; - } - memcpy(info->ubuf + info->nread, buf, toWrite); - info->nread = nextpos; - if (info->nread > info->nbyte) { - info->nbyte = info->nread; - } - *errloc = 0; - return toWrite; -} - -/* - *------------------------------------------------------------------------- - * - * ZipChannelSeek -- - * - * This function is called to position file pointer of channel. - * - * Results: - * New file position or -1 on error with error number set. - * - * Side effects: - * File pointer is repositioned according to offset and mode. - * - *------------------------------------------------------------------------- - */ - -static int -ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) -{ - ZipChannel *info = (ZipChannel *) instanceData; - - if (info->isdir) { - *errloc = EINVAL; - return -1; - } - switch (mode) { - case SEEK_CUR: - offset += info->nread; - break; - case SEEK_END: - offset += info->nbyte; - break; - case SEEK_SET: - break; - default: - *errloc = EINVAL; - return -1; - } - if (offset < 0) { - *errloc = EINVAL; - return -1; - } - if (info->iswr) { - if ((unsigned long) offset > info->nmax) { - *errloc = EINVAL; - return -1; - } - if ((unsigned long) offset > info->nbyte) { - info->nbyte = offset; - } - } else if ((unsigned long) offset > info->nbyte) { - *errloc = EINVAL; - return -1; - } - info->nread = (unsigned long) offset; - return info->nread; -} - -/* - *------------------------------------------------------------------------- - * - * ZipChannelWatchChannel -- - * - * This function is called for event notifications on channel. - * - * Results: - * None. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static void -ZipChannelWatchChannel(ClientData instanceData, int mask) -{ - return; -} - -/* - *------------------------------------------------------------------------- - * - * ZipChannelGetFile -- - * - * This function is called to retrieve OS handle for channel. - * - * Results: - * Always TCL_ERROR since there's never an OS handle for a - * file within a ZIP archive. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -ZipChannelGetFile(ClientData instanceData, int direction, - ClientData *handlePtr) -{ - return TCL_ERROR; -} - -/* - * The channel type/driver definition used for ZIP archive members. - */ - -static Tcl_ChannelType ZipChannelType = { - "zip", /* Type name. */ -#ifdef TCL_CHANNEL_VERSION_4 - TCL_CHANNEL_VERSION_4, - ZipChannelClose, /* Close channel, clean instance data */ - ZipChannelRead, /* Handle read request */ - ZipChannelWrite, /* Handle write request */ - ZipChannelSeek, /* Move location of access point, NULL'able */ - NULL, /* Set options, NULL'able */ - NULL, /* Get options, NULL'able */ - ZipChannelWatchChannel, /* Initialize notifier */ - ZipChannelGetFile, /* Get OS handle from the channel */ - NULL, /* 2nd version of close channel, NULL'able */ - NULL, /* Set blocking mode for raw channel, NULL'able */ - NULL, /* Function to flush channel, NULL'able */ - NULL, /* Function to handle event, NULL'able */ - NULL, /* Wide seek function, NULL'able */ - NULL, /* Thread action function, NULL'able */ -#else - NULL, /* Set blocking/nonblocking behaviour, NULL'able */ - ZipChannelClose, /* Close channel, clean instance data */ - ZipChannelRead, /* Handle read request */ - ZipChannelWrite, /* Handle write request */ - ZipChannelSeek, /* Move location of access point, NULL'able */ - NULL, /* Set options, NULL'able */ - NULL, /* Get options, NULL'able */ - ZipChannelWatchChannel, /* Initialize notifier */ - ZipChannelGetFile, /* Get OS handle from the channel */ -#endif -}; - -/* - *------------------------------------------------------------------------- - * - * ZipChannelOpen -- - * - * This function opens a Tcl_Channel on a file from a mounted ZIP - * archive according to given open mode. - * - * Results: - * Tcl_Channel on success, or NULL on error. - * - * Side effects: - * Memory is allocated, the file from the ZIP archive is uncompressed. - * - *------------------------------------------------------------------------- - */ - -static Tcl_Channel -ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) -{ - ZipEntry *z; - ZipChannel *info; - int i, ch, trunc, wr, flags = 0; - char cname[128]; - - if ((mode & O_APPEND) || - ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); - } - return NULL; - } - WriteLock(); - z = ZipFSLookup(filename); - if (z == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); - } - goto error; - } - trunc = (mode & O_TRUNC) != 0; - wr = (mode & (O_WRONLY | O_RDWR)) != 0; - if ((z->cmeth != ZIP_COMPMETH_STORED) && - (z->cmeth != ZIP_COMPMETH_DEFLATED)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("unsupported compression method", -1)); - } - goto error; - } - if (wr && z->isdir) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("unsupported file type", -1)); - } - goto error; - } - if (!trunc) { - flags |= TCL_READABLE; - if (z->isenc && (z->zipfile->pwbuf[0] == 0)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("decryption failed", -1)); - } - goto error; - } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file too large", -1)); - } - goto error; - } - } else { - flags = TCL_WRITABLE; - } - info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info)); - if (info == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - info->zipfile = z->zipfile; - info->zipentry = z; - info->nread = 0; - if (wr) { - flags |= TCL_WRITABLE; - info->iswr = 1; - info->isdir = 0; - info->nmax = ZipFS.wrmax; - info->iscompr = 0; - info->isenc = 0; - info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax); - if (info->ubuf == NULL) { -merror0: - if (info->ubuf != NULL) { - Tcl_Free((char *) info->ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - memset(info->ubuf, 0, info->nmax); - if (trunc) { - info->nbyte = 0; - } else { - if (z->data != NULL) { - unsigned int j = z->nbyte; - - if (j > info->nmax) { - j = info->nmax; - } - memcpy(info->ubuf, z->data, j); - info->nbyte = j; - } else { - unsigned char *zbuf = z->zipfile->data + z->offset; - - if (z->isenc) { - int len = z->zipfile->pwbuf[0]; - char pwbuf[260]; - - for (i = 0; i < len; i++) { - ch = z->zipfile->pwbuf[len - i]; - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - } - pwbuf[i] = '\0'; - init_keys(pwbuf, info->keys, crc32tab); - memset(pwbuf, 0, sizeof (pwbuf)); - for (i = 0; i < 12; i++) { - ch = info->ubuf[i]; - zdecode(info->keys, crc32tab, ch); - } - zbuf += i; - } - if (z->cmeth == ZIP_COMPMETH_DEFLATED) { - z_stream stream; - int err; - unsigned char *cbuf = NULL; - - memset(&stream, 0, sizeof (stream)); - stream.zalloc = Z_NULL; - stream.zfree = Z_NULL; - stream.opaque = Z_NULL; - stream.avail_in = z->nbytecompr; - if (z->isenc) { - unsigned int j; - - stream.avail_in -= 12; - cbuf = (unsigned char *) - Tcl_AttemptAlloc(stream.avail_in); - if (cbuf == NULL) { - goto merror0; - } - for (j = 0; j < stream.avail_in; j++) { - ch = info->ubuf[j]; - cbuf[j] = zdecode(info->keys, crc32tab, ch); - } - stream.next_in = cbuf; - } else { - stream.next_in = zbuf; - } - stream.next_out = info->ubuf; - stream.avail_out = info->nmax; - if (inflateInit2(&stream, -15) != Z_OK) { - goto cerror0; - } - err = inflate(&stream, Z_SYNC_FLUSH); - inflateEnd(&stream); - if ((err == Z_STREAM_END) || - ((err == Z_OK) && (stream.avail_in == 0))) { - if (cbuf != NULL) { - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) cbuf); - } - goto wrapchan; - } -cerror0: - if (cbuf != NULL) { - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) cbuf); - } - if (info->ubuf != NULL) { - Tcl_Free((char *) info->ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("decompression error", -1)); - } - goto error; - } else if (z->isenc) { - for (i = 0; i < z->nbyte - 12; i++) { - ch = zbuf[i]; - info->ubuf[i] = zdecode(info->keys, crc32tab, ch); - } - } else { - memcpy(info->ubuf, zbuf, z->nbyte); - } - memset(info->keys, 0, sizeof (info->keys)); - goto wrapchan; - } - } - } else if (z->data != NULL) { - flags |= TCL_READABLE; - info->iswr = 0; - info->iscompr = 0; - info->isdir = 0; - info->isenc = 0; - info->nbyte = z->nbyte; - info->nmax = 0; - info->ubuf = z->data; - } else { - flags |= TCL_READABLE; - info->iswr = 0; - info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED; - info->ubuf = z->zipfile->data + z->offset; - info->isdir = z->isdir; - info->isenc = z->isenc; - info->nbyte = z->nbyte; - info->nmax = 0; - if (info->isenc) { - int len = z->zipfile->pwbuf[0]; - char pwbuf[260]; - - for (i = 0; i < len; i++) { - ch = z->zipfile->pwbuf[len - i]; - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - } - pwbuf[i] = '\0'; - init_keys(pwbuf, info->keys, crc32tab); - memset(pwbuf, 0, sizeof (pwbuf)); - for (i = 0; i < 12; i++) { - ch = info->ubuf[i]; - zdecode(info->keys, crc32tab, ch); - } - info->ubuf += i; - } - if (info->iscompr) { - z_stream stream; - int err; - unsigned char *ubuf = NULL; - unsigned int j; - - memset(&stream, 0, sizeof (stream)); - stream.zalloc = Z_NULL; - stream.zfree = Z_NULL; - stream.opaque = Z_NULL; - stream.avail_in = z->nbytecompr; - if (info->isenc) { - stream.avail_in -= 12; - ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); - if (ubuf == NULL) { - info->ubuf = NULL; - goto merror; - } - for (j = 0; j < stream.avail_in; j++) { - ch = info->ubuf[j]; - ubuf[j] = zdecode(info->keys, crc32tab, ch); - } - stream.next_in = ubuf; - } else { - stream.next_in = info->ubuf; - } - stream.next_out = info->ubuf = - (unsigned char *) Tcl_AttemptAlloc(info->nbyte); - if (info->ubuf == NULL) { -merror: - if (ubuf != NULL) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - stream.avail_out = info->nbyte; - if (inflateInit2(&stream, -15) != Z_OK) { - goto cerror; - } - err = inflate(&stream, Z_SYNC_FLUSH); - inflateEnd(&stream); - if ((err == Z_STREAM_END) || - ((err == Z_OK) && (stream.avail_in == 0))) { - if (ubuf != NULL) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) ubuf); - } - goto wrapchan; - } -cerror: - if (ubuf != NULL) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) ubuf); - } - if (info->ubuf != NULL) { - Tcl_Free((char *) info->ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("decompression error", -1)); - } - goto error; - } - } -wrapchan: - sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, ZipFS.idCount++); - z->zipfile->nopen++; - Unlock(); - return Tcl_CreateChannel(&ZipChannelType, cname, (ClientData) info, flags); - -error: - Unlock(); - return NULL; -} - -/* - *------------------------------------------------------------------------- - * - * ZipEntryStat -- - * - * This function implements the ZIP filesystem specific version - * of the library version of stat. - * - * Results: - * See stat documentation. - * - * Side effects: - * See stat documentation. - * - *------------------------------------------------------------------------- - */ - -static int -ZipEntryStat(char *path, Tcl_StatBuf *buf) -{ - ZipEntry *z; - int ret = -1; - - ReadLock(); - z = ZipFSLookup(path); - if (z == NULL) { - goto done; - } - memset(buf, 0, sizeof (Tcl_StatBuf)); - if (z->isdir) { - buf->st_mode = S_IFDIR | 0555; - } else { - buf->st_mode = S_IFREG | 0555; - } - buf->st_size = z->nbyte; - buf->st_mtime = z->timestamp; - buf->st_ctime = z->timestamp; - buf->st_atime = z->timestamp; - ret = 0; -done: - Unlock(); - return ret; -} - -/* - *------------------------------------------------------------------------- - * - * ZipEntryAccess -- - * - * This function implements the ZIP filesystem specific version - * of the library version of access. - * - * Results: - * See access documentation. - * - * Side effects: - * See access documentation. - * - *------------------------------------------------------------------------- - */ - -static int -ZipEntryAccess(char *path, int mode) -{ - ZipEntry *z; - - if (mode & 3) { - return -1; - } - ReadLock(); - z = ZipFSLookup(path); - Unlock(); - return (z != NULL) ? 0 : -1; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSOpenFileChannelProc -- - * - * Results: - * - * Side effects: - * - *------------------------------------------------------------------------- - */ - -static Tcl_Channel -Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, - int mode, int permissions) -{ - int len; - - return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), - mode, permissions); -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSStatProc -- - * - * This function implements the ZIP filesystem specific version - * of the library version of stat. - * - * Results: - * See stat documentation. - * - * Side effects: - * See stat documentation. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) -{ - int len; - - return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSAccessProc -- - * - * This function implements the ZIP filesystem specific version - * of the library version of access. - * - * Results: - * See access documentation. - * - * Side effects: - * See access documentation. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) -{ - int len; - - return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSFilesystemSeparatorProc -- - * - * This function returns the separator to be used for a given path. The - * object returned should have a refCount of zero - * - * Results: - * A Tcl object, with a refCount of zero. If the caller needs to retain a - * reference to the object, it should call Tcl_IncrRefCount, and should - * otherwise free the object. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static Tcl_Obj * -Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) -{ - return Tcl_NewStringObj("/", -1); -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSMatchInDirectoryProc -- - * - * This routine is used by the globbing code to search a directory for - * all files which match a given pattern. - * - * Results: - * The return value is a standard Tcl result indicating whether an - * error occurred in globbing. Errors are left in interp, good - * results are lappend'ed to resultPtr (which must be a valid object). - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, - Tcl_Obj *pathPtr, const char *pattern, - Tcl_GlobTypeData *types) -{ - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; - char *pat, *prefix, *path; -#if HAS_DRIVES - char drivePrefix[3]; -#endif - Tcl_DString ds, dsPref; - -#if HAS_DRIVES - if ((pattern != NULL) && (pattern[0] != '\0') && - (strchr(drvletters, pattern[0]) != NULL) && (pattern[1] == ':')) { - pattern += 2; - } -#endif - if (types != NULL) { - dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; - } - Tcl_DStringInit(&ds); - Tcl_DStringInit(&dsPref); - prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); - Tcl_DStringAppend(&dsPref, prefix, prefixLen); - prefix = Tcl_DStringValue(&dsPref); -#if HAS_DRIVES - path = AbsolutePath(prefix, NULL, &ds); -#else - path = AbsolutePath(prefix, &ds); -#endif - len = Tcl_DStringLength(&ds); - if (strcmp(prefix, path) == 0) { - prefix = NULL; - } else { -#if HAS_DRIVES - if ((strchr(drvletters, prefix[0]) != NULL) && (prefix[1] == ':')) { - if (strcmp(prefix + 2, path) == 0) { - strncpy(drivePrefix, prefix, 3); - drivePrefix[2] = '\0'; - prefix = drivePrefix; - } - } else { - strip = len + 1; - } -#else - strip = len + 1; -#endif - } - if (prefix != NULL) { -#if HAS_DRIVES - if (prefix == drivePrefix) { - Tcl_DStringSetLength(&dsPref, 0); - Tcl_DStringAppend(&dsPref, drivePrefix, -1); - prefixLen = Tcl_DStringLength(&dsPref); - } else { - Tcl_DStringAppend(&dsPref, "/", 1); - prefixLen++; - } - prefix = Tcl_DStringValue(&dsPref); -#else - Tcl_DStringAppend(&dsPref, "/", 1); - prefixLen++; - prefix = Tcl_DStringValue(&dsPref); -#endif - } - ReadLock(); - if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { - l = CountSlashes(path); - if (path[len - 1] == '/') { - len--; - } else { - l++; - } - if ((pattern == NULL) || (pattern[0] == '\0')) { - pattern = "*"; - } - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); - - if (zf->mntptlen == 0) { - ZipEntry *z = zf->topents; - - while (z != NULL) { - int lenz = strlen(z->name); - - if ((lenz > len + 1) && - (strncmp(z->name, path, len) == 0) && - (z->name[len] == '/') && - (CountSlashes(z->name) == l) && - Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name, lenz); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name, lenz)); - } - } - z = z->tnext; - } - } else if ((zf->mntptlen > len + 1) && - (strncmp(zf->mntpt, path, len) == 0) && - (zf->mntpt[len] == '/') && - (CountSlashes(zf->mntpt) == l) && - Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); - } - } - hPtr = Tcl_NextHashEntry(&search); - } - goto end; - } - if ((pattern == NULL) || (pattern[0] == '\0')) { - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); - if (hPtr != NULL) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if ((dirOnly < 0) || - (!dirOnly && !z->isdir) || - (dirOnly && z->isdir)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name, -1); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name, -1)); - } - } - } - goto end; - } - l = strlen(pattern); - pat = Tcl_Alloc(len + l + 2); - memcpy(pat, path, len); - while ((len > 1) && (pat[len - 1] == '/')) { - --len; - } - if ((len > 1) || (pat[0] != '/')) { - pat[len] = '/'; - ++len; - } - memcpy(pat + len, pattern, l + 1); - scnt = CountSlashes(pat); - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if ((dirOnly >= 0) && - ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) { - continue; - } - if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name + strip, -1); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name + strip, -1)); - } - } - } - Tcl_Free(pat); -end: - Unlock(); - Tcl_DStringFree(&dsPref); - Tcl_DStringFree(&ds); - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSNormalizePathProc -- - * - * Function to normalize given path object. - * - * Results: - * Length of final absolute path name. - * - * Side effects: - * Path object gets converted to an absolute path. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSNormalizePathProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, - int nextCheckpoint) -{ - char *path; - Tcl_DString ds; - int len; - - path = Tcl_GetStringFromObj(pathPtr, &len); - Tcl_DStringInit(&ds); -#if HAS_DRIVES - path = AbsolutePath(path, NULL, &ds); -#else - path = AbsolutePath(path, &ds); -#endif - nextCheckpoint = Tcl_DStringLength(&ds); - Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - return nextCheckpoint; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSPathInFilesystemProc -- - * - * This function determines if the given path object is in the - * ZIP filesystem. - * - * Results: - * TCL_OK when the path object is in the ZIP filesystem, -1 otherwise. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) -{ - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - ZipFile *zf; - int ret = -1, len; - char *path; - Tcl_DString ds; -#if HAS_DRIVES - int drive = 0; -#endif - - path = Tcl_GetStringFromObj(pathPtr, &len); - Tcl_DStringInit(&ds); -#if HAS_DRIVES - path = AbsolutePath(path, &drive, &ds); -#else - path = AbsolutePath(path, &ds); -#endif - len = Tcl_DStringLength(&ds); -#if HAS_DRIVES - if (len && (strchr(drvletters, path[0]) != NULL) && (path[1] == ':')) { - path += 2; - len -= 2; - } -#endif - ReadLock(); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); - if (hPtr != NULL) { -#if HAS_DRIVES - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - if (drive == z->zipfile->mntdrv) { - ret = TCL_OK; - goto endloop; - } -#else - ret = TCL_OK; - goto endloop; -#endif - } - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - zf = (ZipFile *) Tcl_GetHashValue(hPtr); -#if HAS_DRIVES - if (drive != zf->mntdrv) { - hPtr = Tcl_NextHashEntry(&search); - continue; - } -#endif - if (zf->mntptlen == 0) { - ZipEntry *z = zf->topents; - - while (z != NULL) { - int lenz = strlen(z->name); - - if ((len >= lenz) && - (strncmp(path, z->name, lenz) == 0)) { - ret = TCL_OK; - goto endloop; - } - z = z->tnext; - } - } else if ((len >= zf->mntptlen) && - (strncmp(path, zf->mntpt, zf->mntptlen) == 0)) { - ret = TCL_OK; - goto endloop; - } - hPtr = Tcl_NextHashEntry(&search); - } -endloop: - Unlock(); - Tcl_DStringFree(&ds); - return ret; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSListVolumesProc -- - * - * Lists the currently mounted ZIP filesystem volumes. - * - * Results: - * The list of volumes. - * - * Side effects: - * None - * - *------------------------------------------------------------------------- - */ - -static Tcl_Obj * -Zip_FSListVolumesProc(void) -{ - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - ZipFile *zf; - Tcl_Obj *vols = Tcl_NewObj(), *vol; - - ReadLock(); - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - zf = (ZipFile *) Tcl_GetHashValue(hPtr); -#if HAS_DRIVES - vol = Tcl_ObjPrintf("%c:%s", zf->mntdrv, - zf->mntpt[0] ? zf->mntpt : "/"); -#else - if (zf->mntpt[0]) { - vol = Tcl_NewStringObj(zf->mntpt, zf->mntptlen); - } else { - vol = Tcl_NewStringObj("/", 1); - } -#endif - Tcl_ListObjAppendElement(NULL, vols, vol); - hPtr = Tcl_NextHashEntry(&search); - } - Unlock(); - Tcl_IncrRefCount(vols); - return vols; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSChdirProc -- - * - * If the path object refers to a directory within the ZIP - * filesystem the current directory is set to this directory. - * - * Results: - * TCL_OK on success, -1 on error with error number set. - * - * Side effects: - * The global cwdPathPtr may change value. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSChdirProc(Tcl_Obj *pathPtr) -{ - int len; - char *path; - Tcl_DString ds; - ZipEntry *z; - int ret = TCL_OK; -#if HAS_DRIVES - int drive = 0; -#endif - - path = Tcl_GetStringFromObj(pathPtr, &len); - Tcl_DStringInit(&ds); -#if HAS_DRIVES - path = AbsolutePath(path, &drive, &ds); -#else - path = AbsolutePath(path, &ds); -#endif - ReadLock(); - z = ZipFSLookup(path); - if ((z == NULL) || !z->isdir) { - Tcl_SetErrno(ENOENT); - ret = -1; - } -#if HAS_DRIVES - if ((z != NULL) && (drive != z->zipfile->mntdrv)) { - Tcl_SetErrno(ENOENT); - ret = -1; - } -#endif - Unlock(); - Tcl_DStringFree(&ds); - return ret; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSFileAttrStringsProc -- - * - * This function implements the ZIP filesystem dependent 'file attributes' - * subcommand, for listing the set of possible attribute strings. - * - * Results: - * An array of strings - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static const char *const * -Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) -{ - static const char *const attrs[] = { - "-uncompsize", - "-compsize", - "-offset", - "-mount", - "-archive", - "-permissions", - NULL, - }; - - return attrs; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSFileAttrsGetProc -- - * - * This function implements the ZIP filesystem specific - * 'file attributes' subcommand, for 'get' operations. - * - * Results: - * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK - * was returned) is likely to have a refCount of zero. Either way we must - * either store it somewhere (e.g. the Tcl result), or Incr/Decr its - * refCount to ensure it is properly freed. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef) -{ - int len, ret = TCL_OK; - char *path; - ZipEntry *z; - - path = Tcl_GetStringFromObj(pathPtr, &len); - ReadLock(); - z = ZipFSLookup(path); - if (z == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); - } - ret = TCL_ERROR; - goto done; - } - switch (index) { - case 0: - *objPtrRef = Tcl_NewIntObj(z->nbyte); - goto done; - case 1: - *objPtrRef= Tcl_NewIntObj(z->nbytecompr); - goto done; - case 2: - *objPtrRef= Tcl_NewLongObj(z->offset); - goto done; - case 3: - *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1); - goto done; - case 4: - *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); - goto done; - case 5: - *objPtrRef= Tcl_NewStringObj("0555", -1); - goto done; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown attribute", -1)); - } - ret = TCL_ERROR; -done: - Unlock(); - return ret; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSFileAttrsSetProc -- - * - * This function implements the ZIP filesystem specific - * 'file attributes' subcommand, for 'set' operations. - * - * Results: - * Standard Tcl return code. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, - Tcl_Obj *objPtr) -{ - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); - } - return TCL_ERROR; -} - -/* - *------------------------------------------------------------------------- - * - * Zip_FSFilesystemPathTypeProc -- - * - * Results: - * - * Side effects: - * - *------------------------------------------------------------------------- - */ - -static Tcl_Obj * -Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) -{ - return Tcl_NewStringObj("zip", -1); -} - - -/* - *------------------------------------------------------------------------- - * - * Zip_FSLoadFile -- - * - * This functions deals with loading native object code. If - * the given path object refers to a file within the ZIP - * filesystem, an approriate error code is returned to delegate - * loading to the caller (by copying the file to temp store - * and loading from there). As fallback when the file refers - * to the ZIP file system but is not present, it is looked up - * relative to the executable and loaded from there when available. - * - * Results: - * TCL_OK on success, -1 otherwise with error number set. - * - * Side effects: - * Loads native code into the process address space. - * - *------------------------------------------------------------------------- - */ - -static int -Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, - Tcl_FSUnloadFileProc **unloadProcPtr, int flags) -{ - Tcl_FSLoadFileProc2 *loadFileProc; -#ifdef ANDROID - /* - * Force loadFileProc to native implementation since the - * package manger already extracted the shared libraries - * from the APK at install time. - */ - - loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; - if (loadFileProc != NULL) { - return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); - } - Tcl_SetErrno(ENOENT); - return -1; -#else - Tcl_Obj *altPath = NULL; - int ret = -1; - - if (Tcl_FSAccess(path, R_OK) == 0) { - /* - * EXDEV should trigger loading by copying to temp store. - */ - Tcl_SetErrno(EXDEV); - return ret; - } else { - Tcl_Obj *objs[2] = { NULL, NULL }; - - objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); - if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { - const char *execName = Tcl_GetNameOfExecutable(); - - /* - * Shared object is not in ZIP but its path prefix is, - * thus try to load from directory where the executable - * came from. - */ - TclDecrRefCount(objs[1]); - objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); - /* - * Get directory name of executable manually to deal - * with cases where [file dirname [info nameofexecutable]] - * is equal to [info nameofexecutable] due to VFS effects. - */ - if (execName != NULL) { - const char *p = strrchr(execName, '/'); - - if (p > execName + 1) { - --p; - objs[0] = Tcl_NewStringObj(execName, p - execName); - } - } - if (objs[0] == NULL) { - objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), - TCL_PATH_DIRNAME); - } - if (objs[0] != NULL) { - altPath = TclJoinPath(2, objs); - if (altPath != NULL) { - Tcl_IncrRefCount(altPath); - if (Tcl_FSAccess(altPath, R_OK) == 0) { - path = altPath; - } - } - } - } - if (objs[0] != NULL) { - Tcl_DecrRefCount(objs[0]); - } - if (objs[1] != NULL) { - Tcl_DecrRefCount(objs[1]); - } - } - loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; - if (loadFileProc != NULL) { - ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); - } else { - Tcl_SetErrno(ENOENT); - } - if (altPath != NULL) { - Tcl_DecrRefCount(altPath); - } - return ret; -#endif -} - - -/* - * Define the ZIP filesystem dispatch table. - */ - -MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; - -const Tcl_Filesystem zipfsFilesystem = { - "zipfs", - sizeof (Tcl_Filesystem), - TCL_FILESYSTEM_VERSION_2, - Zip_FSPathInFilesystemProc, - NULL, /* dupInternalRepProc */ - NULL, /* freeInternalRepProc */ - NULL, /* internalToNormalizedProc */ - NULL, /* createInternalRepProc */ - Zip_FSNormalizePathProc, - Zip_FSFilesystemPathTypeProc, - Zip_FSFilesystemSeparatorProc, - Zip_FSStatProc, - Zip_FSAccessProc, - Zip_FSOpenFileChannelProc, - Zip_FSMatchInDirectoryProc, - NULL, /* utimeProc */ - NULL, /* linkProc */ - Zip_FSListVolumesProc, - Zip_FSFileAttrStringsProc, - Zip_FSFileAttrsGetProc, - Zip_FSFileAttrsSetProc, - NULL, /* createDirectoryProc */ - NULL, /* removeDirectoryProc */ - NULL, /* deleteFileProc */ - NULL, /* copyFileProc */ - NULL, /* renameFileProc */ - NULL, /* copyDirectoryProc */ - NULL, /* lstatProc */ - (Tcl_FSLoadFileProc *) Zip_FSLoadFile, - NULL, /* getCwdProc */ - Zip_FSChdirProc, -}; - -#endif /* HAVE_ZLIB */ - - - -Zipfs_one_time_init(Tcl_Interp *interp) { - /* one-time initialization */ - WriteLock(); - if (!ZipFS.initialized) { -#ifdef TCL_THREADS - static const Tcl_Time t = { 0, 0 }; - - /* - * Inflate condition variable. - */ - Tcl_MutexLock(&ZipFSMutex); - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); - Tcl_MutexUnlock(&ZipFSMutex); -#endif - Tcl_FSRegister(NULL, &zipfsFilesystem); - Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); - ZipFS.initialized = ZipFS.idCount = 1; - if(interp) { - Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); - } - } - Unlock(); -} -/* - *------------------------------------------------------------------------- - * - * Zipfs_doInit -- - * - * Perform per interpreter initialization of this module. - * - * Results: - * The return value is a standard Tcl result. - * - * Side effects: - * Initializes this module if not already initialized, and adds - * module related commands to the given interpreter. - * - *------------------------------------------------------------------------- - */ - -static int -Zipfs_doInit(Tcl_Interp *interp, int safe) -{ -#ifdef HAVE_ZLIB - static const EnsembleImplMap initMap[] = { - {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, - {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, - {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, - {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, - {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, - {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, - {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, - {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 0}, - {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 0}, - {"list", ZipFSListObjCmd, NULL, NULL, NULL, 0}, - {NULL, NULL, NULL, NULL, NULL, 0} - }; - - static const EnsembleImplMap initSafeMap[] = { - {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 0}, - {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 0}, - {"list", ZipFSListObjCmd, NULL, NULL, NULL, 0}, - {NULL, NULL, NULL, NULL, NULL, 0} - }; - - static const char findproc[] = - "namespace eval zipfs {}\n" - "proc ::zipfs::find dir {\n" - " set result {}\n" - " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n" - " return $result\n" - " }\n" - " foreach file $list {\n" - " if {$file eq \".\" || $file eq \"..\"} {\n" - " continue\n" - " }\n" - " set file [file join $dir $file]\n" - " lappend result $file\n" - " foreach file [::zipfs::find $file] {\n" - " lappend result $file\n" - " }\n" - " }\n" - " return [lsort $result]\n" - "}\n"; - Zipfs_one_time_init(interp); - if (!safe) { - Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); - Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, - TCL_LINK_INT); - } - TclMakeEnsemble(interp, "zipfs", safe ? initSafeMap : initMap); - - Tcl_PkgProvide(interp, "zipfs", "1.0"); - - return TCL_OK; -#else - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("no zlib available", -1)); - } - return TCL_ERROR; -#endif -} - -/* - *------------------------------------------------------------------------- - * - * Tclzipfs_Init, Tclzipfs_SafeInit -- - * - * These functions are invoked to perform per interpreter initialization - * of this module. - * - * Results: - * The return value is a standard Tcl result. - * - * Side effects: - * Initializes this module if not already initialized, and adds - * module related commands to the given interpreter. - * - *------------------------------------------------------------------------- - */ - -int -Tclzipfs_Init(Tcl_Interp *interp) -{ - return Zipfs_doInit(interp, 0); -} - -int -Tclzipfs_SafeInit(Tcl_Interp *interp) -{ - return Zipfs_doInit(interp, 1); -} - -#ifndef HAVE_ZLIB - -/* - *------------------------------------------------------------------------- - * - * Tclzipfs_Mount, Tclzipfs_Unmount -- - * - * Dummy version when no ZLIB support available. - * - *------------------------------------------------------------------------- - */ - -int -Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, - const char *passwd) -{ - return Zipfs_doInit(interp, 1); -} - -int -Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname) -{ - return Zipfs_doInit(interp, 1); -} - -#endif - -/* -** Boot a shell, mount the executable's VFS, detect main.tcl -*/ -int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *initscript,const char *passwd) { - #ifdef HAVE_ZLIB - Zipfs_one_time_init(NULL); - if(!vfsmountpoint) { - vfsmountpoint="/zvfs"; - } - if(!initscript) { - initscript="main.tcl"; - } - /* We have to initialize the virtual filesystem before calling - ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find - ** its startup script files. - */ - if(!Tclzipfs_Mount(NULL, archive, vfsmountpoint,passwd)) { - Tcl_DString filepath; - Tcl_DString preinit; - - Tcl_Obj *vfsinitscript; - Tcl_Obj *vfstcllib; - Tcl_Obj *vfstklib; - Tcl_Obj *vfspreinit; - Tcl_DStringInit(&filepath); - Tcl_DStringInit(&preinit); - - Tcl_DStringInit(&filepath); - Tcl_DStringAppend(&filepath,vfsmountpoint,-1); - Tcl_DStringAppend(&filepath,"/",-1); - Tcl_DStringAppend(&filepath,initscript,-1); - vfsinitscript=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); - Tcl_DStringFree(&filepath); - - Tcl_DStringInit(&filepath); - Tcl_DStringAppend(&filepath,vfsmountpoint,-1); - Tcl_DStringAppend(&filepath,"/boot/tcl",-1); - vfstcllib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); - Tcl_DStringFree(&filepath); - - Tcl_DStringInit(&filepath); - Tcl_DStringAppend(&filepath,vfsmountpoint,-1); - Tcl_DStringAppend(&filepath,"/boot/tk",-1); - vfstklib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1); - Tcl_DStringFree(&filepath); - - Tcl_IncrRefCount(vfsinitscript); - Tcl_IncrRefCount(vfstcllib); - Tcl_IncrRefCount(vfstklib); - - if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { - /* Startup script should be set before calling Tcl_AppInit */ - Tcl_SetStartupScript(vfsinitscript,NULL); - } - /* Record the mountpoint for scripts to refer back to */ - Tcl_DStringAppend(&preinit,"\nset ::tcl_boot_vfs ",-1); - Tcl_DStringAppendElement(&preinit,vfsmountpoint); - Tcl_DStringAppend(&preinit,"\nset ::SRCDIR ",-1); - Tcl_DStringAppendElement(&preinit,vfsmountpoint); - - if(Tcl_FSAccess(vfstcllib,F_OK)==0) { - Tcl_DStringAppend(&preinit,"\nset tcl_library ",-1); - Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstcllib)); - } - if(Tcl_FSAccess(vfstklib,F_OK)==0) { - Tcl_DStringAppend(&preinit,"\nset tk_library ",-1); - Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstklib)); - } - vfspreinit=Tcl_NewStringObj(Tcl_DStringValue(&preinit),-1); - /* NOTE: We never decr this refcount, lest the contents of the script be deallocated */ - Tcl_IncrRefCount(vfspreinit); - TclSetPreInitScript(Tcl_GetString(vfspreinit)); - - Tcl_DecrRefCount(vfsinitscript); - Tcl_DecrRefCount(vfstcllib); - Tcl_DecrRefCount(vfstklib); - } - #endif - return TCL_OK; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/library/practcl/pkgIndex.tcl b/library/practcl/pkgIndex.tcl new file mode 100644 index 0000000..1e378e8 --- /dev/null +++ b/library/practcl/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded practcl 0.5 [list source [file join $dir practcl.tcl]] diff --git a/library/practcl/practcl.tcl b/library/practcl/practcl.tcl new file mode 100644 index 0000000..3b4b04e --- /dev/null +++ b/library/practcl/practcl.tcl @@ -0,0 +1,4000 @@ +### +# Practcl +# An object oriented templating system for stamping out Tcl API calls to C +### +puts [list LOADED practcl.tcl from [info script]] +package require TclOO +proc ::debug args { + #puts $args + ::practcl::cputs ::DEBUG_INFO $args +} + +### +# Drop in a static copy of Tcl +### +proc ::doexec args { + puts [list {*}$args] + exec {*}$args >&@ stdout +} + +proc ::dotclexec args { + puts [list [info nameofexecutable] {*}$args] + exec [info nameofexecutable] {*}$args >&@ stdout +} + +proc ::domake {path args} { + set PWD [pwd] + cd $path + puts [list *** $path ***] + puts [list make {*}$args] + exec make {*}$args >&@ stdout + cd $PWD +} + +proc ::domake.tcl {path args} { + set PWD [pwd] + cd $path + puts [list *** $path ***] + puts [list make.tcl {*}$args] + exec [info nameofexecutable] make.tcl {*}$args >&@ stdout + cd $PWD +} + +proc ::fossil {path args} { + set PWD [pwd] + cd $path + puts [list {*}$args] + exec fossil {*}$args >&@ stdout + cd $PWD +} + + +proc ::fossil_status {dir} { + if {[info exists ::fosdat($dir)]} { + return $::fosdat($dir) + } + set result { +tags experimental +version {} + } + set pwd [pwd] + cd $dir + set info [exec fossil status] + cd $pwd + foreach line [split $info \n] { + if {[lindex $line 0] eq "checkout:"} { + set hash [lindex $line end-3] + set maxdate [lrange $line end-2 end-1] + dict set result hash $hash + dict set result maxdate $maxdate + regsub -all {[^0-9]} $maxdate {} isodate + dict set result isodate $isodate + } + if {[lindex $line 0] eq "tags:"} { + set tags [lrange $line 1 end] + dict set result tags $tags + break + } + } + set ::fosdat($dir) $result + return $result +} +### +# Seek out Tcllib if it's available +### +set tcllib_path {} +foreach path {.. ../.. ../../..} { + foreach path [glob -nocomplain [file join [file normalize $path] tcllib* modules]] { + set tclib_path $path + lappend ::auto_path $path + break + } + if {$tcllib_path ne {}} break +} + + +### +# Build utility functions +### +namespace eval ::practcl {} + +proc ::practcl::os {} { + if {[info exists ::project(TEACUP_OS)] && $::project(TEACUP_OS) ni {"@TEACUP_OS@" {}}} { + return $::project(TEACUP_OS) + } + set info [::practcl::config.tcl $::project(builddir)] + if {[dict exists $info TEACUP_OS]} { + return [dict get $info TEACUP_OS] + } + return unknown +} + +### +# Detect local platform +### +proc ::practcl::config.tcl {path} { + dict set result buildpath $path + set result {} + if {[file exists [file join $path config.tcl]]} { + set fin [open [file join $path config.tcl] r] + set bufline {} + set rawcount 0 + set linecount 0 + while {[gets $fin thisline]>=0} { + incr rawcount + append bufline \n $thisline + if {![info complete $bufline]} continue + set line [string trimleft $bufline] + set bufline {} + if {[string index [string trimleft $line] 0] eq "#"} continue + incr linecount + set key [lindex $line 0] + set value [lindex $line 1] + dict set result $key $value + } + dict set result sandbox [file dirname [dict get $result srcdir]] + dict set result download [file join [dict get $result sandbox] download] + dict set result teapot [file join [dict get $result sandbox] teapot] + set result [::practcl::de_shell $result] + } + # If data is available from autoconf, defer to that + if {[dict exists $result TEACUP_OS] && [dict get $result TEACUP_OS] ni {"@TEACUP_OS@" {}}} { + return $result + } + # If autoconf hasn't run yet, assume we are not cross compiling + # and defer to local checks + dict set result TEACUP_PROFILE unknown + dict set result TEACUP_OS unknown + dict set result EXEEXT {} + if {$::tcl_platform(platform) eq "windows"} { + set system "windows" + set arch ix86 + dict set result TEACUP_PROFILE win32-ix86 + dict set result TEACUP_OS windows + dict set result EXEEXT .exe + } else { + set system [exec uname -s]-[exec uname -r] + set arch unknown + dict set result TEACUP_OS generic + } + dict set result TEA_PLATFORM $system + dict set result TEA_SYSTEM $system + switch -glob $system { + Linux* { + dict set result TEACUP_OS linux + set arch [exec uname -m] + dict set result TEACUP_PROFILE "linux-glibc2.3-$arch" + } + GNU* { + set arch [exec uname -m] + dict set result TEACUP_OS "gnu" + } + NetBSD-Debian { + set arch [exec uname -m] + dict set result TEACUP_OS "netbsd-debian" + } + OpenBSD-* { + set arch [exec arch -s] + dict set result TEACUP_OS "openbsd" + } + Darwin* { + set arch [exec uname -m] + dict set result TEACUP_OS "macosx" + if {$arch eq "x86_64"} { + dict set result TEACUP_PROFILE "macosx10.5-i386-x86_84" + } else { + dict set result TEACUP_PROFILE "macosx-universal" + } + } + OpenBSD* { + set arch [exec arch -s] + dict set result TEACUP_OS "openbsd" + } + } + if {$arch eq "unknown"} { + catch {set arch [exec uname -m]} + } + switch -glob $arch { + i*86 { + set arch "ix86" + } + amd64 { + set arch "x86_64" + } + } + dict set result TEACUP_ARCH $arch + if {[dict get $result TEACUP_PROFILE] eq "unknown"} { + dict set result TEACUP_PROFILE [dict get $result TEACUP_OS]-$arch + } + return $result +} + + +### +# Convert an MSYS path to a windows native path +### +if {$::tcl_platform(platform) eq "windows"} { +proc ::practcl::msys_to_tclpath msyspath { + return [exec sh -c "cd $msyspath ; pwd -W"] +} +} else { +proc ::practcl::msys_to_tclpath msyspath { + return [file normalize $msyspath] +} +} + +### +# Bits stolen from fileutil +### +proc ::practcl::cat fname { + set fname [open $fname r] + set data [read $fname] + close $fname + return $data +} + +proc ::practcl::file_lexnormalize {sp} { + set spx [file split $sp] + + # Resolution of embedded relative modifiers (., and ..). + + if { + ([lsearch -exact $spx . ] < 0) && + ([lsearch -exact $spx ..] < 0) + } { + # Quick path out if there are no relative modifiers + return $sp + } + + set absolute [expr {![string equal [file pathtype $sp] relative]}] + # A volumerelative path counts as absolute for our purposes. + + set sp $spx + set np {} + set noskip 1 + + while {[llength $sp]} { + set ele [lindex $sp 0] + set sp [lrange $sp 1 end] + set islast [expr {[llength $sp] == 0}] + + if {[string equal $ele ".."]} { + if { + ($absolute && ([llength $np] > 1)) || + (!$absolute && ([llength $np] >= 1)) + } { + # .. : Remove the previous element added to the + # new path, if there actually is enough to remove. + set np [lrange $np 0 end-1] + } + } elseif {[string equal $ele "."]} { + # Ignore .'s, they stay at the current location + continue + } else { + # A regular element. + lappend np $ele + } + } + if {[llength $np] > 0} { + return [eval [linsert $np 0 file join]] + # 8.5: return [file join {*}$np] + } + return {} +} + +proc ::practcl::file_relative {base dst} { + # Ensure that the link to directory 'dst' is properly done relative to + # the directory 'base'. + + if {![string equal [file pathtype $base] [file pathtype $dst]]} { + return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)" + } + + set base [file_lexnormalize [file join [pwd] $base]] + set dst [file_lexnormalize [file join [pwd] $dst]] + + set save $dst + set base [file split $base] + set dst [file split $dst] + + while {[string equal [lindex $dst 0] [lindex $base 0]]} { + set dst [lrange $dst 1 end] + set base [lrange $base 1 end] + if {![llength $dst]} {break} + } + + set dstlen [llength $dst] + set baselen [llength $base] + + if {($dstlen == 0) && ($baselen == 0)} { + # Cases: + # (a) base == dst + + set dst . + } else { + # Cases: + # (b) base is: base/sub = sub + # dst is: base = {} + + # (c) base is: base = {} + # dst is: base/sub = sub + + while {$baselen > 0} { + set dst [linsert $dst 0 ..] + incr baselen -1 + } + # 8.5: set dst [file join {*}$dst] + set dst [eval [linsert $dst 0 file join]] + } + + return $dst +} + +### +# Unpack the source of a fossil project into a designated location +### +proc ::practcl::fossil_sandbox {pkg args} { + if {[llength $args]==1} { + set info [lindex $args 0] + } else { + set info $args + } + set result $info + if {[dict exists $info srcroot]} { + set srcroot [dict get $info srcroot] + } elseif {[dict exists $info sandbox]} { + set srcroot [file join [dict get $info sandbox] $pkg] + } else { + set srcroot [file join $::CWD .. $pkg] + } + dict set result srcroot $srcroot + puts [list fossil_sandbox $pkg $srcroot] + if {[dict exists $info download]} { + ### + # Source is actually a zip archive + ### + set download [dict get $info download] + if {[file exists [file join $download $pkg.zip]]} { + if {![info exists $srcroot]} { + package require zipfile::decode + ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcroot + } + return + } + } + variable fossil_dbs + if {![::info exists fossil_dbs]} { + # Get a list of local fossil databases + set fossil_dbs [exec fossil all list] + } + set CWD [pwd] + if {![dict exists $info tag]} { + set tag trunk + } else { + set tag [dict get $info tag] + } + dict set result tag $tag + + try { + if {[file exists [file join $srcroot .fslckout]]} { + if {[dict exists $info update] && [dict get $info update]==1} { + catch { + puts "FOSSIL UPDATE" + cd $srcroot + doexec fossil update $tag + } + } + } elseif {[file exists [file join $srcroot _FOSSIL_]]} { + if {[dict exists $info update] && [dict get $info update]==1} { + catch { + puts "FOSSIL UPDATE" + cd $srcroot + doexec fossil update $tag + } + } + } else { + puts "OPEN AND UNPACK" + set fosdb {} + foreach line [split $fossil_dbs \n] { + set line [string trim $line] + if {[file rootname [file tail $line]] eq $pkg} { + set fosdb $line + break + } + } + if {$fosdb eq {}} { + file mkdir [file join $download fossil] + set fosdb [file join $download fossil $pkg.fos] + set cloned 0 + if {[dict exists $info localmirror]} { + set localmirror [dict get $info localmirror] + catch { + doexec fossil clone $localmirror/$pkg $fosdb + set cloned 1 + } + } + if {!$cloned && [dict exists $info fossil_url]} { + set localmirror [dict get $info fossil_url] + catch { + doexec fossil clone $localmirror/$pkg $fosdb + set cloned 1 + } + } + if {!$cloned} { + doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb + } + } + file mkdir $srcroot + cd $srcroot + puts "FOSSIL OPEN [pwd]" + doexec fossil open $fosdb $tag + } + } on error {result opts} { + puts [list ERR [dict get $opts -errorinfo]] + return {*}$opts + } finally { + cd $CWD + } + return $result +} + +### +# topic: e71f3f61c348d56292011eec83e95f0aacc1c618 +# description: Converts a XXX.sh file into a series of Tcl variables +### +proc ::practcl::read_sh_subst {line info} { + regsub -all {\x28} $line \x7B line + regsub -all {\x29} $line \x7D line + + #set line [string map $key [string trim $line]] + foreach {field value} $info { + catch {set $field $value} + } + if [catch {subst $line} result] { + return {} + } + set result [string trim $result] + return [string trim $result '] +} + +### +# topic: 03567140cca33c814664c7439570f669b9ab88e6 +### +proc ::practcl::read_sh_file {filename {localdat {}}} { + set fin [open $filename r] + set result {} + if {$localdat eq {}} { + set top 1 + set local [array get ::env] + dict set local EXE {} + } else { + set top 0 + set local $localdat + } + while {[gets $fin line] >= 0} { + set line [string trim $line] + if {[string index $line 0] eq "#"} continue + if {$line eq {}} continue + catch { + if {[string range $line 0 6] eq "export "} { + set eq [string first "=" $line] + set field [string trim [string range $line 6 [expr {$eq - 1}]]] + set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] + dict set result $field [read_sh_subst $value $local] + dict set local $field $value + } elseif {[string range $line 0 7] eq "include "} { + set subfile [read_sh_subst [string range $line 7 end] $local] + foreach {field value} [read_sh_file $subfile $local] { + dict set result $field $value + } + } else { + set eq [string first "=" $line] + if {$eq > 0} { + set field [read_sh_subst [string range $line 0 [expr {$eq - 1}]] $local] + set value [string trim [string range $line [expr {$eq+1}] end] '] + #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] + dict set local $field $value + dict set result $field $value + } + } + } err opts + if {[dict get $opts -code] != 0} { + #puts $opts + puts "Error reading line:\n$line\nerr: $err\n***" + return $err {*}$opts + } + } + return $result +} + +### +# A simpler form of read_sh_file tailored +# to pulling data from (tcl|tk)Config.sh +### +proc ::practcl::read_Config.sh filename { + set fin [open $filename r] + set result {} + set linecount 0 + while {[gets $fin line] >= 0} { + set line [string trim $line] + if {[string index $line 0] eq "#"} continue + if {$line eq {}} continue + catch { + set eq [string first "=" $line] + if {$eq > 0} { + set field [string range $line 0 [expr {$eq - 1}]] + set value [string trim [string range $line [expr {$eq+1}] end] '] + #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] + dict set result $field $value + incr $linecount + } + } err opts + if {[dict get $opts -code] != 0} { + #puts $opts + puts "Error reading line:\n$line\nerr: $err\n***" + return $err {*}$opts + } + } + return $result +} + +### +# A simpler form of read_sh_file tailored +# to pulling data from a Makefile +### +proc ::practcl::read_Makefile filename { + set fin [open $filename r] + set result {} + while {[gets $fin line] >= 0} { + set line [string trim $line] + if {[string index $line 0] eq "#"} continue + if {$line eq {}} continue + catch { + set eq [string first "=" $line] + if {$eq > 0} { + set field [string trim [string range $line 0 [expr {$eq - 1}]]] + set value [string trim [string trim [string range $line [expr {$eq+1}] end] ']] + switch $field { + PKG_LIB_FILE { + dict set result libfile $value + } + srcdir { + if {$value eq "."} { + dict set result srcdir [file dirname $filename] + } else { + dict set result srcdir $value + } + } + PACKAGE_NAME { + dict set result name $value + } + PACKAGE_VERSION { + dict set result version $value + } + LIBS { + dict set result PRACTCL_LIBS $value + } + PKG_LIB_FILE { + dict set result libfile $value + } + } + } + } err opts + if {[dict get $opts -code] != 0} { + #puts $opts + puts "Error reading line:\n$line\nerr: $err\n***" + return $err {*}$opts + } + # the Compile field is about where most TEA files start getting silly + if {$field eq "compile"} { + break + } + } + return $result +} + +## Append arguments to a buffer +# The command works like puts in that each call will also insert +# a line feed. Unlike puts, blank links in the interstitial are +# suppressed +proc ::practcl::cputs {varname args} { + upvar 1 $varname buffer + if {[llength $args]==1 && [string length [string trim [lindex $args 0]]] == 0} { + + } + if {[info exist buffer]} { + if {[string index $buffer end] ne "\n"} { + append buffer \n + } + } else { + set buffer \n + } + # Trim leading \n's + append buffer [string trimleft [lindex $args 0] \n] {*}[lrange $args 1 end] +} + + +proc ::practcl::tcl_to_c {body} { + set result {} + foreach rawline [split $body \n] { + set line [string map [list \" \\\" \\ \\\\] $rawline] + cputs result "\n \"$line\\n\" \\" + } + return [string trimright $result \\] +} + + +proc ::practcl::_tagblock {text {style tcl} {note {}}} { + if {[string length [string trim $text]]==0} { + return {} + } + set output {} + switch $style { + tcl { + ::practcl::cputs output "# BEGIN $note" + } + c { + ::practcl::cputs output "/* BEGIN $note */" + } + default { + ::practcl::cputs output "# BEGIN $note" + } + } + ::practcl::cputs output $text + switch $style { + tcl { + ::practcl::cputs output "# END $note" + } + c { + ::practcl::cputs output "/* END $note */" + } + default { + ::practcl::cputs output "# END $note" + } + } + return $output +} + +proc ::practcl::_isdirectory name { + return [file isdirectory $name] +} + +### +# Return true if the pkgindex file contains +# any statement other than "package ifneeded" +# and/or if any package ifneeded loads a DLL +### +proc ::practcl::_pkgindex_directory {path} { + set buffer {} + set pkgidxfile [file join $path pkgIndex.tcl] + if {![file exists $pkgidxfile]} { + # No pkgIndex file, read the source + foreach file [glob -nocomplain $path/*.tm] { + set file [file normalize $file] + set fname [file rootname [file tail $file]] + ### + # We used to be able to ... Assume the package is correct in the filename + # No hunt for a "package provides" + ### + set package [lindex [split $fname -] 0] + set version [lindex [split $fname -] 1] + ### + # Read the file, and override assumptions as needed + ### + set fin [open $file r] + set dat [read $fin] + close $fin + # Look for a teapot style Package statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 9] != "# Package " } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + } + foreach file [glob -nocomplain $path/*.tcl] { + if { [file tail $file] == "version_info.tcl" } continue + set fin [open $file r] + set dat [read $fin] + close $fin + if {![regexp "package provide" $dat]} continue + set fname [file rootname [file tail $file]] + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + if {[string index $package 0] in "\$ \["} continue + if {[string index $version 0] in "\$ \["} continue + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + break + } + } + return $buffer + } + set fin [open $pkgidxfile r] + set dat [read $fin] + close $fin + set thisline {} + foreach line [split $dat \n] { + append thisline $line \n + if {![info complete $thisline]} continue + set line [string trim $line] + if {[string length $line]==0} { + set thisline {} ; continue + } + if {[string index $line 0] eq "#"} { + set thisline {} ; continue + } + try { + # Ignore contditionals + if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} continue + if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} continue + if {![regexp "package.*ifneeded" $thisline]} { + # This package index contains arbitrary code + # source instead of trying to add it to the master + # package index + return {source [file join $dir pkgIndex.tcl]} + } + append buffer $thisline \n + } on error {err opts} { + puts *** + puts "GOOF: $pkgidxfile" + puts $line + puts $err + puts [dict get $opts -errorinfo] + puts *** + } finally { + set thisline {} + } + } + return $buffer +} + + +proc ::practcl::_pkgindex_path_subdir {path} { + set result {} + foreach subpath [glob -nocomplain [file join $path *]] { + if {[file isdirectory $subpath]} { + lappend result $subpath {*}[_pkgindex_path_subdir $subpath] + } + } + return $result +} +### +# Index all paths given as though they will end up in the same +# virtual file system +### +proc ::practcl::pkgindex_path args { + set stack {} + set buffer { +lappend ::PATHSTACK $dir + } + foreach base $args { + set base [file normalize $base] + set paths [::practcl::_pkgindex_path_subdir $base] + set i [string length $base] + # Build a list of all of the paths + foreach path $paths { + if {$path eq $base} continue + set path_indexed($path) 0 + } + set path_indexed($base) 1 + set path_indexed([file join $base boot tcl]) 1 + #set path_index([file join $base boot tk]) 1 + + foreach path $paths { + if {$path_indexed($path)} continue + set thisdir [file_relative $base $path] + #set thisdir [string range $path $i+1 end] + set idxbuf [::practcl::_pkgindex_directory $path] + if {[string length $idxbuf]} { + incr path_indexed($path) + append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n + append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n + } + } + } + append buffer { +set dir [lindex $::PATHSTACK end] +set ::PATHSTACK [lrange $::PATHSTACK 0 end-1] +} + return $buffer +} + +### +# topic: 64319f4600fb63c82b2258d908f9d066 +# description: Script to build the VFS file system +### +proc ::practcl::installDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]] + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + installDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +proc ::practcl::copyDir {d1 d2} { + #puts [list $d1 -> $d2] + #file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + } + } +} + +::oo::class create ::practcl::metaclass { + superclass ::oo::object + + method script script { + eval $script + } + + method source filename { + source $filename + } + + method initialize {} {} + + method define {submethod args} { + my variable define + switch $submethod { + dump { + return [array get define] + } + add { + set field [lindex $args 0] + if {![info exists define($field)]} { + set define($field) {} + } + foreach arg [lrange $args 1 end] { + if {$arg ni $define($field)} { + lappend define($field) $arg + } + } + return $define($field) + } + remove { + set field [lindex $args 0] + if {![info exists define($field)]} { + return + } + set rlist [lrange $args 1 end] + set olist $define($field) + set nlist {} + foreach arg $olist { + if {$arg in $rlist} continue + lappend nlist $arg + } + set define($field) $nlist + return $nlist + } + exists { + set field [lindex $args 0] + return [info exists define($field)] + } + getnull - + get - + cget { + set field [lindex $args 0] + if {[info exists define($field)]} { + return $define($field) + } + return [lindex $args 1] + } + set { + if {[llength $args]==1} { + set arglist [lindex $args 0] + } else { + set arglist $args + } + array set define $arglist + if {[dict exists $arglist class]} { + my select + } + } + default { + array $submethod define {*}$args + } + } + } + + method graft args { + my variable organs + if {[llength $args] == 1} { + error "Need two arguments" + } + set object {} + foreach {stub object} $args { + dict set organs $stub $object + oo::objdefine [self] forward <${stub}> $object + oo::objdefine [self] export <${stub}> + } + return $object + } + + method organ {{stub all}} { + my variable organs + if {![info exists organs]} { + return {} + } + if { $stub eq "all" } { + return $organs + } + if {[dict exists $organs $stub]} { + return [dict get $organs $stub] + } + } + + method link {command args} { + my variable links + switch $command { + object { + foreach obj $args { + foreach linktype [$obj linktype] { + my link add $linktype $obj + } + } + } + add { + ### + # Add a link to an object that was externally created + ### + if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"} + lassign $args linktype object + if {[info exists links($linktype)] && $object in $links($linktype)} { + return + } + lappend links($linktype) $object + } + remove { + set object [lindex $args 0] + if {[llength $args]==1} { + set ltype * + } else { + set ltype [lindex $args 1] + } + foreach {linktype elements} [array get links $ltype] { + if {$object in $elements} { + set nlist {} + foreach e $elements { + if { $object ne $e } { lappend nlist $e } + } + set links($linktype) $nlist + } + } + } + list { + if {[llength $args]==0} { + return [array get links] + } + if {[llength $args] != 1} { error "Usage: link list LINKTYPE"} + set linktype [lindex $args 0] + if {![info exists links($linktype)]} { + return {} + } + return $links($linktype) + } + dump { + return [array get links] + } + } + } + + method select {} { + my variable define + set class {} + if {[info exists define(class)]} { + if {[info command $define(class)] ne {}} { + set class $define(class) + } elseif {[info command ::practcl::$define(class)] ne {}} { + set class ::practcl::$define(class) + } else { + switch $define(class) { + default { + set class ::practcl::object + } + } + } + } + if {$class ne {}} { + ::oo::objdefine [self] class $class + } + if {[::info exists define(oodefine)]} { + ::oo::objdefine [self] $define(oodefine) + unset define(oodefine) + } + } +} + +proc ::practcl::trigger {args} { + foreach name $args { + if {[dict exists $::make_objects $name]} { + [dict get $::make_objects $name] triggers + } + } +} + +proc ::practcl::depends {args} { + foreach name $args { + if {[dict exists $::make_objects $name]} { + [dict get $::make_objects $name] check + } + } +} + +proc ::practcl::target {name info} { + set obj [::practcl::target_obj new $name $info] + dict set ::make_objects $name $obj + if {[dict exists $info aliases]} { + foreach item [dict get $info aliases] { + if {![dict exists $::make_objects $item]} { + dict set ::make_objects $item $obj + } + } + } + set ::make($name) 0 + set ::trigger($name) 0 + set filename [$obj define get filename] + if {$filename ne {}} { + set ::target($name) $filename + } +} + +### Batch Tasks + +namespace eval ::practcl::build {} + +## method DEFS +# This method populates 4 variables: +# name - The name of the package +# version - The version of the package +# defs - C flags passed to the compiler +# includedir - A list of paths to feed to the compiler for finding headers +# +proc ::practcl::build::DEFS {PROJECT DEFS namevar versionvar defsvar} { + upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs + set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]] + set NAME [string toupper $name] + set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] + if {$version eq {}} { + set version 0.1a + } + set defs {} + append defs " -DPACKAGE_NAME=\"${name}\" -DPACKAGE_VERSION=\"${version}\"" + append defs " -DPACKAGE_TARNAME=\"${name}\" -DPACKAGE_STRING=\"${name}\x5c\x20${version}\"" + set NAME [string toupper $name] + set idx 0 + set count 0 + while {$idx>=0} { + set ndx [string first " -D" $DEFS $idx+1] + set item [string range $DEFS $idx $ndx] + set item [string trim $item] + set item [string trimleft $item -D] + if {[string range $item 0 7] eq "PACKAGE_"} { + set idx $ndx + continue + } + set eqidx [string first = $item ] + if {$eqidx < 0} { + append defs { } $item + set idx $ndx + continue + } + + set field [string range $item 0 [expr {$eqidx-1}]] + set value [string range $item [expr {$eqidx+1}] end] + set emap {} + lappend emap \x5c \x5c\x5c \x20 \x5c\x20 \x22 \x5c\x22 \x28 \x5c\x28 \x29 \x5c\x29 + if {[string is integer -strict $value]} { + append defs " -D${field}=$value" + } else { + append defs " -D${field}=[string map $emap $value]" + } + set idx $ndx + } + return $defs +} + +proc ::practcl::build::tclkit_main {PROJECT PKG_OBJS} { + ### + # Build static package list + ### + set statpkglist {} + dict set statpkglist Tk {autoload 0} + puts [list TCLKIT MAIN $PROJECT] + + foreach {ofile info} [${PROJECT} compile-products] { + puts [list * PROD $ofile $info] + if {![dict exists $info object]} continue + set cobj [dict get $info object] + foreach {pkg info} [$cobj static-packages] { + dict set statpkglist $pkg $info + } + } + foreach cobj [list {*}${PKG_OBJS} $PROJECT] { + puts [list * PROG $cobj] + foreach {pkg info} [$cobj static-packages] { + puts [list * PKG $pkg $info] + dict set statpkglist $pkg $info + } + } + + set result {} + $PROJECT include {} + $PROJECT include {"tclInt.h"} + $PROJECT include {"tclFileSystem.h"} + $PROJECT include {} + $PROJECT include {} + $PROJECT include {} + $PROJECT include {} + $PROJECT include {} + + $PROJECT code header { +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif + +/* +** Provide a dummy Tcl_InitStubs if we are using this as a static +** library. +*/ +#ifndef USE_TCL_STUBS +# undef Tcl_InitStubs +# define Tcl_InitStubs(a,b,c) TCL_VERSION +#endif +#define STATIC_BUILD 1 +#undef USE_TCL_STUBS + +/* Make sure the stubbed variants of those are never used. */ +#undef Tcl_ObjSetVar2 +#undef Tcl_NewStringObj +#undef Tk_Init +#undef Tk_MainEx +#undef Tk_SafeInit +} + + # Build an area of the file for #define directives and + # function declarations + set define {} + set mainhook [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] + set mainfunc [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit] + set mainscript [$PROJECT define get main.tcl main.tcl] + set vfsroot [$PROJECT define get vfsroot zipfs:/app] + set vfs_main "${vfsroot}/${mainscript}" + set vfs_tcl_library "${vfsroot}/boot/tcl" + set vfs_tk_library "${vfsroot}/boot/tk" + + set map {} + foreach var { + vfsroot mainhook mainfunc vfs_main vfs_tcl_library vfs_tk_library + } { + dict set map %${var}% [set $var] + } + set preinitscript { +set ::odie(boot_vfs) {%vfsroot%} +set ::SRCDIR {%vfsroot%} +if {[file exists {%vfs_tcl_library%}]} { + set ::tcl_library {%vfs_tcl_library%} + set ::auto_path {} +} +if {[file exists {%vfs_tk_library%}]} { + set ::tk_library {%vfs_tk_library%} +} +} ; # Preinitscript + + set zvfsboot { +/* + * %mainhook% -- + * Performs the argument munging for the shell + */ + } + ::practcl::cputs zvfsboot { + CONST char *archive; + Tcl_FindExecutable(*argv[0]); + archive=Tcl_GetNameOfExecutable(); + + Tclzipfs_Init(NULL); + } + # We have to initialize the virtual filesystem before calling + # Tcl_Init(). Otherwise, Tcl_Init() will not be able to find + # its startup script files. + $PROJECT include {"tclZipfs.h"} + + ::practcl::cputs zvfsboot " if(!TclZipfsMount(NULL, archive, \"%vfsroot%\", NULL)) \x7B " + ::practcl::cputs zvfsboot { + Tcl_Obj *vfsinitscript; + vfsinitscript=Tcl_NewStringObj("%vfs_main%",-1); + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } + } + ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c $preinitscript])\;" + ::practcl::cputs zvfsboot " \x7D else \x7B" + ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c { +foreach path { + ../tcl +} { + set p [file join $path library init.tcl] + if {[file exists [file join $path library init.tcl]]} { + set ::tcl_library [file normalize [file join $path library]] + break + } +} +foreach path { + ../tk +} { + if {[file exists [file join $path library tk.tcl]]} { + set ::tk_library [file normalize [file join $path library]] + break + } +} +}])\;" + + ::practcl::cputs zvfsboot " \x7D" + + ::practcl::cputs zvfsboot " return TCL_OK;" + + if {[$PROJECT define get os] eq "windows"} { + set header {int %mainhook%(int *argc, TCHAR ***argv)} + } else { + set header {int %mainhook%(int *argc, char ***argv)} + } + $PROJECT c_function [string map $map $header] [string map $map $zvfsboot] + + practcl::cputs appinit "int %mainfunc%(Tcl_Interp *interp) \x7B" + + # Build AppInit() + set appinit {} + practcl::cputs appinit { + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; + } +} + set main_init_script {} + + foreach {statpkg info} $statpkglist { + set initfunc {} + if {[dict exists $info initfunc]} { + set initfunc [dict get $info initfunc] + } + if {$initfunc eq {}} { + set initfunc [string totitle ${statpkg}]_Init + } + # We employ a NULL to prevent the package system from thinking the + # package is actually loaded into the interpreter + $PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n" + set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]] + append main_init_script \n [list set ::kitpkg(${statpkg}) $script] + if {[dict get $info autoload]} { + ::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;" + ::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;" + } else { + ::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;" + append main_init_script \n $script + } + } + append main_init_script \n { +if {[file exists [file join $::SRCDIR packages.tcl]]} { + #In a wrapped exe, we don't go out to the environment + set dir $::SRCDIR + source [file join $::SRCDIR packages.tcl] +} +# Specify a user-specific startup file to invoke if the application +# is run interactively. Typically the startup file is "~/.apprc" +# where "app" is the name of the application. If this line is deleted +# then no user-specific startup file will be run under any conditions. + } + append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] + practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $main_init_script]);" + practcl::cputs appinit { return TCL_OK;} + $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] +} + +proc ::practcl::build::compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} { + set EXTERN_OBJS {} + set OBJECTS {} + set result {} + set builddir [$PROJECT define get builddir] + file mkdir [file join $builddir objs] + set debug [$PROJECT define get debug 0] + if {$CPPCOMPILE eq {}} { + set CPPCOMPILE $COMPILE + } + set task [${PROJECT} compile-products] + ### + # Compile the C sources + ### + foreach {ofile info} $task { + dict set task $ofile done 0 + if {[dict exists $info external] && [dict get $info external]==1} { + dict set task $ofile external 1 + } else { + dict set task $ofile external 0 + } + if {[dict exists $info library]} { + dict set task $ofile done 1 + continue + } + # Products with no cfile aren't compiled + if {![dict exists $info cfile] || [set cfile [dict get $info cfile]] eq {}} { + dict set task $ofile done 1 + continue + } + set cfile [dict get $info cfile] + set ofilename [file join $builddir objs [file tail $ofile]] + if {$debug} { + set ofilename [file join $builddir objs [file rootname [file tail $ofile]].debug.o] + } + dict set task $ofile filename $ofilename + if {[file exists $ofilename] && [file mtime $ofilename]>[file mtime $cfile]} { + lappend result $ofilename + dict set task $ofile done 1 + continue + } + if {![dict exist $info command]} { + if {[file extension $cfile] in {.c++ .cpp}} { + set cmd $CPPCOMPILE + } else { + set cmd $COMPILE + } + if {[dict exists $info extra]} { + append cmd " [dict get $info extra]" + } + append cmd " -c $cfile" + append cmd " -o $ofilename" + dict set task $ofile command $cmd + } + } + set completed 0 + while {$completed==0} { + set completed 1 + foreach {ofile info} $task { + set waiting {} + if {[dict exists $info done] && [dict get $info done]} continue + if {[dict exists $info depend]} { + foreach file [dict get $info depend] { + if {[dict exists $task $file command] && [dict exists $task $file done] && [dict get $task $file done] != 1} { + set waiting $file + break + } + } + } + if {$waiting ne {}} { + set completed 0 + puts "$ofile waiting for $waiting" + continue + } + if {[dict exists $info command]} { + set cmd [dict get $info command] + puts "$cmd" + exec {*}$cmd >&@ stdout + } + lappend result [dict get $info filename] + dict set task $ofile done 1 + } + } + return $result +} + +proc ::practcl::de_shell {data} { + set values {} + foreach flag {DEFS TCL_DEFS TK_DEFS} { + if {[dict exists $data $flag]} { + set value {} + foreach item [dict get $data $flag] { + append value " " [string map {{ } {\ }} $item] + } + dict set values $flag $value + } + } + set map {} + lappend map {${PKG_OBJECTS}} %LIBRARY_OBJECTS% + lappend map {$(PKG_OBJECTS)} %LIBRARY_OBJECTS% + lappend map {${PKG_STUB_OBJECTS}} %LIBRARY_STUB_OBJECTS% + lappend map {$(PKG_STUB_OBJECTS)} %LIBRARY_STUB_OBJECTS% + + lappend map %LIBRARY_NAME% [dict get $data name] + lappend map %LIBRARY_VERSION% [dict get $data version] + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} [dict get $data version]] + if {[dict exists $data libprefix]} { + lappend map %LIBRARY_PREFIX% [dict get $data libprefix] + } else { + lappend map %LIBRARY_PREFIX% [dict get $data prefix] + } + foreach flag [dict keys $data] { + if {$flag in {TCL_DEFS TK_DEFS DEFS}} continue + + dict set map "%${flag}%" [dict get $data $flag] + dict set map "\$\{${flag}\}" [dict get $data $flag] + dict set map "\$\(${flag}\)" [dict get $data $flag] + dict set values $flag [dict get $data $flag] + #dict set map "\$\{${flag}\}" $proj($flag) + } + set changed 1 + while {$changed} { + set changed 0 + foreach {field value} $values { + if {$field in {TCL_DEFS TK_DEFS DEFS}} continue + dict with values {} + set newval [string map $map $value] + if {$newval eq $value} continue + set changed 1 + dict set values $field $newval + } + } + return $values +} + +proc ::practcl::build::Makefile {path PROJECT} { + array set proj [$PROJECT define dump] + set path $proj(builddir) + cd $path + set includedir . + #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] + foreach include [$PROJECT generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + set INCLUDES "-I[join $includedir " -I"]" + set NAME [string toupper $proj(name)] + set result {} + set products {} + set libraries {} + set thisline {} + ::practcl::cputs result "${NAME}_DEFS = $proj(DEFS)\n" + ::practcl::cputs result "${NAME}_INCLUDES = -I\"[join $includedir "\" -I\""]\"\n" + ::practcl::cputs result "${NAME}_COMPILE = \$(CC) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" + ::practcl::cputs result "${NAME}_CPPCOMPILE = \$(CXX) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" + + foreach {ofile info} [$PROJECT compile-products] { + dict set products $ofile $info + if {[dict exists $info library]} { +lappend libraries $ofile +continue + } + if {[dict exists $info depend]} { + ::practcl::cputs result "\n${ofile}: [dict get $info depend]" + } else { + ::practcl::cputs result "\n${ofile}:" + } + set cfile [dict get $info cfile] + if {[file extension $cfile] in {.c++ .cpp}} { + set cmd "\t\$\(${NAME}_CPPCOMPILE\)" + } else { + set cmd "\t\$\(${NAME}_COMPILE\)" + } + if {[dict exists $info extra]} { + append cmd " [dict get $info extra]" + } + append cmd " -c [dict get $info cfile] -o \$@\n\t" + ::practcl::cputs result $cmd + } + + set map {} + lappend map %LIBRARY_NAME% $proj(name) + lappend map %LIBRARY_VERSION% $proj(version) + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] + lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix] + + if {[string is true [$PROJECT define get SHARED_BUILD]]} { + set outfile [$PROJECT define get libfile] + } else { + set outfile [$PROJECT shared_library] + } + $PROJECT define set shared_library $outfile + ::practcl::cputs result " +${NAME}_SHLIB = $outfile +${NAME}_OBJS = [dict keys $products] +" + + #lappend map %OUTFILE% {\[$]@} + lappend map %OUTFILE% $outfile + lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)" + ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]" + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]" + } + ::practcl::cputs result {} + if {[string is true [$PROJECT define get SHARED_BUILD]]} { + #set outfile [$PROJECT static_library] + set outfile $proj(name).a + } else { + set outfile [$PROJECT define get libfile] + } + $PROJECT define set static_library $outfile + dict set map %OUTFILE% $outfile + ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result {} + return $result +} + +### +# Produce a dynamic library +### +proc ::practcl::build::library {outfile PROJECT} { + array set proj [$PROJECT define dump] + set path $proj(builddir) + cd $path + set includedir . + #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] + if {[$PROJECT define get tk 0]} { + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]] + lappend includedir [::practcl::file_relative $path [file normalize $proj(TK_BIN_DIR)]] + } + foreach include [$PROJECT generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + ::practcl::build::DEFS $PROJECT $proj(DEFS) name version defs + set NAME [string toupper $name] + set debug [$PROJECT define get debug 0] + set os [$PROJECT define get os] + + set INCLUDES "-I[join $includedir " -I"]" + if {$debug} { + set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ +$proj(CFLAGS_WARNING) $INCLUDES $defs" + + if {[info exists proc(CXX)]} { + set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS_DEBUG) -ggdb \ + $proj(DEFS) $proj(CFLAGS_WARNING)" + } else { + set COMPILECPP $COMPILE + } + } else { + set COMPILE "$proj(CC) $proj(CFLAGS) $defs $INCLUDES " + + if {[info exists proc(CXX)]} { + set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS) $proj(DEFS)" + } else { + set COMPILECPP $COMPILE + } + } + + set products [compile-sources $PROJECT $COMPILE $COMPILECPP] + + set map {} + lappend map %LIBRARY_NAME% $proj(name) + lappend map %LIBRARY_VERSION% $proj(version) + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] + lappend map %OUTFILE% $outfile + lappend map %LIBRARY_OBJECTS% $products + lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)" + + if {[string is true [$PROJECT define get SHARED_BUILD 1]]} { + set cmd [$PROJECT define get PRACTCL_SHARED_LIB] + append cmd " [$PROJECT define get PRACTCL_LIBS]" + set cmd [string map $map $cmd] + puts $cmd + exec {*}$cmd >&@ stdout + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] + puts $cmd + exec {*}$cmd >&@ stdout + } + } else { + set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] + puts $cmd + exec {*}$cmd >&@ stdout + } +} + +### +# Produce a static executable +### +proc ::practcl::build::static-tclsh {outfile PROJECT} { + puts " BUILDING STATIC TCLSH " + set TCLOBJ [$PROJECT project TCLCORE] + set TKOBJ [$PROJECT project TKCORE] + set ODIEOBJ [$PROJECT project odie] + + set PKG_OBJS {} + foreach item [$PROJECT link list package] { + if {[string is true [$item define get static]]} { + lappend PKG_OBJS $item + } + } + array set TCL [$TCLOBJ config.sh] + array set TK [$TKOBJ config.sh] + set path [file dirname $outfile] + cd $path + ### + # For a static Tcl shell, we need to build all local sources + # with the same DEFS flags as the tcl core was compiled with. + # The DEFS produced by a TEA extension aren't intended to operate + # with the internals of a staticly linked Tcl + ### + ::practcl::build::DEFS $PROJECT $TCL(defs) name version defs + set debug [$PROJECT define get debug 0] + set NAME [string toupper $name] + set result {} + set libraries {} + set thisline {} + set OBJECTS {} + set EXTERN_OBJS {} + foreach obj $PKG_OBJS { + $obj compile + set config($obj) [$obj config.sh] + } + set os [$PROJECT define get os] + set TCLSRCDIR [$TCLOBJ define get srcroot] + set TKSRCDIR [$TKOBJ define get srcroot] + + set includedir . + foreach include [$TCLOBJ generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]] + foreach include [$PROJECT generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + + set INCLUDES "-I[join $includedir " -I"]" + if {$debug} { + set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) -ggdb \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } else { + set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } + append COMPILE " " $defs + lappend OBJECTS {*}[compile-sources $PROJECT $COMPILE $COMPILE] + + if {[${PROJECT} define get platform] eq "windows"} { + set RSOBJ [file join $path build tclkit.res.o] + set RCSRC [${PROJECT} define get kit_resource_file] + if {$RCSRC eq {} || ![file exists $RCSRC]} { + set RCSRC [file join $TKSRCDIR win rc wish.rc] + } + set cmd [list windres -o $RSOBJ -DSTATIC_BUILD] + set TCLSRC [file normalize $TCLSRCDIR] + set TKSRC [file normalize $TKSRCDIR] + + lappend cmd --include [::practcl::file_relative $path [file join $TCLSRC generic]] \ + --include [::practcl::file_relative $path [file join $TKSRC generic]] \ + --include [::practcl::file_relative $path [file join $TKSRC win]] \ + --include [::practcl::file_relative $path [file join $TKSRC win rc]] + foreach item [${PROJECT} define get resource_include] { + lappend cmd --include [::practcl::file_relative $path [file normalize $item]] + } + lappend cmd $RCSRC + doexec {*}$cmd + + lappend OBJECTS $RSOBJ + set LDFLAGS_CONSOLE {-mconsole -pipe -static-libgcc} + set LDFLAGS_WINDOW {-mwindows -pipe -static-libgcc} + } else { + set LDFLAGS_CONSOLE {} + set LDFLAGS_WINDOW {} + } + puts "***" + if {$debug} { + set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } else { + set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } + append cmd " $OBJECTS" + append cmd " $EXTERN_OBJS " + # On OSX it is impossibly to generate a completely static + # executable + if {[$PROJECT define get TEACUP_OS] ne "macosx"} { + append cmd " -static " + } + parray TCL + if {$debug} { + if {$os eq "windows"} { + append cmd " -L${TCL(src_dir)}/win -ltcl86g" + append cmd " -L${TK(src_dir)}/win -ltk86g" + } else { + append cmd " -L${TCL(src_dir)}/unix -ltcl86g" + append cmd " -L${TK(src_dir)}/unix -ltk86g" + } + } else { + append cmd " $TCL(build_lib_spec) $TK(build_lib_spec)" + } + foreach obj $PKG_OBJS { + append cmd " [$obj linker-products $config($obj)]" + } + append cmd " $TCL(libs) $TK(libs)" + foreach obj $PKG_OBJS { + append cmd " [$obj linker-external $config($obj)]" + } + if {$debug} { + if {$os eq "windows"} { + append cmd " -L${TCL(src_dir)}/win ${TCL(stub_lib_flag)}" + append cmd " -L${TK(src_dir)}/win ${TK(stub_lib_flag)}" + } else { + append cmd " -L${TCL(src_dir)}/unix ${TCL(stub_lib_flag)}" + append cmd " -L${TK(src_dir)}/unix ${TK(stub_lib_flag)}" + } + } else { + append cmd " $TCL(build_stub_lib_spec)" + append cmd " $TK(build_stub_lib_spec)" + } + append cmd " -o $outfile $LDFLAGS_CONSOLE" + puts "LINK: $cmd" + exec {*}$cmd >&@ stdout +} + +::oo::class create ::practcl::target_obj { + superclass ::practcl::metaclass + + constructor {name info} { + my variable define triggered domake + set triggered 0 + set domake 0 + set define(name) $name + set data [uplevel 2 [list subst $info]] + array set define $data + my select + my initialize + } + + method do {} { + my variable domake + return $domake + } + + method check {} { + my variable needs_make domake + if {$domake} { + return 1 + } + if {[info exists needs_make]} { + return $needs_make + } + set needs_make 0 + foreach item [my define get depends] { + if {![dict exists $::make_objects $item]} continue + set depobj [dict get $::make_objects $item] + if {$depobj eq [self]} { + puts "WARNING [self] depends on itself" + continue + } + if {[$depobj check]} { + set needs_make 1 + } + } + if {!$needs_make} { + set filename [my define get filename] + if {$filename ne {} && ![file exists $filename]} { + set needs_make 1 + } + } + return $needs_make + } + + method triggers {} { + my variable triggered domake define + if {$triggered} { + return $domake + } + set triggered 1 + foreach item [my define get depends] { + puts [list $item [dict exists $::make_objects $item]] + if {![dict exists $::make_objects $item]} continue + set depobj [dict get $::make_objects $item] + if {$depobj eq [self]} { + puts "WARNING [self] triggers itself" + continue + } else { + set r [$depobj check] + puts [list $depobj check $r] + if {$r} { + puts [list $depobj TRIGGER] + $depobj triggers + } + } + } + if {[info exists ::make($define(name))] && $::make($define(name))} { + return + } + set ::make($define(name)) 1 + ::practcl::trigger {*}[my define get triggers] + } +} + + +### +# Define the metaclass +### +::oo::class create ::practcl::object { + superclass ::practcl::metaclass + + constructor {parent args} { + my variable links define + set organs [$parent child organs] + my graft {*}$organs + array set define $organs + array set define [$parent child define] + array set links {} + if {[llength $args]==1 && [file exists [lindex $args 0]]} { + my InitializeSourceFile [lindex $args 0] + } elseif {[llength $args] == 1} { + set data [uplevel 1 [list subst [lindex $args 0]]] + array set define $data + my select + my initialize + } else { + array set define [uplevel 1 [list subst $args]] + my select + my initialize + } + } + + + method include_dir args { + my define add include_dir {*}$args + } + + method include_directory args { + my define add include_dir {*}$args + } + + method Collate_Source CWD {} + + + method child {method} { + return {} + } + + method InitializeSourceFile filename { + my define set filename $filename + set class {} + switch [file extension $filename] { + .tcl { + set class ::practcl::dynamic + } + .h { + set class ::practcl::cheader + } + .c { + set class ::practcl::csource + } + .ini { + switch [file tail $filename] { + module.ini { + set class ::practcl::module + } + library.ini { + set class ::practcl::subproject + } + } + } + .so - + .dll - + .dylib - + .a { + set class ::practcl::clibrary + } + } + if {$class ne {}} { + oo::objdefine [self] class $class + my initialize + } + } + + method add args { + my variable links + set object [::practcl::object new [self] {*}$args] + foreach linktype [$object linktype] { + lappend links($linktype) $object + } + return $object + } + + method go {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable links + foreach {linktype objs} [array get links] { + foreach obj $objs { + $obj go + } + } + debug [list /[self] [self method] [self class]] + } + + method code {section body} { + my variable code + ::practcl::cputs code($section) $body + } + + method Ofile filename { + set lpath [my define get localpath] + if {$lpath eq {}} { + set lpath [my define get name] + } + return ${lpath}_[file rootname [file tail $filename]].o + } + + method compile-products {} { + set filename [my define get filename] + set result {} + if {$filename ne {}} { + if {[my define exists ofile]} { + set ofile [my define get ofile] + } else { + set ofile [my Ofile $filename] + my define set ofile $ofile + } + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] + } + foreach item [my link list subordinate] { + lappend result {*}[$item compile-products] + } + return $result + } + + method generate-include-directory {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result [my define get include_dir] + foreach obj [my link list product] { + foreach path [$obj generate-include-directory] { + lappend result $path + } + } + return $result + } + + method generate-debug {{spaces {}}} { + set result {} + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" + foreach item [my link list subordinate] { + practcl::cputs result [$item generate-debug "$spaces "] + } + return $result + } + + # Empty template methods + method generate-cheader {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct cstruct methods tcltype tclprocs + set result {} + if {[info exists code(header)]} { + ::practcl::cputs result $code(header) + } + foreach obj [my link list product] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cheader */" + ::practcl::cputs result [$obj generate-cheader] + ::practcl::cputs result "/* END [$obj define get filename] generate-cheader */" + } + debug [list cfunct [info exists cfunct]] + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + if {[dict get $info public]} continue + ::practcl::cputs result "[dict get $info header]\;" + } + } + debug [list tclprocs [info exists tclprocs]] + if {[info exists tclprocs]} { + foreach {name info} $tclprocs { + if {[dict exists $info header]} { + ::practcl::cputs result "[dict get $info header]\;" + } + } + } + debug [list methods [info exists methods] [my define get cclass]] + + if {[info exists methods]} { + set thisclass [my define get cclass] + foreach {name info} $methods { + if {[dict exists $info header]} { + ::practcl::cputs result "[dict get $info header]\;" + } + } + # Add the initializer wrapper for the class + ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;" + } + return $result + } + + method generate-public-define {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code + set result {} + if {[info exists code(public-define)]} { + ::practcl::cputs result $code(public-define) + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-define] + } + return $result + } + + method generate-public-macro {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code + set result {} + if {[info exists code(public-macro)]} { + ::practcl::cputs result $code(public-macro) + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-macro] + } + return $result + } + + method generate-public-typedef {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cstruct + set result {} + if {[info exists code(public-typedef)]} { + ::practcl::cputs result $code(public-typedef) + } + if {[info exists cstruct]} { + # Add defintion for native c data structures + foreach {name info} $cstruct { + ::practcl::cputs result "typedef struct $name ${name}\;" + if {[dict exists $info aliases]} { + foreach n [dict get $info aliases] { + ::practcl::cputs result "typedef struct $name ${n}\;" + } + } + } + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-typedef] + } + return $result + } + + method generate-public-structure {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cstruct + set result {} + if {[info exists code(public-structure)]} { + ::practcl::cputs result $code(public-structure) + } + if {[info exists cstruct]} { + foreach {name info} $cstruct { + if {[dict exists $info comment]} { + ::practcl::cputs result [dict get $info comment] + } + ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" + } + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-structure] + } + return $result + } + method generate-public-headers {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code tcltype + set result {} + if {[info exists code(public-header)]} { + ::practcl::cputs result $code(public-header) + } + if {[info exists tcltype]} { + foreach {type info} $tcltype { + if {![dict exists $info cname]} { + set cname [string tolower ${type}]_tclobjtype + dict set tcltype $type cname $cname + } else { + set cname [dict get $info cname] + } + ::practcl::cputs result "extern const Tcl_ObjType $cname\;" + } + } + if {[info exists code(public)]} { + ::practcl::cputs result $code(public) + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-headers] + } + return $result + } + + method generate-stub-function {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct tcltype + set result {} + foreach mod [my link list product] { + foreach {funct def} [$mod generate-stub-function] { + dict set result $funct $def + } + } + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + if {![dict get $info export]} continue + dict set result $funcname [dict get $info header] + } + } + return $result + } + + method generate-public-function {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct tcltype + set result {} + + if {[my define get initfunc] ne {}} { + ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" + } + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + if {![dict get $info public]} continue + ::practcl::cputs result "[dict get $info header]\;" + } + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-function] + } + return $result + } + + method generate-public-includes {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set includes {} + foreach item [my define get public-include] { + if {$item ni $includes} { + lappend includes $item + } + } + foreach mod [my link list product] { + foreach item [$mod generate-public-includes] { + if {$item ni $includes} { + lappend includes $item + } + } + } + return $includes + } + method generate-public-verbatim {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set includes {} + foreach item [my define get public-verbatim] { + if {$item ni $includes} { + lappend includes $item + } + } + foreach mod [my link list subordinate] { + foreach item [$mod generate-public-verbatim] { + if {$item ni $includes} { + lappend includes $item + } + } + } + return $includes + } + ### + # This methods generates the contents of an amalgamated .h file + # which describes the public API of this module + ### + method generate-h {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + set includes [my generate-public-includes] + foreach inc $includes { + if {[string index $inc 0] ni {< \"}} { + ::practcl::cputs result "#include \"$inc\"" + } else { + ::practcl::cputs result "#include $inc" + } + } + foreach file [my generate-public-verbatim] { + ::practcl::cputs result "/* BEGIN $file */" + ::practcl::cputs result [::practcl::cat $file] + ::practcl::cputs result "/* END $file */" + } + foreach method { + generate-public-define + generate-public-macro + generate-public-typedef + generate-public-structure + generate-public-headers + generate-public-function + } { + ::practcl::cputs result "/* BEGIN SECTION $method */" + ::practcl::cputs result [my $method] + ::practcl::cputs result "/* END SECTION $method */" + } + return $result + } + + ### + # This methods generates the contents of an amalgamated .c file + # which implements the loader for a batch of tools + ### + method generate-c {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result { +/* This file was generated by practcl */ + } + set includes {} + lappend headers + if {[my define get tk 0]} { + lappend headers + } + lappend headers {*}[my define get include] + if {[my define get output_h] ne {}} { + lappend headers "\"[my define get output_h]\"" + } + foreach mod [my link list product] { + # Signal modules to formulate final implementation + $mod go + } + foreach mod [my link list dynamic] { + foreach inc [$mod define get include] { + if {$inc ni $headers} { + lappend headers $inc + } + } + } + foreach inc $headers { + if {[string index $inc 0] ni {< \"}} { + ::practcl::cputs result "#include \"$inc\"" + } else { + ::practcl::cputs result "#include $inc" + } + } + foreach {method} { + generate-cheader + generate-cstruct + generate-constant + generate-cfunct + generate-cmethod + } { + ::practcl::cputs result "/* BEGIN $method [my define get filename] */" + ::practcl::cputs result [my $method] + ::practcl::cputs result "/* END $method [my define get filename] */" + } + debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + return $result + } + + + method generate-loader {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + if {[my define get initfunc] eq {}} return + ::practcl::cputs result " +extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" + ::practcl::cputs result { + /* Initialise the stubs tables. */ + #ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR; + if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR; +} + if {[my define get tk 0]} { + ::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;} + } + ::practcl::cputs result { #endif} + set TCLINIT [my generate-tcl] + ::practcl::cputs result " if(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR ;" + foreach item [my link list product] { + if {[$item define get output_c] ne {}} { + ::practcl::cputs result [$item generate-cinit-external] + } else { + ::practcl::cputs result [$item generate-cinit] + } + } + if {[my define exists pkg_name]} { + ::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" + } + ::practcl::cputs result " return TCL_OK\;\n\}\n" + return $result + } + + ### + # This methods generates any Tcl script file + # which is required to pre-initialize the C library + ### + method generate-tcl {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + my variable code + if {[info exists code(tcl)]} { + ::practcl::cputs result $code(tcl) + } + set result [::practcl::_tagblock $result tcl [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-tcl] + } + return $result + } + + method static-packages {} { + set result [my define get static_packages] + set statpkg [my define get static_pkg] + set initfunc [my define get initfunc] + if {$initfunc ne {}} { + set pkg_name [my define get pkg_name] + if {$pkg_name ne {}} { + dict set result $pkg_name initfunc $initfunc + dict set result $pkg_name version [my define get version [my define get pkg_vers]] + dict set result $pkg_name autoload [my define get autoload 0] + } + } + foreach item [my link list subordinate] { + foreach {pkg info} [$item static-packages] { + dict set result $pkg $info + } + } + return $result + } + + method target {method args} { + switch $method { + is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] } + } + } + +} + +::oo::class create ::practcl::product { + superclass ::practcl::object + + method linktype {} { + return {subordinate product} + } + + method include header { + my define add include $header + } + + method cstructure {name definition {argdat {}}} { + my variable cstruct + dict set cstruct $name body $definition + foreach {f v} $argdat { + dict set cstruct $name $f $v + } + } + + method generate-cinit {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code + set result {} + if {[info exists code(cinit)]} { + ::practcl::cputs result $code(cinit) + } + if {[my define get initfunc] ne {}} { + ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach obj [my link list product] { + ::practcl::cputs result [$obj generate-cinit] + } + return $result + } +} + +### +# Dynamic blocks do not generate their own .c files, +# instead the contribute to the amalgamation +# of the main library file +### +::oo::class create ::practcl::dynamic { + superclass ::practcl::product + + # Retrieve any additional source files required + + method compile-products {} { + set filename [my define get output_c] + set result {} + if {$filename ne {}} { + if {[my define exists ofile]} { + set ofile [my define get ofile] + } else { + set ofile [my Ofile $filename] + my define set ofile $ofile + } + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + } else { + set filename [my define get cfile] + if {$filename ne {}} { + if {[my define exists ofile]} { + set ofile [my define get ofile] + } else { + set ofile [my Ofile $filename] + my define set ofile $ofile + } + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + } + } + foreach item [my link list subordinate] { + lappend result {*}[$item compile-products] + } + return $result + } + + method implement path { + my go + my Collate_Source $path + if {[my define get output_c] eq {}} return + set filename [file join $path [my define get output_c]] + my define set cfile $filename + set fout [open $filename w] + puts $fout [my generate-c] + puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" + puts $fout [my generate-cinit] + if {[my define get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" + } + puts $fout " return TCL_OK\;" + puts $fout "\x7D" + close $fout + } + + method initialize {} { + set filename [my define get filename] + if {$filename eq {}} { + return + } + if {[my define get name] eq {}} { + my define set name [file tail [file rootname $filename]] + } + if {[my define get localpath] eq {}} { + my define set localpath [my define get localpath]_[my define get name] + } + ::source $filename + } + + method linktype {} { + return {subordinate product dynamic} + } + + ### + # Populate const static data structures + ### + method generate-cstruct {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cstruct methods tcltype + set result {} + if {[info exists code(struct)]} { + ::practcl::cputs result $code(struct) + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result [$obj generate-cstruct] + } + return $result + } + + method generate-constant {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + my variable code cstruct methods tcltype + if {[info exists code(constant)]} { + ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result $code(constant) + } + if {[info exists cstruct]} { + foreach {name info} $cstruct { + set map {} + lappend map @NAME@ $name + lappend map @MACRO@ GET[string toupper $name] + + if {[dict exists $info deleteproc]} { + lappend map @DELETEPROC@ [dict get $info deleteproc] + } else { + lappend map @DELETEPROC@ NULL + } + if {[dict exists $info cloneproc]} { + lappend map @CLONEPROC@ [dict get $info cloneproc] + } else { + lappend map @CLONEPROC@ NULL + } + ::practcl::cputs result [string map $map { +const static Tcl_ObjectMetadataType @NAME@DataType = { + TCL_OO_METADATA_VERSION_CURRENT, + "@NAME@", + @DELETEPROC@, + @CLONEPROC@ +}; +#define @MACRO@(OBJCONTEXT) (@NAME@ *) Tcl_ObjectGetMetadata(OBJCONTEXT,&@NAME@DataType) +}] + } + } + if {[info exists tcltype]} { + foreach {type info} $tcltype { + dict with info {} + ::practcl::cputs result "const Tcl_ObjType $cname = \{\n .freeIntRepProc = &${freeproc},\n .dupIntRepProc = &${dupproc},\n .updateStringProc = &${updatestringproc},\n .setFromAnyProc = &${setfromanyproc}\n\}\;" + } + } + + if {[info exists methods]} { + set mtypes {} + foreach {name info} $methods { + set callproc [dict get $info callproc] + set methodtype [dict get $info methodtype] + if {$methodtype in $mtypes} continue + lappend mtypes $methodtype + ### + # Build the data struct for this method + ### + ::practcl::cputs result "const static Tcl_MethodType $methodtype = \{" + ::practcl::cputs result " .version = TCL_OO_METADATA_VERSION_CURRENT,\n .name = \"$name\",\n .callProc = $callproc," + if {[dict exists $info deleteproc]} { + set deleteproc [dict get $info deleteproc] + } else { + set deleteproc NULL + } + if {$deleteproc ni { {} NULL }} { + ::practcl::cputs result " .deleteProc = $deleteproc," + } else { + ::practcl::cputs result " .deleteProc = NULL," + } + if {[dict exists $info cloneproc]} { + set cloneproc [dict get $info cloneproc] + } else { + set cloneproc NULL + } + if {$cloneproc ni { {} NULL }} { + ::practcl::cputs result " .cloneProc = $cloneproc\n\}\;" + } else { + ::practcl::cputs result " .cloneProc = NULL\n\}\;" + } + dict set methods $name methodtype $methodtype + } + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result [$obj generate-constant] + } + return $result + } + + ### + # Generate code that provides subroutines called by + # Tcl API methods + ### + method generate-cfunct {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct + set result {} + if {[info exists code(funct)]} { + ::practcl::cputs result $code(funct) + } + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + ::practcl::cputs result "[dict get $info header]\{[dict get $info body]\}\;" + } + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} { + continue + } + ::practcl::cputs result [$obj generate-cfunct] + } + return $result + } + + ### + # Generate code that provides implements Tcl API + # calls + ### + method generate-cmethod {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code methods tclprocs + set result {} + if {[info exists code(method)]} { + ::practcl::cputs result $code(method) + } + + if {[info exists tclprocs]} { + foreach {name info} $tclprocs { + if {![dict exists $info body]} continue + set callproc [dict get $info callproc] + set header [dict get $info header] + set body [dict get $info body] + ::practcl::cputs result "${header} \{${body}\}" + } + } + + + if {[info exists methods]} { + set thisclass [my define get cclass] + foreach {name info} $methods { + if {![dict exists $info body]} continue + set callproc [dict get $info callproc] + set header [dict get $info header] + set body [dict get $info body] + ::practcl::cputs result "${header} \{${body}\}" + } + # Build the OO_Init function + ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{" + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my define get class]] { + /* + ** Build the "@TCLCLASS@" class + */ + Tcl_Obj* nameObj; /* Name of a class or method being looked up */ + Tcl_Object curClassObject; /* Tcl_Object representing the current class */ + Tcl_Class curClass; /* Tcl_Class representing the current class */ + + /* + * Find the "@TCLCLASS@" class, and attach an 'init' method to it. + */ + + nameObj = Tcl_NewStringObj("@TCLCLASS@", -1); + Tcl_IncrRefCount(nameObj); + if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { + Tcl_DecrRefCount(nameObj); + return TCL_ERROR; + } + Tcl_DecrRefCount(nameObj); + curClass = Tcl_GetObjectAsClass(curClassObject); +}] + if {[dict exists $methods constructor]} { + set mtype [dict get $methods constructor methodtype] + ::practcl::cputs result [string map [list @MTYPE@ $mtype] { + /* Attach the constructor to the class */ + Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &@MTYPE@, NULL)); + }] + } + foreach {name info} $methods { + dict with info {} + if {$name in {constructor destructor}} continue + ::practcl::cputs result [string map [list @NAME@ $name @MTYPE@ $methodtype] { + nameObj=Tcl_NewStringObj("@NAME@",-1); + Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); + Tcl_DecrRefCount(nameObj); +}] + if {[dict exists $info aliases]} { + foreach alias [dict get $info aliases] { + if {[dict exists $methods $alias]} continue + ::practcl::cputs result [string map [list @NAME@ $alias @MTYPE@ $methodtype] { + nameObj=Tcl_NewStringObj("@NAME@",-1); + Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); + Tcl_DecrRefCount(nameObj); +}] + } + } + } + ::practcl::cputs result " return TCL_OK\;\n\}\n" + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result [$obj generate-cmethod] + } + return $result + } + + method generate-cinit-external {} { + if {[my define get initfunc] eq {}} { + return "/* [my define get filename] declared not initfunc */" + } + return " if([my define get initfunc](interp)) return TCL_ERROR\;" + } + + ### + # Generate code that runs when the package/module is + # initialized into the interpreter + ### + method generate-cinit {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + my variable code methods tclprocs + if {[info exists code(nspace)]} { + ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" + foreach nspace $code(nspace) { + ::practcl::cputs result [string map [list @NSPACE@ $nspace] { + modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); + if(!modPtr) { + modPtr = Tcl_CreateNamespace(interp, "@NSPACE@", NULL, NULL); + } +}] + } + ::practcl::cputs result " \}" + } + if {[info exists code(tclinit)]} { + ::practcl::cputs result $code(tclinit) + } + if {[info exists code(cinit)]} { + ::practcl::cputs result $code(cinit) + } + if {[info exists code(initfuncts)]} { + foreach func $code(initfuncts) { + ::practcl::cputs result " if (${func}(interp) != TCL_OK) return TCL_ERROR\;" + } + } + if {[info exists tclprocs]} { + foreach {name info} $tclprocs { + set map [list @NAME@ $name @CALLPROC@ [dict get $info callproc]] + ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] + if {[dict exists $info aliases]} { + foreach alias [dict get $info aliases] { + set map [list @NAME@ $alias @CALLPROC@ [dict get $info callproc]] + ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] + } + } + } + } + + if {[info exists code(nspace)]} { + ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" + foreach nspace $code(nspace) { + ::practcl::cputs result [string map [list @NSPACE@ $nspace] { + modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); + Tcl_CreateEnsemble(interp, modPtr->fullName, modPtr, TCL_ENSEMBLE_PREFIX); + Tcl_Export(interp, modPtr, "[a-z]*", 1); +}] + } + ::practcl::cputs result " \}" + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach obj [my link list product] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} { + ::practcl::cputs result [$obj generate-cinit-external] + } else { + ::practcl::cputs result [$obj generate-cinit] + } + } + return $result + } + + method c_header body { + my variable code + ::practcl::cputs code(header) $body + } + + method c_code body { + my variable code + ::practcl::cputs code(funct) $body + } + method c_function {header body} { + my variable code cfunct + foreach regexp { + {(.*) ([a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} + {(.*) (\x2a[a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} + } { + if {[regexp $regexp $header all keywords funcname arglist]} { + dict set cfunct $funcname header $header + dict set cfunct $funcname body $body + dict set cfunct $funcname keywords $keywords + dict set cfunct $funcname arglist $arglist + dict set cfunct $funcname public [expr {"static" ni $keywords}] + dict set cfunct $funcname export [expr {"STUB_EXPORT" in $keywords}] + + return + } + } + ::practcl::cputs code(header) "$header\;" + # Could not parse that block as a function + # append it verbatim to our c_implementation + ::practcl::cputs code(funct) "$header [list $body]" + } + + + method cmethod {name body {arginfo {}}} { + my variable methods code + foreach {f v} $arginfo { + dict set methods $name $f $v + } + dict set methods $name body "Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ +$body" + } + + method c_tclproc_nspace nspace { + my variable code + if {![info exists code(nspace)]} { + set code(nspace) {} + } + if {$nspace ni $code(nspace)} { + lappend code(nspace) $nspace + } + } + + method c_tclproc_raw {name body {arginfo {}}} { + my variable tclprocs code + + foreach {f v} $arginfo { + dict set tclprocs $name $f $v + } + dict set tclprocs $name body $body + } + + method go {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + next + my variable methods code cstruct tclprocs + if {[info exists methods]} { + debug [self] methods [my define get cclass] + set thisclass [my define get cclass] + foreach {name info} $methods { + # Provide a callproc + if {![dict exists $info callproc]} { + set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]] + dict set methods $name callproc $callproc + } else { + set callproc [dict get $info callproc] + } + if {[dict exists $info body] && ![dict exists $info header]} { + dict set methods $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)" + } + if {![dict exists $info methodtype]} { + set methodtype [string map {{ } _ : _} MethodType_${thisclass}_${name}] + dict set methods $name methodtype $methodtype + } + } + if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { + lappend code(initfuncts) "${thisclass}_OO_Init" + } + } + set thisnspace [my define get nspace] + + if {[info exists tclprocs]} { + debug [self] tclprocs [dict keys $tclprocs] + foreach {name info} $tclprocs { + if {![dict exists $info callproc]} { + set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} Tclcmd_${thisnspace}_${name}]] + dict set tclprocs $name callproc $callproc + } else { + set callproc [dict get $info callproc] + } + if {[dict exists $info body] && ![dict exists $info header]} { + dict set tclprocs $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv\[\])" + } + } + } + debug [list /[self] [self method] [self class]] + } + + # Once an object marks itself as some + # flavor of dynamic, stop trying to morph + # it into something else + method select {} {} + + + method tcltype {name argdat} { + my variable tcltype + foreach {f v} $argdat { + dict set tcltype $name $f $v + } + if {![dict exists tcltype $name cname]} { + dict set tcltype $name cname [string tolower $name]_tclobjtype + } + lappend map @NAME@ $name + set info [dict get $tcltype $name] + foreach {f v} $info { + lappend map @[string toupper $f]@ $v + } + foreach {func fpat template} { + freeproc {@Name@Obj_freeIntRepProc} {void @FNAME@(Tcl_Obj *objPtr)} + dupproc {@Name@Obj_dupIntRepProc} {void @FNAME@(Tcl_Obj *srcPtr,Tcl_Obj *dupPtr)} + updatestringproc {@Name@Obj_updateStringRepProc} {void @FNAME@(Tcl_Obj *objPtr)} + setfromanyproc {@Name@Obj_setFromAnyProc} {int @FNAME@(Tcl_Interp *interp,Tcl_Obj *objPtr)} + } { + if {![dict exists $info $func]} { + error "$name does not define $func" + } + set body [dict get $info $func] + # We were given a function name to call + if {[llength $body] eq 1} continue + set fname [string map [list @Name@ [string totitle $name]] $fpat] + my c_function [string map [list @FNAME@ $fname] $template] [string map $map $body] + dict set tcltype $name $func $fname + } + } +} + +::oo::class create ::practcl::cheader { + superclass ::practcl::product + + method compile-products {} {} + method generate-cinit {} {} +} + +::oo::class create ::practcl::csource { + superclass ::practcl::product +} + +::oo::class create ::practcl::clibrary { + superclass ::practcl::product + + method linker-products {configdict} { + return [my define get filename] + } + +} + +### +# In the end, all C code must be loaded into a module +# This will either be a dynamically loaded library implementing +# a tcl extension, or a compiled in segment of a custom shell/app +### +::oo::class create ::practcl::module { + superclass ::practcl::dynamic + + method child which { + switch $which { + organs { + return [list project [my define get project] module [self]] + } + } + } + + method initialize {} { + set filename [my define get filename] + if {$filename eq {}} { + return + } + if {[my define get name] eq {}} { + my define set name [file tail [file dirname $filename]] + } + if {[my define get localpath] eq {}} { + my define set localpath [my define get name]_[my define get name] + } + debug [self] SOURCE $filename + my source $filename + } + + method implement path { + my go + my Collate_Source $path + foreach item [my link list dynamic] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + foreach item [my link list module] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set filename [my define get output_c] + if {$filename eq {}} { + debug [list /[self] [self method] [self class]] + return + } + set cout [open [file join $path [file rootname $filename].c] w] + puts $cout [subst {/* +** This file is generated by the [info script] script +** any changes will be overwritten the next time it is run +*/}] + puts $cout [my generate-c] + puts $cout [my generate-loader] + close $cout + debug [list /[self] [self method] [self class]] + } + + method linktype {} { + return {subordinate product dynamic module} + } +} + +::oo::class create ::practcl::autoconf { + + ### + # find or fake a key/value list describing this project + ### + method config.sh {} { + my variable conf_result + if {[info exists conf_result]} { + return $conf_result + } + set result {} + set name [my define get name] + set PWD $::CWD + set builddir [my define get builddir] + my unpack + set srcroot [my define get srcroot] + if {![file exists $builddir]} { + my Configure + } + set filename [file join $builddir config.tcl] + # Project uses the practcl template. Use the leavings from autoconf + if {[file exists $filename]} { + set dat [::practcl::config.tcl $builddir] + foreach {item value} [lsort -stride 2 -dictionary $dat] { + dict set result $item $value + } + set conf_result $result + return $result + } + set filename [file join $builddir ${name}Config.sh] + if {[file exists $filename]} { + set l [expr {[string length $name]+1}] + foreach {field dat} [::practcl::read_Config.sh $filename] { + set field [string tolower $field] + if {[string match ${name}_* $field]} { + set field [string range $field $l end] + } + dict set result $field $dat + } + set conf_result $result + return $result + } + ### + # Oh man... we have to guess + ### + set filename [file join $builddir Makefile] + if {![file exists $filename]} { + error "Could not locate any configuration data in $srcroot" + } + foreach {field dat} [::practcl::read_Makefile $filename] { + dict set result $field $dat + } + set conf_result $result + cd $PWD + return $result + } +} + + +::oo::class create ::practcl::project { + superclass ::practcl::module ::practcl::autoconf + + constructor args { + my variable define + if {[llength $args] == 1} { + if {[catch {uplevel 1 [list subst [lindex $args 0]]} contents]} { + set contents [lindex $args 0] + } + } else { + if {[catch {uplevel 1 [list subst $args]} contents]} { + set contents $args + } + } + array set define $contents + my select + my initialize + } + + + method add_project {pkg info {oodefine {}}} { + set os [my define get os] + if {$os eq {}} { + set os [::practcl::os] + my define set os $os + } + set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] + if {[dict exists $info os] && ($os ni [dict get $info os])} return + # Select which tag to use here. + # For production builds: tag-release + if {[::info exists ::env(FOSSIL_MIRROR)]} { + dict set info localmirror $::env(FOSSIL_MIRROR) + } + set profile [my define get profile release]: + if {[dict exists $info profile $profile]} { + dict set info tag [dict get $info profile $profile] + } + set obj [namespace current]::PROJECT.$pkg + if {[info command $obj] eq {}} { + set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]] + } + my link object $obj + oo::objdefine $obj $oodefine + $obj define set masterpath $::CWD + $obj go + return $obj + } + + method child which { + switch $which { + organs { + # A library can be a project, it can be a module. Any + # subordinate modules will indicate their existance + return [list project [self] module [self]] + } + } + } + + method linktype {} { + return project + } + + # Exercise the methods of a sub-object + method project {pkg args} { + set obj [namespace current]::PROJECT.$pkg + if {[llength $args]==0} { + return $obj + } + tailcall ${obj} {*}$args + } +} + +::oo::class create ::practcl::library { + superclass ::practcl::project + + method compile-products {} { + set result {} + foreach item [my link list subordinate] { + lappend result {*}[$item compile-products] + } + set filename [my define get output_c] + if {$filename ne {}} { + set ofile [file rootname [file tail $filename]]_main.o + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + } + return $result + } + + method generate-tcl-loader {} { + set result {} + set PKGINIT [my define get pkginit] + set PKG_NAME [my define get name [my define get pkg_name]] + set PKG_VERSION [my define get pkg_vers [my define get version]] + if {[string is true [my define get SHARED_BUILD 0]]} { + set LIBFILE [my define get libfile] + ::practcl::cputs result [string map \ + [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { +# Shared Library Style +load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ +package provide @PKG_NAME@ @PKG_VERSION@ +}] + } else { + ::practcl::cputs result [string map \ + [list @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { +# Tclkit Style +load {} @PKGINIT@ +package provide @PKG_NAME@ @PKG_VERSION@ +}] + } + return $result + } + + method go {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set name [my define getnull name] + if {$name eq {}} { + set name generic + my define name generic + } + if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { + my define set tk 0 + } + set output_c [my define getnull output_c] + if {$output_c eq {}} { + set output_c [file rootname $name].c + my define set output_c $output_c + } + set output_h [my define getnull output_h] + if {$output_h eq {}} { + set output_h [file rootname $output_c].h + my define set output_h $output_h + } + set output_tcl [my define getnull output_tcl] + #if {$output_tcl eq {}} { + # set output_tcl [file rootname $output_c].tcl + # my define set output_tcl $output_tcl + #} + #set output_mk [my define getnull output_mk] + #if {$output_mk eq {}} { + # set output_mk [file rootname $output_c].mk + # my define set output_mk $output_mk + #} + set initfunc [my define getnull initfunc] + if {$initfunc eq {}} { + set initfunc [string totitle $name]_Init + my define set initfunc $initfunc + } + set output_decls [my define getnull output_decls] + if {$output_decls eq {}} { + set output_decls [file rootname $output_c].decls + my define set output_decls $output_decls + } + my variable links + foreach {linktype objs} [array get links] { + foreach obj $objs { + $obj go + } + } + debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + } + + method implement path { + my go + my Collate_Source $path + foreach item [my link list dynamic] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + foreach item [my link list module] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + set cout [open [file join $path [my define get output_c]] w] + puts $cout [subst {/* +** This file is generated by the [info script] script +** any changes will be overwritten the next time it is run +*/}] + puts $cout [my generate-c] + puts $cout [my generate-loader] + close $cout + + set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H + set hout [open [file join $path [my define get output_h]] w] + puts $hout [subst {/* +** This file is generated by the [info script] script +** any changes will be overwritten the next time it is run +*/}] + puts $hout "#ifndef ${macro}" + puts $hout "#define ${macro}" + puts $hout [my generate-h] + puts $hout "#endif" + close $hout + + set output_tcl [my define get output_tcl] + if {$output_tcl ne {}} { + set tclout [open [file join $path [my define get output_tcl]] w] + puts $tclout "### +# This file is generated by the [info script] script +# any changes will be overwritten the next time it is run +###" + puts $tclout [my generate-tcl] + puts $tclout [my generate-tcl-loader] + close $tclout + } + } + + method generate-decls {pkgname path} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set outfile [file join $path/$pkgname.decls] + + ### + # Build the decls file + ### + set fout [open $outfile w] + puts $fout [subst {### + # $outfile + # + # This file was generated by [info script] + ### + + library $pkgname + interface $pkgname + }] + + ### + # Generate list of functions + ### + set stubfuncts [my generate-stub-function] + set thisline {} + set functcount 0 + foreach {func header} $stubfuncts { + puts $fout [list declare [incr functcount] $header] + } + puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"] + puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] + + close $fout + + ### + # Build [package]Decls.h + ### + set hout [open [file join $path ${pkgname}Decls.h] w] + + close $hout + + set cout [open [file join $path ${pkgname}StubInit.c] w] +puts $cout [string map [list %pkgname% $pkgname %PkgName% [string totitle $pkgname]] { +#ifndef USE_TCL_STUBS +#define USE_TCL_STUBS +#endif +#undef USE_TCL_STUB_PROCS + +#include "tcl.h" +#include "%pkgname%.h" + + /* + ** Ensure that Tdom_InitStubs is built as an exported symbol. The other stub + ** functions should be built as non-exported symbols. + */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +%PkgName%Stubs *%pkgname%StubsPtr; + + /* + **---------------------------------------------------------------------- + ** + ** %PkgName%_InitStubs -- + ** + ** Checks that the correct version of %PkgName% is loaded and that it + ** supports stubs. It then initialises the stub table pointers. + ** + ** Results: + ** The actual version of %PkgName% that satisfies the request, or + ** NULL to indicate that an error occurred. + ** + ** Side effects: + ** Sets the stub table pointers. + ** + **---------------------------------------------------------------------- + */ + +char * +%PkgName%_InitStubs (Tcl_Interp *interp, char *version, int exact) +{ + char *actualVersion; + actualVersion = Tcl_PkgRequireEx(interp, "%pkgname%", version, exact,(ClientData *) &%pkgname%StubsPtr); + if (!actualVersion) { + return NULL; + } + if (!%pkgname%StubsPtr) { + Tcl_SetResult(interp,"This implementation of %PkgName% does not support stubs",TCL_STATIC); + return NULL; + } + return actualVersion; +} +}] + close $cout + } + + # Backward compadible call + method generate-make path { + ::practcl::build::Makefile $path [self] + } + + method install-headers {} { + set result {} + return $result + } + + method linktype {} { + return library + } + + # Create a "package ifneeded" + # Args are a list of aliases for which this package will answer to + method package-ifneeded {args} { + set result {} + set name [my define get pkg_name [my define get name]] + set version [my define get pkg_vers [my define get version]] + if {$version eq {}} { + set version 0.1a + } + set output_tcl [my define get output_tcl] + if {$output_tcl ne {}} { + set script "\[list source \[file join \$dir $output_tcl\]\]" + } elseif {[string is true -strict [my define get SHARED_BUILD]]} { + set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" + } else { + # Provide a null passthrough + set script [list package provide $name $version] + } + set result "package ifneeded [list $name] [list $version] $script" + foreach alias $args { + set script "package require $name $version \; package provide $alias $version" + append result \n\n [list package ifneeded $alias $version $script] + } + return $result + } + + + method shared_library {} { + set name [string tolower [my define get name [my define get pkg_name]]] + set NAME [string toupper $name] + set version [my define get version [my define get pkg_vers]] + set map {} + lappend map %LIBRARY_NAME% $name + lappend map %LIBRARY_VERSION% $version + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] + lappend map %LIBRARY_PREFIX% [my define getnull libprefix] + set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] + return $outfile + } +} + +::oo::class create ::practcl::tclkit { + superclass ::practcl::library + + method Collate_Source CWD { + my define set SHARED_BUILD 0 + set name [my define get name] + + if {![my define exists TCL_LOCAL_APPINIT]} { + my define set TCL_LOCAL_APPINIT Tclkit_AppInit + } + if {![my define exists TCL_LOCAL_MAIN_HOOK]} { + my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + } + + set PROJECT [self] + set os [$PROJECT define get os] + set TCLOBJ [$PROJECT project TCLCORE] + set TKOBJ [$PROJECT project TKCORE] + set ODIEOBJ [$PROJECT project odie] + + set TCLSRCDIR [$TCLOBJ define get srcroot] + set TKSRCDIR [$TKOBJ define get srcroot] + set PKG_OBJS {} + foreach item [$PROJECT link list package] { + if {[string is true [$item define get static]]} { + lappend PKG_OBJS $item + } + } + # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK + if {$os eq "windows"} { + set PLATFORM_SRC_DIR win + my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 + my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 + my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] + } else { + set PLATFORM_SRC_DIR unix + my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] + } + ### + # Add local static Zlib implementation + ### + set cdir [file join $TCLSRCDIR compat zlib] + foreach file { + adler32.c compress.c crc32.c + deflate.c infback.c inffast.c + inflate.c inftrees.c trees.c + uncompr.c zutil.c + } { + my add [file join $cdir $file] + } + + ### + # Pre 8.7, Tcl doesn't include a Zipfs implementation + # in the core. Grab the one from odielib + ### + set zipfs [file join $TCLSRCDIR generic zvfs.c] + if {![file exists $zipfs]} { + # The Odie project maintains a mirror of the version + # released with the Tcl core + my add_project odie { + tag trunk + class subproject + vfsinstall 0 + } + my project odie unpack + set ODIESRCROOT [my project odie define get srcroot] + set cdir [file join $ODIESRCROOT compat zipfs] + my define add include_dir $cdir + set zipfs [file join $cdir zvfs.c] + } + + my add class csource filename $zipfs initfunc Tclzipfs_Init pkg_name zipfs pkg_vers 1.0 autoload 1 + + my define add include_dir [file join $TKSRCDIR generic] + my define add include_dir [file join $TKSRCDIR $PLATFORM_SRC_DIR] + my define add include_dir [file join $TKSRCDIR bitmaps] + my define add include_dir [file join $TKSRCDIR xlib] + my define add include_dir [file join $TCLSRCDIR generic] + my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my define add include_dir [file join $TCLSRCDIR compat zlib] + # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK + ::practcl::build::tclkit_main $PROJECT $PKG_OBJS + } + + ## Wrap an executable + # + method wrap {PWD exename vfspath args} { + cd $PWD + if {![file exists $vfspath]} { + file mkdir $vfspath + } + foreach item [my link list core.library] { + set name [$item define get name] + set libsrcroot [$item define get srcroot] + if {[file exists [file join $libsrcroot library]]} { + ::practcl::copyDir [file join $libsrcroot library] [file join $vfspath boot $name] + } + } + if {[my define get installdir] ne {}} { + ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] + } + foreach arg $args { + ::practcl::copyDir $arg $vfspath + } + + set fout [open [file join $vfspath packages.tcl] w] + puts $fout { + set ::PKGIDXFILE [info script] + set dir [file dirname $::PKGIDXFILE] + } + #set BASEVFS [my define get BASEVFS] + set EXEEXT [my define get EXEEXT] + + set tclkit_bare [my define get tclkit_bare] + + set buffer [::practcl::pkgindex_path $vfspath] + puts $fout $buffer + puts $fout { + # Advertise statically linked packages + foreach {pkg script} [array get ::kitpkg] { + eval $script + } + } + close $fout + package require zipfile::mkzip + ::zipfile::mkzip::mkzip ${exename}${EXEEXT} -runtime $tclkit_bare -directory $vfspath + if { [my define get platform] ne "windows" } { + file attributes ${exename}${EXEEXT} -permissions a+x + } + } +} + +### +# Meta repository +# The default is an inert source code block +### +oo::class create ::practcl::subproject { + superclass ::practcl::object + + method compile {} {} + + method go {} { + set platform [my define get platform] + my define get USEMSVC [my define get USEMSVC] + set name [my define get name] + if {![my define exists srcroot]} { + my define set srcroot [file join [my define get sandbox] $name] + } + set srcroot [my define get srcroot] + my define set localsrcdir $srcroot + my define add include_dir [file join $srcroot generic] + my sources + } + + # Install project into the local build system + method install-local {} { + my unpack + } + + # Install project into the virtual file system + method install-vfs {} {} + + method linktype {} { + return {subordinate package} + } + + method linker-products {configdict} {} + + method linker-external {configdict} { + if {[dict exists $configdict PRACTCL_LIBS]} { + return [dict get $configdict PRACTCL_LIBS] + } + } + + method sources {} {} + + method unpack {} { + set name [my define get name] + puts [list $name [self] UNPACK] + my define set [::practcl::fossil_sandbox $name [my define dump]] + } + + method update {} { + set name [my define get name] + my define set [::practcl::fossil_sandbox $name [dict merge [my define dump] {update 1}]] + } +} + +### +# A project which the kit compiles and integrates +# the source for itself +### +oo::class create ::practcl::subproject.source { + superclass ::practcl::subproject ::practcl::library + + method linktype {} { + return {subordinate package source} + } + +} + +# a copy from the teapot +oo::class create ::practcl::subproject.teapot { + superclass ::practcl::subproject + + method install-local {} { + my install-vfs + } + + method install-vfs {} { + set pkg [my define get pkg_name [my define get name]] + set download [my define get download] + my unpack + set DEST [my define get installdir] + set prefix [string trimleft [my define get prefix] /] + # Get tcllib from our destination + set dir [file join $DEST $prefix lib tcllib] + source [file join $DEST $prefix lib tcllib pkgIndex.tcl] + package require zipfile::decode + ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] + } +} + +oo::class create ::practcl::subproject.sak { + superclass ::practcl::subproject + + method install-local {} { + my install-vfs + } + + method install-vfs {} { + ### + # Handle teapot installs + ### + set pkg [my define get pkg_name [my define get name]] + my unpack + set DEST [my define get installdir] + set prefix [string trimleft [my define get prefix] /] + set srcroot [my define get srcroot] + ::dotclexec [file join $srcroot installer.tcl] \ + -pkg-path [file join $DEST $prefix lib $pkg] \ + -no-examples -no-html -no-nroff \ + -no-wait -no-gui -no-apps + } +} + +### +# A binary package +### +oo::class create ::practcl::subproject.binary { + superclass ::practcl::subproject ::practcl::autoconf + + + method compile-products {} {} + + method ConfigureOpts {} { + set opts {} + set builddir [my define get builddir] + if {[my define get broken_destroot 0]} { + set PREFIX [my define get prefix_broken_destdir] + } else { + set PREFIX [my define get prefix] + } + if {[my define get HOST] != [my define get TARGET]} { + lappend opts --host=[my define get TARGET] + } + if {[my define exists tclsrcdir]} { + set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir]]]] + set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir] .. generic]]] + lappend opts --with-tcl=$TCLSRCDIR --with-tclinclude=$TCLGENERIC + } + if {[my define exists tksrcdir]} { + set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir]]]] + set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir] .. generic]]] + lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC + } + lappend opts {*}[my define get config_opts] + lappend opts --prefix=$PREFIX + #--exec_prefix=$PREFIX + #if {$::tcl_platform(platform) eq "windows"} { + # lappend opts --disable-64bit + #} + if {[my define get static 1]} { + lappend opts --disable-shared --disable-stubs + # + } else { + lappend opts --enable-shared + } + return $opts + } + + method go {} { + next + my define set builddir [my BuildDir [my define get masterpath]] + } + + method linker-products {configdict} { + if {![my define get static 0]} { + return {} + } + set srcdir [my define get builddir] + if {[dict exists $configdict libfile]} { + return " [file join $srcdir [dict get $configdict libfile]]" + } + } + + method static-packages {} { + if {![my define get static 0]} { + return {} + } + set result [my define get static_packages] + set statpkg [my define get static_pkg] + set initfunc [my define get initfunc] + if {$initfunc ne {}} { + set pkg_name [my define get pkg_name] + if {$pkg_name ne {}} { + dict set result $pkg_name initfunc $initfunc + set version [my define get version] + if {$version eq {}} { + set info [my config.sh] + set version [dict get $info version] + set pl {} + if {[dict exists $info patch_level]} { + set pl [dict get $info patch_level] + append version $pl + } + my define set version $version + } + dict set result $pkg_name version $version + dict set result $pkg_name autoload [my define get autoload 0] + } + } + foreach item [my link list subordinate] { + foreach {pkg info} [$item static-packages] { + dict set result $pkg $info + } + } + return $result + } + + method BuildDir {PWD} { + set name [my define get name] + return [my define get builddir [file join $PWD pkg.$name]] + } + + method compile {} { + set name [my define get name] + set PWD $::CWD + cd $PWD + my go + set srcroot [file normalize [my define get srcroot]] + my Collate_Source $PWD + + ### + # Build a starter VFS for both Tcl and wish + ### + set srcroot [my define get srcroot] + if {[my define get static 1]} { + puts "BUILDING Static $name $srcroot" + } else { + puts "BUILDING Dynamic $name $srcroot" + } + if {[my define get USEMSVC 0]} { + cd $srcroot + doexec nmake -f makefile.vc INSTALLDIR=[my define get installdir] release + } else { + cd $::CWD + set builddir [file normalize [my define get builddir]] + file mkdir $builddir + if {![file exists [file join $builddir Makefile]]} { + my Configure + } + if {[file exists [file join $builddir make.tcl]]} { + domake.tcl $builddir library + } else { + domake $builddir all + } + } + cd $PWD + } + + + method Configure {} { + cd $::CWD + my unpack + my TeaConfig + set builddir [file normalize [my define get builddir]] + file mkdir $builddir + set srcroot [file normalize [my define get srcroot]] + if {[my define get USEMSVC 0]} { + return + } + set opts [my ConfigureOpts] + puts [list [self] CONFIGURE] + puts [list PWD [pwd]] + puts [list LOCALSRC $srcroot] + puts [list BUILDDIR $builddir] + puts [list CONFIGURE {*}$opts] + cd $builddir + exec sh [file join $srcroot configure] {*}$opts >& [file join $builddir practcl.log] + cd $::CWD + } + + method install-vfs {} { + set PWD [pwd] + set PKGROOT [my define get installdir] + set PREFIX [my define get prefix] + + ### + # Handle teapot installs + ### + set pkg [my define get pkg_name [my define get name]] + if {[my define get teapot] ne {}} { + set TEAPOT [my define get teapot] + set found 0 + foreach ver [my define get pkg_vers [my define get version]] { + set teapath [file join $TEAPOT $pkg$ver] + if {[file exists $teapath]} { + set dest [file join $PKGROOT [string trimleft $PREFIX /] lib [file tail $teapath]] + ::practcl::copyDir $teapath $dest + return + } + } + } + my compile + if {[my define get USEMSVC 0]} { + set srcroot [my define get srcroot] + cd $srcroot + puts "[self] VFS INSTALL $PKGROOT" + doexec nmake -f makefile.vc INSTALLDIR=$PKGROOT install + } else { + set builddir [my define get builddir] + if {[file exists [file join $builddir make.tcl]]} { + # Practcl builds can inject right to where we need them + puts "[self] VFS INSTALL $PKGROOT (Practcl)" + domake.tcl $builddir install-package $PKGROOT + } elseif {[my define get broken_destroot 0] == 0} { + # Most modern TEA projects understand DESTROOT in the makefile + puts "[self] VFS INSTALL $PKGROOT (TEA)" + domake $builddir install DESTDIR=$PKGROOT + } else { + # But some require us to do an install into a fictitious filesystem + # and then extract the gooey parts within. + # (*cough*) TkImg + set PREFIX [my define get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my define get prefix_broken_destdir]] + file delete -force $BROKENROOT + file mkdir $BROKENROOT + domake $builddir $install + ::practcl::copyDir $BROKENROOT [file join $PKGROOT [string trimleft $PREFIX /]] + file delete -force $BROKENROOT + } + } + cd $PWD + } + + method TeaConfig {} { + set srcroot [file normalize [my define get srcroot]] + set copytea 0 + if {![file exists [file join $srcroot tclconfig]]} { + set copytea 1 + } else { + if {![file exists [file join $srcroot tclconfig practcl.tcl]] || ![file exists [file join $srcroot tclconfig config.tcl.in]]} { + set copytea 1 + } + } + # ensure we have tclconfig with all of the trimming + if {$copytea} { + set tclconfiginfo [::practcl::fossil_sandbox tclconfig [list sandbox [my define get sandbox]]] + ::practcl::copyDir [dict get $tclconfiginfo srcroot] [file join $srcroot tclconfig] + if {$::tcl_platform(platform) ne "windows"} { + set pwd [pwd] + cd $srcroot + # On windows there's no practical way to execute + # autoconf. We'll have to trust that configure + # us up to date + foreach template {configure.ac configure.in} { + set input [file join $srcroot $template] + if {[file exists $input]} { + puts "autoconf -f $input > [file join $srcroot configure]" + exec autoconf -f $input > [file join $srcroot configure] + } + } + cd $pwd + } + } + } +} + +oo::class create ::practcl::subproject.core { + superclass ::practcl::subproject.binary + + # On the windows platform MinGW must build + # from the platform directory in the source repo + method BuildDir {PWD} { + return [my define get localsrcdir] + } + + method Configure {} { + if {[my define get USEMSVC 0]} { + return + } + set opts [my ConfigureOpts] + puts [list PWD [pwd]] + puts [list [self] CONFIGURE] + set builddir [file normalize [my define get builddir]] + set localsrcdir [file normalize [my define get localsrcdir]] + puts [list LOCALSRC $localsrcdir] + puts [list BUILDDIR $builddir] + puts [list CONFIGURE {*}$opts] + cd $localsrcdir + exec sh [file join $localsrcdir configure] {*}$opts >& [file join $builddir practcl.log] + } + + method ConfigureOpts {} { + set opts {} + set builddir [file normalize [my define get builddir]] + set PREFIX [my define get prefix] + if {[my define get HOST] != [my define get TARGET]} { + lappend opts --host=[my define get TARGET] + } + lappend opts {*}[my define get config_opts] + lappend opts --prefix=$PREFIX + #--exec_prefix=$PREFIX + lappend opts --disable-shared + return $opts + } + + method go {} { + set name [my define get name] + set platform [my define get platform] + if {![my define exists srcroot]} { + my define set srcroot [file join [my define get sandbox] $name] + } + set srcroot [my define get srcroot] + my define add include_dir [file join $srcroot generic] + switch $platform { + windows { + my define set localsrcdir [file join $srcroot win] + my define add include_dir [file join $srcroot win] + } + default { + my define set localsrcdir [file join $srcroot unix] + my define add include_dir [file join $srcroot $name unix] + } + } + my define set builddir [my BuildDir [my define get masterpath]] + } + + method linktype {} { + return {subordinate core.library} + } +} + +package provide practcl 0.5 diff --git a/unix/Makefile.in b/unix/Makefile.in index 1afc883..ca15312 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -308,7 +308,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ - tclTomMathInterface.o zipfs.o + tclTomMathInterface.o tclZipfs.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o @@ -373,7 +373,6 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclInt.h \ $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ - $(GENERIC_DIR)/tclZipfs.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h \ $(GENERIC_DIR)/tclOO.h \ @@ -954,7 +953,6 @@ install-headers: @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclPlatDecls.h \ - $(GENERIC_DIR)/tclZipfs.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h ; \ do \ @@ -1324,8 +1322,8 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c -zipfs.o: $(GENERIC_DIR)/zipfs.c - $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/zipfs.c +tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 2dcd192..9bbc88b 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -15,9 +15,7 @@ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" -#ifdef HAVE_ZLIB -#include "tclZipfs.h" -#endif + #ifdef TCL_TEST extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; @@ -42,7 +40,6 @@ extern Tcl_PackageInitProc Tclxttest_Init; #endif MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); MODULE_SCOPE int main(int, char **); -MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *,const char *); /* * The following #if block allows you to change how Tcl finds the startup @@ -83,12 +80,7 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif - #define TCLKIT_INIT "main.tcl" - #define TCLKIT_VFSMOUNT "/zvfs" - #define TCLKIT_PASSWD NULL - Tcl_FindExecutable(argv[0]); - CONST char *cp=Tcl_GetNameOfExecutable(); - Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT,TCLKIT_PASSWD); + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -119,11 +111,7 @@ Tcl_AppInit( if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } - /* Load the zipfs package */ - if (Tclzipfs_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); + #ifdef TCL_XT_TEST if (Tclxttest_Init(interp) == TCL_ERROR) { return TCL_ERROR; diff --git a/win/Makefile.in b/win/Makefile.in index e4ca501..118ccb1 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -152,6 +152,7 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} +TCLKIT = tclkit$(VER)${EXESUFFIX} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -303,7 +304,7 @@ GENERIC_OBJS = \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ tclZlib.$(OBJEXT) \ - zipfs.$(OBJEXT) + tclZipfs.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -399,6 +400,8 @@ STUB_OBJS = \ TCLSH_OBJS = tclAppInit.$(OBJEXT) +TCLKIT_OBJS = tclkitMain.${OBJEXT} tclkit.${OBJEXT} + ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ @@ -420,7 +423,7 @@ all: binaries libraries doc packages tcltest: $(TCLSH) $(TEST_DLL_FILE) -binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) $(TCLKIT) winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} @@ -433,6 +436,11 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ +$(TCLKIT): $(TCLKIT_OBJ) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLKIT_OBJ) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ + cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -496,6 +504,9 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +tclkitMain.${OBJEXT}: tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_LOCAL_MAIN_HOOK="Tclkit_MainHook" -DTCL_LOCAL_APPINIT="Tclkit_AppInit" @DEPARG@ $(CC_OBJNAME) + # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed diff --git a/win/makefile.vc b/win/makefile.vc index ec7afac..cf7d422 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -345,7 +345,7 @@ COREOBJS = \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ $(TMP_DIR)\tclZlib.obj \ - $(TMP_DIR)\zipfs.obj + $(TMP_DIR)\tclZipfs.obj ZLIBOBJS = \ $(TMP_DIR)\adler32.obj \ diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 1c3ef9b..e06eaf5 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -25,13 +25,10 @@ #include #ifdef TCL_TEST -#include "tclZipfs.h" extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ -MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); - #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES extern Tcl_PackageInitProc Registry_Init; extern Tcl_PackageInitProc Dde_Init; @@ -128,13 +125,7 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif -#ifdef TCL_ZIPVFS - #define TCLKIT_INIT "main.tcl" - #define TCLKIT_VFSMOUNT "/zvfs" - Tcl_FindExecutable(argv[0]); - CONST char *cp=Tcl_GetNameOfExecutable(); - Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT); -#endif + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } @@ -165,9 +156,6 @@ Tcl_AppInit( if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } - if(Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit) == TCL_ERROR ) { - return TCL_ERROR; - } #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES if (Registry_Init(interp) == TCL_ERROR) { @@ -186,9 +174,6 @@ Tcl_AppInit( return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); - if (Tclzipfs_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } #endif /* TCL_TEST */ /* -- cgit v0.12 From 58ab27bf86284012b5dba6df12a30f10ecee6491 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 14 Sep 2016 13:36:27 +0000 Subject: Fixed the line endings on practcl.tcl --- library/practcl/practcl.tcl | 7998 +++++++++++++++++++++---------------------- 1 file changed, 3999 insertions(+), 3999 deletions(-) diff --git a/library/practcl/practcl.tcl b/library/practcl/practcl.tcl index 3b4b04e..f285116 100644 --- a/library/practcl/practcl.tcl +++ b/library/practcl/practcl.tcl @@ -1,4000 +1,4000 @@ -### -# Practcl -# An object oriented templating system for stamping out Tcl API calls to C -### -puts [list LOADED practcl.tcl from [info script]] -package require TclOO -proc ::debug args { - #puts $args - ::practcl::cputs ::DEBUG_INFO $args -} - -### -# Drop in a static copy of Tcl -### -proc ::doexec args { - puts [list {*}$args] - exec {*}$args >&@ stdout -} - -proc ::dotclexec args { - puts [list [info nameofexecutable] {*}$args] - exec [info nameofexecutable] {*}$args >&@ stdout -} - -proc ::domake {path args} { - set PWD [pwd] - cd $path - puts [list *** $path ***] - puts [list make {*}$args] - exec make {*}$args >&@ stdout - cd $PWD -} - -proc ::domake.tcl {path args} { - set PWD [pwd] - cd $path - puts [list *** $path ***] - puts [list make.tcl {*}$args] - exec [info nameofexecutable] make.tcl {*}$args >&@ stdout - cd $PWD -} - -proc ::fossil {path args} { - set PWD [pwd] - cd $path - puts [list {*}$args] - exec fossil {*}$args >&@ stdout - cd $PWD -} - - -proc ::fossil_status {dir} { - if {[info exists ::fosdat($dir)]} { - return $::fosdat($dir) - } - set result { -tags experimental -version {} - } - set pwd [pwd] - cd $dir - set info [exec fossil status] - cd $pwd - foreach line [split $info \n] { - if {[lindex $line 0] eq "checkout:"} { - set hash [lindex $line end-3] - set maxdate [lrange $line end-2 end-1] - dict set result hash $hash - dict set result maxdate $maxdate - regsub -all {[^0-9]} $maxdate {} isodate - dict set result isodate $isodate - } - if {[lindex $line 0] eq "tags:"} { - set tags [lrange $line 1 end] - dict set result tags $tags - break - } - } - set ::fosdat($dir) $result - return $result -} -### -# Seek out Tcllib if it's available -### -set tcllib_path {} -foreach path {.. ../.. ../../..} { - foreach path [glob -nocomplain [file join [file normalize $path] tcllib* modules]] { - set tclib_path $path - lappend ::auto_path $path - break - } - if {$tcllib_path ne {}} break -} - - -### -# Build utility functions -### -namespace eval ::practcl {} - -proc ::practcl::os {} { - if {[info exists ::project(TEACUP_OS)] && $::project(TEACUP_OS) ni {"@TEACUP_OS@" {}}} { - return $::project(TEACUP_OS) - } - set info [::practcl::config.tcl $::project(builddir)] - if {[dict exists $info TEACUP_OS]} { - return [dict get $info TEACUP_OS] - } - return unknown -} - -### -# Detect local platform -### -proc ::practcl::config.tcl {path} { - dict set result buildpath $path - set result {} - if {[file exists [file join $path config.tcl]]} { - set fin [open [file join $path config.tcl] r] - set bufline {} - set rawcount 0 - set linecount 0 - while {[gets $fin thisline]>=0} { - incr rawcount - append bufline \n $thisline - if {![info complete $bufline]} continue - set line [string trimleft $bufline] - set bufline {} - if {[string index [string trimleft $line] 0] eq "#"} continue - incr linecount - set key [lindex $line 0] - set value [lindex $line 1] - dict set result $key $value - } - dict set result sandbox [file dirname [dict get $result srcdir]] - dict set result download [file join [dict get $result sandbox] download] - dict set result teapot [file join [dict get $result sandbox] teapot] - set result [::practcl::de_shell $result] - } - # If data is available from autoconf, defer to that - if {[dict exists $result TEACUP_OS] && [dict get $result TEACUP_OS] ni {"@TEACUP_OS@" {}}} { - return $result - } - # If autoconf hasn't run yet, assume we are not cross compiling - # and defer to local checks - dict set result TEACUP_PROFILE unknown - dict set result TEACUP_OS unknown - dict set result EXEEXT {} - if {$::tcl_platform(platform) eq "windows"} { - set system "windows" - set arch ix86 - dict set result TEACUP_PROFILE win32-ix86 - dict set result TEACUP_OS windows - dict set result EXEEXT .exe - } else { - set system [exec uname -s]-[exec uname -r] - set arch unknown - dict set result TEACUP_OS generic - } - dict set result TEA_PLATFORM $system - dict set result TEA_SYSTEM $system - switch -glob $system { - Linux* { - dict set result TEACUP_OS linux - set arch [exec uname -m] - dict set result TEACUP_PROFILE "linux-glibc2.3-$arch" - } - GNU* { - set arch [exec uname -m] - dict set result TEACUP_OS "gnu" - } - NetBSD-Debian { - set arch [exec uname -m] - dict set result TEACUP_OS "netbsd-debian" - } - OpenBSD-* { - set arch [exec arch -s] - dict set result TEACUP_OS "openbsd" - } - Darwin* { - set arch [exec uname -m] - dict set result TEACUP_OS "macosx" - if {$arch eq "x86_64"} { - dict set result TEACUP_PROFILE "macosx10.5-i386-x86_84" - } else { - dict set result TEACUP_PROFILE "macosx-universal" - } - } - OpenBSD* { - set arch [exec arch -s] - dict set result TEACUP_OS "openbsd" - } - } - if {$arch eq "unknown"} { - catch {set arch [exec uname -m]} - } - switch -glob $arch { - i*86 { - set arch "ix86" - } - amd64 { - set arch "x86_64" - } - } - dict set result TEACUP_ARCH $arch - if {[dict get $result TEACUP_PROFILE] eq "unknown"} { - dict set result TEACUP_PROFILE [dict get $result TEACUP_OS]-$arch - } - return $result -} - - -### -# Convert an MSYS path to a windows native path -### -if {$::tcl_platform(platform) eq "windows"} { -proc ::practcl::msys_to_tclpath msyspath { - return [exec sh -c "cd $msyspath ; pwd -W"] -} -} else { -proc ::practcl::msys_to_tclpath msyspath { - return [file normalize $msyspath] -} -} - -### -# Bits stolen from fileutil -### -proc ::practcl::cat fname { - set fname [open $fname r] - set data [read $fname] - close $fname - return $data -} - -proc ::practcl::file_lexnormalize {sp} { - set spx [file split $sp] - - # Resolution of embedded relative modifiers (., and ..). - - if { - ([lsearch -exact $spx . ] < 0) && - ([lsearch -exact $spx ..] < 0) - } { - # Quick path out if there are no relative modifiers - return $sp - } - - set absolute [expr {![string equal [file pathtype $sp] relative]}] - # A volumerelative path counts as absolute for our purposes. - - set sp $spx - set np {} - set noskip 1 - - while {[llength $sp]} { - set ele [lindex $sp 0] - set sp [lrange $sp 1 end] - set islast [expr {[llength $sp] == 0}] - - if {[string equal $ele ".."]} { - if { - ($absolute && ([llength $np] > 1)) || - (!$absolute && ([llength $np] >= 1)) - } { - # .. : Remove the previous element added to the - # new path, if there actually is enough to remove. - set np [lrange $np 0 end-1] - } - } elseif {[string equal $ele "."]} { - # Ignore .'s, they stay at the current location - continue - } else { - # A regular element. - lappend np $ele - } - } - if {[llength $np] > 0} { - return [eval [linsert $np 0 file join]] - # 8.5: return [file join {*}$np] - } - return {} -} - -proc ::practcl::file_relative {base dst} { - # Ensure that the link to directory 'dst' is properly done relative to - # the directory 'base'. - - if {![string equal [file pathtype $base] [file pathtype $dst]]} { - return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)" - } - - set base [file_lexnormalize [file join [pwd] $base]] - set dst [file_lexnormalize [file join [pwd] $dst]] - - set save $dst - set base [file split $base] - set dst [file split $dst] - - while {[string equal [lindex $dst 0] [lindex $base 0]]} { - set dst [lrange $dst 1 end] - set base [lrange $base 1 end] - if {![llength $dst]} {break} - } - - set dstlen [llength $dst] - set baselen [llength $base] - - if {($dstlen == 0) && ($baselen == 0)} { - # Cases: - # (a) base == dst - - set dst . - } else { - # Cases: - # (b) base is: base/sub = sub - # dst is: base = {} - - # (c) base is: base = {} - # dst is: base/sub = sub - - while {$baselen > 0} { - set dst [linsert $dst 0 ..] - incr baselen -1 - } - # 8.5: set dst [file join {*}$dst] - set dst [eval [linsert $dst 0 file join]] - } - - return $dst -} - -### -# Unpack the source of a fossil project into a designated location -### -proc ::practcl::fossil_sandbox {pkg args} { - if {[llength $args]==1} { - set info [lindex $args 0] - } else { - set info $args - } - set result $info - if {[dict exists $info srcroot]} { - set srcroot [dict get $info srcroot] - } elseif {[dict exists $info sandbox]} { - set srcroot [file join [dict get $info sandbox] $pkg] - } else { - set srcroot [file join $::CWD .. $pkg] - } - dict set result srcroot $srcroot - puts [list fossil_sandbox $pkg $srcroot] - if {[dict exists $info download]} { - ### - # Source is actually a zip archive - ### - set download [dict get $info download] - if {[file exists [file join $download $pkg.zip]]} { - if {![info exists $srcroot]} { - package require zipfile::decode - ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcroot - } - return - } - } - variable fossil_dbs - if {![::info exists fossil_dbs]} { - # Get a list of local fossil databases - set fossil_dbs [exec fossil all list] - } - set CWD [pwd] - if {![dict exists $info tag]} { - set tag trunk - } else { - set tag [dict get $info tag] - } - dict set result tag $tag - - try { - if {[file exists [file join $srcroot .fslckout]]} { - if {[dict exists $info update] && [dict get $info update]==1} { - catch { - puts "FOSSIL UPDATE" - cd $srcroot - doexec fossil update $tag - } - } - } elseif {[file exists [file join $srcroot _FOSSIL_]]} { - if {[dict exists $info update] && [dict get $info update]==1} { - catch { - puts "FOSSIL UPDATE" - cd $srcroot - doexec fossil update $tag - } - } - } else { - puts "OPEN AND UNPACK" - set fosdb {} - foreach line [split $fossil_dbs \n] { - set line [string trim $line] - if {[file rootname [file tail $line]] eq $pkg} { - set fosdb $line - break - } - } - if {$fosdb eq {}} { - file mkdir [file join $download fossil] - set fosdb [file join $download fossil $pkg.fos] - set cloned 0 - if {[dict exists $info localmirror]} { - set localmirror [dict get $info localmirror] - catch { - doexec fossil clone $localmirror/$pkg $fosdb - set cloned 1 - } - } - if {!$cloned && [dict exists $info fossil_url]} { - set localmirror [dict get $info fossil_url] - catch { - doexec fossil clone $localmirror/$pkg $fosdb - set cloned 1 - } - } - if {!$cloned} { - doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb - } - } - file mkdir $srcroot - cd $srcroot - puts "FOSSIL OPEN [pwd]" - doexec fossil open $fosdb $tag - } - } on error {result opts} { - puts [list ERR [dict get $opts -errorinfo]] - return {*}$opts - } finally { - cd $CWD - } - return $result -} - -### -# topic: e71f3f61c348d56292011eec83e95f0aacc1c618 -# description: Converts a XXX.sh file into a series of Tcl variables -### -proc ::practcl::read_sh_subst {line info} { - regsub -all {\x28} $line \x7B line - regsub -all {\x29} $line \x7D line - - #set line [string map $key [string trim $line]] - foreach {field value} $info { - catch {set $field $value} - } - if [catch {subst $line} result] { - return {} - } - set result [string trim $result] - return [string trim $result '] -} - -### -# topic: 03567140cca33c814664c7439570f669b9ab88e6 -### -proc ::practcl::read_sh_file {filename {localdat {}}} { - set fin [open $filename r] - set result {} - if {$localdat eq {}} { - set top 1 - set local [array get ::env] - dict set local EXE {} - } else { - set top 0 - set local $localdat - } - while {[gets $fin line] >= 0} { - set line [string trim $line] - if {[string index $line 0] eq "#"} continue - if {$line eq {}} continue - catch { - if {[string range $line 0 6] eq "export "} { - set eq [string first "=" $line] - set field [string trim [string range $line 6 [expr {$eq - 1}]]] - set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] - dict set result $field [read_sh_subst $value $local] - dict set local $field $value - } elseif {[string range $line 0 7] eq "include "} { - set subfile [read_sh_subst [string range $line 7 end] $local] - foreach {field value} [read_sh_file $subfile $local] { - dict set result $field $value - } - } else { - set eq [string first "=" $line] - if {$eq > 0} { - set field [read_sh_subst [string range $line 0 [expr {$eq - 1}]] $local] - set value [string trim [string range $line [expr {$eq+1}] end] '] - #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] - dict set local $field $value - dict set result $field $value - } - } - } err opts - if {[dict get $opts -code] != 0} { - #puts $opts - puts "Error reading line:\n$line\nerr: $err\n***" - return $err {*}$opts - } - } - return $result -} - -### -# A simpler form of read_sh_file tailored -# to pulling data from (tcl|tk)Config.sh -### -proc ::practcl::read_Config.sh filename { - set fin [open $filename r] - set result {} - set linecount 0 - while {[gets $fin line] >= 0} { - set line [string trim $line] - if {[string index $line 0] eq "#"} continue - if {$line eq {}} continue - catch { - set eq [string first "=" $line] - if {$eq > 0} { - set field [string range $line 0 [expr {$eq - 1}]] - set value [string trim [string range $line [expr {$eq+1}] end] '] - #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] - dict set result $field $value - incr $linecount - } - } err opts - if {[dict get $opts -code] != 0} { - #puts $opts - puts "Error reading line:\n$line\nerr: $err\n***" - return $err {*}$opts - } - } - return $result -} - -### -# A simpler form of read_sh_file tailored -# to pulling data from a Makefile -### -proc ::practcl::read_Makefile filename { - set fin [open $filename r] - set result {} - while {[gets $fin line] >= 0} { - set line [string trim $line] - if {[string index $line 0] eq "#"} continue - if {$line eq {}} continue - catch { - set eq [string first "=" $line] - if {$eq > 0} { - set field [string trim [string range $line 0 [expr {$eq - 1}]]] - set value [string trim [string trim [string range $line [expr {$eq+1}] end] ']] - switch $field { - PKG_LIB_FILE { - dict set result libfile $value - } - srcdir { - if {$value eq "."} { - dict set result srcdir [file dirname $filename] - } else { - dict set result srcdir $value - } - } - PACKAGE_NAME { - dict set result name $value - } - PACKAGE_VERSION { - dict set result version $value - } - LIBS { - dict set result PRACTCL_LIBS $value - } - PKG_LIB_FILE { - dict set result libfile $value - } - } - } - } err opts - if {[dict get $opts -code] != 0} { - #puts $opts - puts "Error reading line:\n$line\nerr: $err\n***" - return $err {*}$opts - } - # the Compile field is about where most TEA files start getting silly - if {$field eq "compile"} { - break - } - } - return $result -} - -## Append arguments to a buffer -# The command works like puts in that each call will also insert -# a line feed. Unlike puts, blank links in the interstitial are -# suppressed -proc ::practcl::cputs {varname args} { - upvar 1 $varname buffer - if {[llength $args]==1 && [string length [string trim [lindex $args 0]]] == 0} { - - } - if {[info exist buffer]} { - if {[string index $buffer end] ne "\n"} { - append buffer \n - } - } else { - set buffer \n - } - # Trim leading \n's - append buffer [string trimleft [lindex $args 0] \n] {*}[lrange $args 1 end] -} - - -proc ::practcl::tcl_to_c {body} { - set result {} - foreach rawline [split $body \n] { - set line [string map [list \" \\\" \\ \\\\] $rawline] - cputs result "\n \"$line\\n\" \\" - } - return [string trimright $result \\] -} - - -proc ::practcl::_tagblock {text {style tcl} {note {}}} { - if {[string length [string trim $text]]==0} { - return {} - } - set output {} - switch $style { - tcl { - ::practcl::cputs output "# BEGIN $note" - } - c { - ::practcl::cputs output "/* BEGIN $note */" - } - default { - ::practcl::cputs output "# BEGIN $note" - } - } - ::practcl::cputs output $text - switch $style { - tcl { - ::practcl::cputs output "# END $note" - } - c { - ::practcl::cputs output "/* END $note */" - } - default { - ::practcl::cputs output "# END $note" - } - } - return $output -} - -proc ::practcl::_isdirectory name { - return [file isdirectory $name] -} - -### -# Return true if the pkgindex file contains -# any statement other than "package ifneeded" -# and/or if any package ifneeded loads a DLL -### -proc ::practcl::_pkgindex_directory {path} { - set buffer {} - set pkgidxfile [file join $path pkgIndex.tcl] - if {![file exists $pkgidxfile]} { - # No pkgIndex file, read the source - foreach file [glob -nocomplain $path/*.tm] { - set file [file normalize $file] - set fname [file rootname [file tail $file]] - ### - # We used to be able to ... Assume the package is correct in the filename - # No hunt for a "package provides" - ### - set package [lindex [split $fname -] 0] - set version [lindex [split $fname -] 1] - ### - # Read the file, and override assumptions as needed - ### - set fin [open $file r] - set dat [read $fin] - close $fin - # Look for a teapot style Package statement - foreach line [split $dat \n] { - set line [string trim $line] - if { [string range $line 0 9] != "# Package " } continue - set package [lindex $line 2] - set version [lindex $line 3] - break - } - # Look for a package provide statement - foreach line [split $dat \n] { - set line [string trim $line] - if { [string range $line 0 14] != "package provide" } continue - set package [lindex $line 2] - set version [lindex $line 3] - break - } - append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n - } - foreach file [glob -nocomplain $path/*.tcl] { - if { [file tail $file] == "version_info.tcl" } continue - set fin [open $file r] - set dat [read $fin] - close $fin - if {![regexp "package provide" $dat]} continue - set fname [file rootname [file tail $file]] - # Look for a package provide statement - foreach line [split $dat \n] { - set line [string trim $line] - if { [string range $line 0 14] != "package provide" } continue - set package [lindex $line 2] - set version [lindex $line 3] - if {[string index $package 0] in "\$ \["} continue - if {[string index $version 0] in "\$ \["} continue - append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n - break - } - } - return $buffer - } - set fin [open $pkgidxfile r] - set dat [read $fin] - close $fin - set thisline {} - foreach line [split $dat \n] { - append thisline $line \n - if {![info complete $thisline]} continue - set line [string trim $line] - if {[string length $line]==0} { - set thisline {} ; continue - } - if {[string index $line 0] eq "#"} { - set thisline {} ; continue - } - try { - # Ignore contditionals - if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} continue - if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} continue - if {![regexp "package.*ifneeded" $thisline]} { - # This package index contains arbitrary code - # source instead of trying to add it to the master - # package index - return {source [file join $dir pkgIndex.tcl]} - } - append buffer $thisline \n - } on error {err opts} { - puts *** - puts "GOOF: $pkgidxfile" - puts $line - puts $err - puts [dict get $opts -errorinfo] - puts *** - } finally { - set thisline {} - } - } - return $buffer -} - - -proc ::practcl::_pkgindex_path_subdir {path} { - set result {} - foreach subpath [glob -nocomplain [file join $path *]] { - if {[file isdirectory $subpath]} { - lappend result $subpath {*}[_pkgindex_path_subdir $subpath] - } - } - return $result -} -### -# Index all paths given as though they will end up in the same -# virtual file system -### -proc ::practcl::pkgindex_path args { - set stack {} - set buffer { -lappend ::PATHSTACK $dir - } - foreach base $args { - set base [file normalize $base] - set paths [::practcl::_pkgindex_path_subdir $base] - set i [string length $base] - # Build a list of all of the paths - foreach path $paths { - if {$path eq $base} continue - set path_indexed($path) 0 - } - set path_indexed($base) 1 - set path_indexed([file join $base boot tcl]) 1 - #set path_index([file join $base boot tk]) 1 - - foreach path $paths { - if {$path_indexed($path)} continue - set thisdir [file_relative $base $path] - #set thisdir [string range $path $i+1 end] - set idxbuf [::practcl::_pkgindex_directory $path] - if {[string length $idxbuf]} { - incr path_indexed($path) - append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n - append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n - } - } - } - append buffer { -set dir [lindex $::PATHSTACK end] -set ::PATHSTACK [lrange $::PATHSTACK 0 end-1] -} - return $buffer -} - -### -# topic: 64319f4600fb63c82b2258d908f9d066 -# description: Script to build the VFS file system -### -proc ::practcl::installDir {d1 d2} { - - puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]] - file delete -force -- $d2 - file mkdir $d2 - - foreach ftail [glob -directory $d1 -nocomplain -tails *] { - set f [file join $d1 $ftail] - if {[file isdirectory $f] && [string compare CVS $ftail]} { - installDir $f [file join $d2 $ftail] - } elseif {[file isfile $f]} { - file copy -force $f [file join $d2 $ftail] - if {$::tcl_platform(platform) eq {unix}} { - file attributes [file join $d2 $ftail] -permissions 0644 - } else { - file attributes [file join $d2 $ftail] -readonly 1 - } - } - } - - if {$::tcl_platform(platform) eq {unix}} { - file attributes $d2 -permissions 0755 - } else { - file attributes $d2 -readonly 1 - } -} - -proc ::practcl::copyDir {d1 d2} { - #puts [list $d1 -> $d2] - #file delete -force -- $d2 - file mkdir $d2 - - foreach ftail [glob -directory $d1 -nocomplain -tails *] { - set f [file join $d1 $ftail] - if {[file isdirectory $f] && [string compare CVS $ftail]} { - copyDir $f [file join $d2 $ftail] - } elseif {[file isfile $f]} { - file copy -force $f [file join $d2 $ftail] - } - } -} - -::oo::class create ::practcl::metaclass { - superclass ::oo::object - - method script script { - eval $script - } - - method source filename { - source $filename - } - - method initialize {} {} - - method define {submethod args} { - my variable define - switch $submethod { - dump { - return [array get define] - } - add { - set field [lindex $args 0] - if {![info exists define($field)]} { - set define($field) {} - } - foreach arg [lrange $args 1 end] { - if {$arg ni $define($field)} { - lappend define($field) $arg - } - } - return $define($field) - } - remove { - set field [lindex $args 0] - if {![info exists define($field)]} { - return - } - set rlist [lrange $args 1 end] - set olist $define($field) - set nlist {} - foreach arg $olist { - if {$arg in $rlist} continue - lappend nlist $arg - } - set define($field) $nlist - return $nlist - } - exists { - set field [lindex $args 0] - return [info exists define($field)] - } - getnull - - get - - cget { - set field [lindex $args 0] - if {[info exists define($field)]} { - return $define($field) - } - return [lindex $args 1] - } - set { - if {[llength $args]==1} { - set arglist [lindex $args 0] - } else { - set arglist $args - } - array set define $arglist - if {[dict exists $arglist class]} { - my select - } - } - default { - array $submethod define {*}$args - } - } - } - - method graft args { - my variable organs - if {[llength $args] == 1} { - error "Need two arguments" - } - set object {} - foreach {stub object} $args { - dict set organs $stub $object - oo::objdefine [self] forward <${stub}> $object - oo::objdefine [self] export <${stub}> - } - return $object - } - - method organ {{stub all}} { - my variable organs - if {![info exists organs]} { - return {} - } - if { $stub eq "all" } { - return $organs - } - if {[dict exists $organs $stub]} { - return [dict get $organs $stub] - } - } - - method link {command args} { - my variable links - switch $command { - object { - foreach obj $args { - foreach linktype [$obj linktype] { - my link add $linktype $obj - } - } - } - add { - ### - # Add a link to an object that was externally created - ### - if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"} - lassign $args linktype object - if {[info exists links($linktype)] && $object in $links($linktype)} { - return - } - lappend links($linktype) $object - } - remove { - set object [lindex $args 0] - if {[llength $args]==1} { - set ltype * - } else { - set ltype [lindex $args 1] - } - foreach {linktype elements} [array get links $ltype] { - if {$object in $elements} { - set nlist {} - foreach e $elements { - if { $object ne $e } { lappend nlist $e } - } - set links($linktype) $nlist - } - } - } - list { - if {[llength $args]==0} { - return [array get links] - } - if {[llength $args] != 1} { error "Usage: link list LINKTYPE"} - set linktype [lindex $args 0] - if {![info exists links($linktype)]} { - return {} - } - return $links($linktype) - } - dump { - return [array get links] - } - } - } - - method select {} { - my variable define - set class {} - if {[info exists define(class)]} { - if {[info command $define(class)] ne {}} { - set class $define(class) - } elseif {[info command ::practcl::$define(class)] ne {}} { - set class ::practcl::$define(class) - } else { - switch $define(class) { - default { - set class ::practcl::object - } - } - } - } - if {$class ne {}} { - ::oo::objdefine [self] class $class - } - if {[::info exists define(oodefine)]} { - ::oo::objdefine [self] $define(oodefine) - unset define(oodefine) - } - } -} - -proc ::practcl::trigger {args} { - foreach name $args { - if {[dict exists $::make_objects $name]} { - [dict get $::make_objects $name] triggers - } - } -} - -proc ::practcl::depends {args} { - foreach name $args { - if {[dict exists $::make_objects $name]} { - [dict get $::make_objects $name] check - } - } -} - -proc ::practcl::target {name info} { - set obj [::practcl::target_obj new $name $info] - dict set ::make_objects $name $obj - if {[dict exists $info aliases]} { - foreach item [dict get $info aliases] { - if {![dict exists $::make_objects $item]} { - dict set ::make_objects $item $obj - } - } - } - set ::make($name) 0 - set ::trigger($name) 0 - set filename [$obj define get filename] - if {$filename ne {}} { - set ::target($name) $filename - } -} - -### Batch Tasks - -namespace eval ::practcl::build {} - -## method DEFS -# This method populates 4 variables: -# name - The name of the package -# version - The version of the package -# defs - C flags passed to the compiler -# includedir - A list of paths to feed to the compiler for finding headers -# -proc ::practcl::build::DEFS {PROJECT DEFS namevar versionvar defsvar} { - upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs - set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]] - set NAME [string toupper $name] - set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] - if {$version eq {}} { - set version 0.1a - } - set defs {} - append defs " -DPACKAGE_NAME=\"${name}\" -DPACKAGE_VERSION=\"${version}\"" - append defs " -DPACKAGE_TARNAME=\"${name}\" -DPACKAGE_STRING=\"${name}\x5c\x20${version}\"" - set NAME [string toupper $name] - set idx 0 - set count 0 - while {$idx>=0} { - set ndx [string first " -D" $DEFS $idx+1] - set item [string range $DEFS $idx $ndx] - set item [string trim $item] - set item [string trimleft $item -D] - if {[string range $item 0 7] eq "PACKAGE_"} { - set idx $ndx - continue - } - set eqidx [string first = $item ] - if {$eqidx < 0} { - append defs { } $item - set idx $ndx - continue - } - - set field [string range $item 0 [expr {$eqidx-1}]] - set value [string range $item [expr {$eqidx+1}] end] - set emap {} - lappend emap \x5c \x5c\x5c \x20 \x5c\x20 \x22 \x5c\x22 \x28 \x5c\x28 \x29 \x5c\x29 - if {[string is integer -strict $value]} { - append defs " -D${field}=$value" - } else { - append defs " -D${field}=[string map $emap $value]" - } - set idx $ndx - } - return $defs -} - -proc ::practcl::build::tclkit_main {PROJECT PKG_OBJS} { - ### - # Build static package list - ### - set statpkglist {} - dict set statpkglist Tk {autoload 0} - puts [list TCLKIT MAIN $PROJECT] - - foreach {ofile info} [${PROJECT} compile-products] { - puts [list * PROD $ofile $info] - if {![dict exists $info object]} continue - set cobj [dict get $info object] - foreach {pkg info} [$cobj static-packages] { - dict set statpkglist $pkg $info - } - } - foreach cobj [list {*}${PKG_OBJS} $PROJECT] { - puts [list * PROG $cobj] - foreach {pkg info} [$cobj static-packages] { - puts [list * PKG $pkg $info] - dict set statpkglist $pkg $info - } - } - - set result {} - $PROJECT include {} - $PROJECT include {"tclInt.h"} - $PROJECT include {"tclFileSystem.h"} - $PROJECT include {} - $PROJECT include {} - $PROJECT include {} - $PROJECT include {} - $PROJECT include {} - - $PROJECT code header { -#ifndef MODULE_SCOPE -# define MODULE_SCOPE extern -#endif - -/* -** Provide a dummy Tcl_InitStubs if we are using this as a static -** library. -*/ -#ifndef USE_TCL_STUBS -# undef Tcl_InitStubs -# define Tcl_InitStubs(a,b,c) TCL_VERSION -#endif -#define STATIC_BUILD 1 -#undef USE_TCL_STUBS - -/* Make sure the stubbed variants of those are never used. */ -#undef Tcl_ObjSetVar2 -#undef Tcl_NewStringObj -#undef Tk_Init -#undef Tk_MainEx -#undef Tk_SafeInit -} - - # Build an area of the file for #define directives and - # function declarations - set define {} - set mainhook [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] - set mainfunc [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit] - set mainscript [$PROJECT define get main.tcl main.tcl] - set vfsroot [$PROJECT define get vfsroot zipfs:/app] - set vfs_main "${vfsroot}/${mainscript}" - set vfs_tcl_library "${vfsroot}/boot/tcl" - set vfs_tk_library "${vfsroot}/boot/tk" - - set map {} - foreach var { - vfsroot mainhook mainfunc vfs_main vfs_tcl_library vfs_tk_library - } { - dict set map %${var}% [set $var] - } - set preinitscript { -set ::odie(boot_vfs) {%vfsroot%} -set ::SRCDIR {%vfsroot%} -if {[file exists {%vfs_tcl_library%}]} { - set ::tcl_library {%vfs_tcl_library%} - set ::auto_path {} -} -if {[file exists {%vfs_tk_library%}]} { - set ::tk_library {%vfs_tk_library%} -} -} ; # Preinitscript - - set zvfsboot { -/* - * %mainhook% -- - * Performs the argument munging for the shell - */ - } - ::practcl::cputs zvfsboot { - CONST char *archive; - Tcl_FindExecutable(*argv[0]); - archive=Tcl_GetNameOfExecutable(); - - Tclzipfs_Init(NULL); - } - # We have to initialize the virtual filesystem before calling - # Tcl_Init(). Otherwise, Tcl_Init() will not be able to find - # its startup script files. - $PROJECT include {"tclZipfs.h"} - - ::practcl::cputs zvfsboot " if(!TclZipfsMount(NULL, archive, \"%vfsroot%\", NULL)) \x7B " - ::practcl::cputs zvfsboot { - Tcl_Obj *vfsinitscript; - vfsinitscript=Tcl_NewStringObj("%vfs_main%",-1); - Tcl_IncrRefCount(vfsinitscript); - if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { - /* Startup script should be set before calling Tcl_AppInit */ - Tcl_SetStartupScript(vfsinitscript,NULL); - } - } - ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c $preinitscript])\;" - ::practcl::cputs zvfsboot " \x7D else \x7B" - ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c { -foreach path { - ../tcl -} { - set p [file join $path library init.tcl] - if {[file exists [file join $path library init.tcl]]} { - set ::tcl_library [file normalize [file join $path library]] - break - } -} -foreach path { - ../tk -} { - if {[file exists [file join $path library tk.tcl]]} { - set ::tk_library [file normalize [file join $path library]] - break - } -} -}])\;" - - ::practcl::cputs zvfsboot " \x7D" - - ::practcl::cputs zvfsboot " return TCL_OK;" - - if {[$PROJECT define get os] eq "windows"} { - set header {int %mainhook%(int *argc, TCHAR ***argv)} - } else { - set header {int %mainhook%(int *argc, char ***argv)} - } - $PROJECT c_function [string map $map $header] [string map $map $zvfsboot] - - practcl::cputs appinit "int %mainfunc%(Tcl_Interp *interp) \x7B" - - # Build AppInit() - set appinit {} - practcl::cputs appinit { - if ((Tcl_Init)(interp) == TCL_ERROR) { - return TCL_ERROR; - } -} - set main_init_script {} - - foreach {statpkg info} $statpkglist { - set initfunc {} - if {[dict exists $info initfunc]} { - set initfunc [dict get $info initfunc] - } - if {$initfunc eq {}} { - set initfunc [string totitle ${statpkg}]_Init - } - # We employ a NULL to prevent the package system from thinking the - # package is actually loaded into the interpreter - $PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n" - set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]] - append main_init_script \n [list set ::kitpkg(${statpkg}) $script] +### +# Practcl +# An object oriented templating system for stamping out Tcl API calls to C +### +puts [list LOADED practcl.tcl from [info script]] +package require TclOO +proc ::debug args { + #puts $args + ::practcl::cputs ::DEBUG_INFO $args +} + +### +# Drop in a static copy of Tcl +### +proc ::doexec args { + puts [list {*}$args] + exec {*}$args >&@ stdout +} + +proc ::dotclexec args { + puts [list [info nameofexecutable] {*}$args] + exec [info nameofexecutable] {*}$args >&@ stdout +} + +proc ::domake {path args} { + set PWD [pwd] + cd $path + puts [list *** $path ***] + puts [list make {*}$args] + exec make {*}$args >&@ stdout + cd $PWD +} + +proc ::domake.tcl {path args} { + set PWD [pwd] + cd $path + puts [list *** $path ***] + puts [list make.tcl {*}$args] + exec [info nameofexecutable] make.tcl {*}$args >&@ stdout + cd $PWD +} + +proc ::fossil {path args} { + set PWD [pwd] + cd $path + puts [list {*}$args] + exec fossil {*}$args >&@ stdout + cd $PWD +} + + +proc ::fossil_status {dir} { + if {[info exists ::fosdat($dir)]} { + return $::fosdat($dir) + } + set result { +tags experimental +version {} + } + set pwd [pwd] + cd $dir + set info [exec fossil status] + cd $pwd + foreach line [split $info \n] { + if {[lindex $line 0] eq "checkout:"} { + set hash [lindex $line end-3] + set maxdate [lrange $line end-2 end-1] + dict set result hash $hash + dict set result maxdate $maxdate + regsub -all {[^0-9]} $maxdate {} isodate + dict set result isodate $isodate + } + if {[lindex $line 0] eq "tags:"} { + set tags [lrange $line 1 end] + dict set result tags $tags + break + } + } + set ::fosdat($dir) $result + return $result +} +### +# Seek out Tcllib if it's available +### +set tcllib_path {} +foreach path {.. ../.. ../../..} { + foreach path [glob -nocomplain [file join [file normalize $path] tcllib* modules]] { + set tclib_path $path + lappend ::auto_path $path + break + } + if {$tcllib_path ne {}} break +} + + +### +# Build utility functions +### +namespace eval ::practcl {} + +proc ::practcl::os {} { + if {[info exists ::project(TEACUP_OS)] && $::project(TEACUP_OS) ni {"@TEACUP_OS@" {}}} { + return $::project(TEACUP_OS) + } + set info [::practcl::config.tcl $::project(builddir)] + if {[dict exists $info TEACUP_OS]} { + return [dict get $info TEACUP_OS] + } + return unknown +} + +### +# Detect local platform +### +proc ::practcl::config.tcl {path} { + dict set result buildpath $path + set result {} + if {[file exists [file join $path config.tcl]]} { + set fin [open [file join $path config.tcl] r] + set bufline {} + set rawcount 0 + set linecount 0 + while {[gets $fin thisline]>=0} { + incr rawcount + append bufline \n $thisline + if {![info complete $bufline]} continue + set line [string trimleft $bufline] + set bufline {} + if {[string index [string trimleft $line] 0] eq "#"} continue + incr linecount + set key [lindex $line 0] + set value [lindex $line 1] + dict set result $key $value + } + dict set result sandbox [file dirname [dict get $result srcdir]] + dict set result download [file join [dict get $result sandbox] download] + dict set result teapot [file join [dict get $result sandbox] teapot] + set result [::practcl::de_shell $result] + } + # If data is available from autoconf, defer to that + if {[dict exists $result TEACUP_OS] && [dict get $result TEACUP_OS] ni {"@TEACUP_OS@" {}}} { + return $result + } + # If autoconf hasn't run yet, assume we are not cross compiling + # and defer to local checks + dict set result TEACUP_PROFILE unknown + dict set result TEACUP_OS unknown + dict set result EXEEXT {} + if {$::tcl_platform(platform) eq "windows"} { + set system "windows" + set arch ix86 + dict set result TEACUP_PROFILE win32-ix86 + dict set result TEACUP_OS windows + dict set result EXEEXT .exe + } else { + set system [exec uname -s]-[exec uname -r] + set arch unknown + dict set result TEACUP_OS generic + } + dict set result TEA_PLATFORM $system + dict set result TEA_SYSTEM $system + switch -glob $system { + Linux* { + dict set result TEACUP_OS linux + set arch [exec uname -m] + dict set result TEACUP_PROFILE "linux-glibc2.3-$arch" + } + GNU* { + set arch [exec uname -m] + dict set result TEACUP_OS "gnu" + } + NetBSD-Debian { + set arch [exec uname -m] + dict set result TEACUP_OS "netbsd-debian" + } + OpenBSD-* { + set arch [exec arch -s] + dict set result TEACUP_OS "openbsd" + } + Darwin* { + set arch [exec uname -m] + dict set result TEACUP_OS "macosx" + if {$arch eq "x86_64"} { + dict set result TEACUP_PROFILE "macosx10.5-i386-x86_84" + } else { + dict set result TEACUP_PROFILE "macosx-universal" + } + } + OpenBSD* { + set arch [exec arch -s] + dict set result TEACUP_OS "openbsd" + } + } + if {$arch eq "unknown"} { + catch {set arch [exec uname -m]} + } + switch -glob $arch { + i*86 { + set arch "ix86" + } + amd64 { + set arch "x86_64" + } + } + dict set result TEACUP_ARCH $arch + if {[dict get $result TEACUP_PROFILE] eq "unknown"} { + dict set result TEACUP_PROFILE [dict get $result TEACUP_OS]-$arch + } + return $result +} + + +### +# Convert an MSYS path to a windows native path +### +if {$::tcl_platform(platform) eq "windows"} { +proc ::practcl::msys_to_tclpath msyspath { + return [exec sh -c "cd $msyspath ; pwd -W"] +} +} else { +proc ::practcl::msys_to_tclpath msyspath { + return [file normalize $msyspath] +} +} + +### +# Bits stolen from fileutil +### +proc ::practcl::cat fname { + set fname [open $fname r] + set data [read $fname] + close $fname + return $data +} + +proc ::practcl::file_lexnormalize {sp} { + set spx [file split $sp] + + # Resolution of embedded relative modifiers (., and ..). + + if { + ([lsearch -exact $spx . ] < 0) && + ([lsearch -exact $spx ..] < 0) + } { + # Quick path out if there are no relative modifiers + return $sp + } + + set absolute [expr {![string equal [file pathtype $sp] relative]}] + # A volumerelative path counts as absolute for our purposes. + + set sp $spx + set np {} + set noskip 1 + + while {[llength $sp]} { + set ele [lindex $sp 0] + set sp [lrange $sp 1 end] + set islast [expr {[llength $sp] == 0}] + + if {[string equal $ele ".."]} { + if { + ($absolute && ([llength $np] > 1)) || + (!$absolute && ([llength $np] >= 1)) + } { + # .. : Remove the previous element added to the + # new path, if there actually is enough to remove. + set np [lrange $np 0 end-1] + } + } elseif {[string equal $ele "."]} { + # Ignore .'s, they stay at the current location + continue + } else { + # A regular element. + lappend np $ele + } + } + if {[llength $np] > 0} { + return [eval [linsert $np 0 file join]] + # 8.5: return [file join {*}$np] + } + return {} +} + +proc ::practcl::file_relative {base dst} { + # Ensure that the link to directory 'dst' is properly done relative to + # the directory 'base'. + + if {![string equal [file pathtype $base] [file pathtype $dst]]} { + return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)" + } + + set base [file_lexnormalize [file join [pwd] $base]] + set dst [file_lexnormalize [file join [pwd] $dst]] + + set save $dst + set base [file split $base] + set dst [file split $dst] + + while {[string equal [lindex $dst 0] [lindex $base 0]]} { + set dst [lrange $dst 1 end] + set base [lrange $base 1 end] + if {![llength $dst]} {break} + } + + set dstlen [llength $dst] + set baselen [llength $base] + + if {($dstlen == 0) && ($baselen == 0)} { + # Cases: + # (a) base == dst + + set dst . + } else { + # Cases: + # (b) base is: base/sub = sub + # dst is: base = {} + + # (c) base is: base = {} + # dst is: base/sub = sub + + while {$baselen > 0} { + set dst [linsert $dst 0 ..] + incr baselen -1 + } + # 8.5: set dst [file join {*}$dst] + set dst [eval [linsert $dst 0 file join]] + } + + return $dst +} + +### +# Unpack the source of a fossil project into a designated location +### +proc ::practcl::fossil_sandbox {pkg args} { + if {[llength $args]==1} { + set info [lindex $args 0] + } else { + set info $args + } + set result $info + if {[dict exists $info srcroot]} { + set srcroot [dict get $info srcroot] + } elseif {[dict exists $info sandbox]} { + set srcroot [file join [dict get $info sandbox] $pkg] + } else { + set srcroot [file join $::CWD .. $pkg] + } + dict set result srcroot $srcroot + puts [list fossil_sandbox $pkg $srcroot] + if {[dict exists $info download]} { + ### + # Source is actually a zip archive + ### + set download [dict get $info download] + if {[file exists [file join $download $pkg.zip]]} { + if {![info exists $srcroot]} { + package require zipfile::decode + ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcroot + } + return + } + } + variable fossil_dbs + if {![::info exists fossil_dbs]} { + # Get a list of local fossil databases + set fossil_dbs [exec fossil all list] + } + set CWD [pwd] + if {![dict exists $info tag]} { + set tag trunk + } else { + set tag [dict get $info tag] + } + dict set result tag $tag + + try { + if {[file exists [file join $srcroot .fslckout]]} { + if {[dict exists $info update] && [dict get $info update]==1} { + catch { + puts "FOSSIL UPDATE" + cd $srcroot + doexec fossil update $tag + } + } + } elseif {[file exists [file join $srcroot _FOSSIL_]]} { + if {[dict exists $info update] && [dict get $info update]==1} { + catch { + puts "FOSSIL UPDATE" + cd $srcroot + doexec fossil update $tag + } + } + } else { + puts "OPEN AND UNPACK" + set fosdb {} + foreach line [split $fossil_dbs \n] { + set line [string trim $line] + if {[file rootname [file tail $line]] eq $pkg} { + set fosdb $line + break + } + } + if {$fosdb eq {}} { + file mkdir [file join $download fossil] + set fosdb [file join $download fossil $pkg.fos] + set cloned 0 + if {[dict exists $info localmirror]} { + set localmirror [dict get $info localmirror] + catch { + doexec fossil clone $localmirror/$pkg $fosdb + set cloned 1 + } + } + if {!$cloned && [dict exists $info fossil_url]} { + set localmirror [dict get $info fossil_url] + catch { + doexec fossil clone $localmirror/$pkg $fosdb + set cloned 1 + } + } + if {!$cloned} { + doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb + } + } + file mkdir $srcroot + cd $srcroot + puts "FOSSIL OPEN [pwd]" + doexec fossil open $fosdb $tag + } + } on error {result opts} { + puts [list ERR [dict get $opts -errorinfo]] + return {*}$opts + } finally { + cd $CWD + } + return $result +} + +### +# topic: e71f3f61c348d56292011eec83e95f0aacc1c618 +# description: Converts a XXX.sh file into a series of Tcl variables +### +proc ::practcl::read_sh_subst {line info} { + regsub -all {\x28} $line \x7B line + regsub -all {\x29} $line \x7D line + + #set line [string map $key [string trim $line]] + foreach {field value} $info { + catch {set $field $value} + } + if [catch {subst $line} result] { + return {} + } + set result [string trim $result] + return [string trim $result '] +} + +### +# topic: 03567140cca33c814664c7439570f669b9ab88e6 +### +proc ::practcl::read_sh_file {filename {localdat {}}} { + set fin [open $filename r] + set result {} + if {$localdat eq {}} { + set top 1 + set local [array get ::env] + dict set local EXE {} + } else { + set top 0 + set local $localdat + } + while {[gets $fin line] >= 0} { + set line [string trim $line] + if {[string index $line 0] eq "#"} continue + if {$line eq {}} continue + catch { + if {[string range $line 0 6] eq "export "} { + set eq [string first "=" $line] + set field [string trim [string range $line 6 [expr {$eq - 1}]]] + set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] + dict set result $field [read_sh_subst $value $local] + dict set local $field $value + } elseif {[string range $line 0 7] eq "include "} { + set subfile [read_sh_subst [string range $line 7 end] $local] + foreach {field value} [read_sh_file $subfile $local] { + dict set result $field $value + } + } else { + set eq [string first "=" $line] + if {$eq > 0} { + set field [read_sh_subst [string range $line 0 [expr {$eq - 1}]] $local] + set value [string trim [string range $line [expr {$eq+1}] end] '] + #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] + dict set local $field $value + dict set result $field $value + } + } + } err opts + if {[dict get $opts -code] != 0} { + #puts $opts + puts "Error reading line:\n$line\nerr: $err\n***" + return $err {*}$opts + } + } + return $result +} + +### +# A simpler form of read_sh_file tailored +# to pulling data from (tcl|tk)Config.sh +### +proc ::practcl::read_Config.sh filename { + set fin [open $filename r] + set result {} + set linecount 0 + while {[gets $fin line] >= 0} { + set line [string trim $line] + if {[string index $line 0] eq "#"} continue + if {$line eq {}} continue + catch { + set eq [string first "=" $line] + if {$eq > 0} { + set field [string range $line 0 [expr {$eq - 1}]] + set value [string trim [string range $line [expr {$eq+1}] end] '] + #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] + dict set result $field $value + incr $linecount + } + } err opts + if {[dict get $opts -code] != 0} { + #puts $opts + puts "Error reading line:\n$line\nerr: $err\n***" + return $err {*}$opts + } + } + return $result +} + +### +# A simpler form of read_sh_file tailored +# to pulling data from a Makefile +### +proc ::practcl::read_Makefile filename { + set fin [open $filename r] + set result {} + while {[gets $fin line] >= 0} { + set line [string trim $line] + if {[string index $line 0] eq "#"} continue + if {$line eq {}} continue + catch { + set eq [string first "=" $line] + if {$eq > 0} { + set field [string trim [string range $line 0 [expr {$eq - 1}]]] + set value [string trim [string trim [string range $line [expr {$eq+1}] end] ']] + switch $field { + PKG_LIB_FILE { + dict set result libfile $value + } + srcdir { + if {$value eq "."} { + dict set result srcdir [file dirname $filename] + } else { + dict set result srcdir $value + } + } + PACKAGE_NAME { + dict set result name $value + } + PACKAGE_VERSION { + dict set result version $value + } + LIBS { + dict set result PRACTCL_LIBS $value + } + PKG_LIB_FILE { + dict set result libfile $value + } + } + } + } err opts + if {[dict get $opts -code] != 0} { + #puts $opts + puts "Error reading line:\n$line\nerr: $err\n***" + return $err {*}$opts + } + # the Compile field is about where most TEA files start getting silly + if {$field eq "compile"} { + break + } + } + return $result +} + +## Append arguments to a buffer +# The command works like puts in that each call will also insert +# a line feed. Unlike puts, blank links in the interstitial are +# suppressed +proc ::practcl::cputs {varname args} { + upvar 1 $varname buffer + if {[llength $args]==1 && [string length [string trim [lindex $args 0]]] == 0} { + + } + if {[info exist buffer]} { + if {[string index $buffer end] ne "\n"} { + append buffer \n + } + } else { + set buffer \n + } + # Trim leading \n's + append buffer [string trimleft [lindex $args 0] \n] {*}[lrange $args 1 end] +} + + +proc ::practcl::tcl_to_c {body} { + set result {} + foreach rawline [split $body \n] { + set line [string map [list \" \\\" \\ \\\\] $rawline] + cputs result "\n \"$line\\n\" \\" + } + return [string trimright $result \\] +} + + +proc ::practcl::_tagblock {text {style tcl} {note {}}} { + if {[string length [string trim $text]]==0} { + return {} + } + set output {} + switch $style { + tcl { + ::practcl::cputs output "# BEGIN $note" + } + c { + ::practcl::cputs output "/* BEGIN $note */" + } + default { + ::practcl::cputs output "# BEGIN $note" + } + } + ::practcl::cputs output $text + switch $style { + tcl { + ::practcl::cputs output "# END $note" + } + c { + ::practcl::cputs output "/* END $note */" + } + default { + ::practcl::cputs output "# END $note" + } + } + return $output +} + +proc ::practcl::_isdirectory name { + return [file isdirectory $name] +} + +### +# Return true if the pkgindex file contains +# any statement other than "package ifneeded" +# and/or if any package ifneeded loads a DLL +### +proc ::practcl::_pkgindex_directory {path} { + set buffer {} + set pkgidxfile [file join $path pkgIndex.tcl] + if {![file exists $pkgidxfile]} { + # No pkgIndex file, read the source + foreach file [glob -nocomplain $path/*.tm] { + set file [file normalize $file] + set fname [file rootname [file tail $file]] + ### + # We used to be able to ... Assume the package is correct in the filename + # No hunt for a "package provides" + ### + set package [lindex [split $fname -] 0] + set version [lindex [split $fname -] 1] + ### + # Read the file, and override assumptions as needed + ### + set fin [open $file r] + set dat [read $fin] + close $fin + # Look for a teapot style Package statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 9] != "# Package " } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + } + foreach file [glob -nocomplain $path/*.tcl] { + if { [file tail $file] == "version_info.tcl" } continue + set fin [open $file r] + set dat [read $fin] + close $fin + if {![regexp "package provide" $dat]} continue + set fname [file rootname [file tail $file]] + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + if {[string index $package 0] in "\$ \["} continue + if {[string index $version 0] in "\$ \["} continue + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + break + } + } + return $buffer + } + set fin [open $pkgidxfile r] + set dat [read $fin] + close $fin + set thisline {} + foreach line [split $dat \n] { + append thisline $line \n + if {![info complete $thisline]} continue + set line [string trim $line] + if {[string length $line]==0} { + set thisline {} ; continue + } + if {[string index $line 0] eq "#"} { + set thisline {} ; continue + } + try { + # Ignore contditionals + if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} continue + if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} continue + if {![regexp "package.*ifneeded" $thisline]} { + # This package index contains arbitrary code + # source instead of trying to add it to the master + # package index + return {source [file join $dir pkgIndex.tcl]} + } + append buffer $thisline \n + } on error {err opts} { + puts *** + puts "GOOF: $pkgidxfile" + puts $line + puts $err + puts [dict get $opts -errorinfo] + puts *** + } finally { + set thisline {} + } + } + return $buffer +} + + +proc ::practcl::_pkgindex_path_subdir {path} { + set result {} + foreach subpath [glob -nocomplain [file join $path *]] { + if {[file isdirectory $subpath]} { + lappend result $subpath {*}[_pkgindex_path_subdir $subpath] + } + } + return $result +} +### +# Index all paths given as though they will end up in the same +# virtual file system +### +proc ::practcl::pkgindex_path args { + set stack {} + set buffer { +lappend ::PATHSTACK $dir + } + foreach base $args { + set base [file normalize $base] + set paths [::practcl::_pkgindex_path_subdir $base] + set i [string length $base] + # Build a list of all of the paths + foreach path $paths { + if {$path eq $base} continue + set path_indexed($path) 0 + } + set path_indexed($base) 1 + set path_indexed([file join $base boot tcl]) 1 + #set path_index([file join $base boot tk]) 1 + + foreach path $paths { + if {$path_indexed($path)} continue + set thisdir [file_relative $base $path] + #set thisdir [string range $path $i+1 end] + set idxbuf [::practcl::_pkgindex_directory $path] + if {[string length $idxbuf]} { + incr path_indexed($path) + append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n + append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n + } + } + } + append buffer { +set dir [lindex $::PATHSTACK end] +set ::PATHSTACK [lrange $::PATHSTACK 0 end-1] +} + return $buffer +} + +### +# topic: 64319f4600fb63c82b2258d908f9d066 +# description: Script to build the VFS file system +### +proc ::practcl::installDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]] + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + installDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +proc ::practcl::copyDir {d1 d2} { + #puts [list $d1 -> $d2] + #file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + } + } +} + +::oo::class create ::practcl::metaclass { + superclass ::oo::object + + method script script { + eval $script + } + + method source filename { + source $filename + } + + method initialize {} {} + + method define {submethod args} { + my variable define + switch $submethod { + dump { + return [array get define] + } + add { + set field [lindex $args 0] + if {![info exists define($field)]} { + set define($field) {} + } + foreach arg [lrange $args 1 end] { + if {$arg ni $define($field)} { + lappend define($field) $arg + } + } + return $define($field) + } + remove { + set field [lindex $args 0] + if {![info exists define($field)]} { + return + } + set rlist [lrange $args 1 end] + set olist $define($field) + set nlist {} + foreach arg $olist { + if {$arg in $rlist} continue + lappend nlist $arg + } + set define($field) $nlist + return $nlist + } + exists { + set field [lindex $args 0] + return [info exists define($field)] + } + getnull - + get - + cget { + set field [lindex $args 0] + if {[info exists define($field)]} { + return $define($field) + } + return [lindex $args 1] + } + set { + if {[llength $args]==1} { + set arglist [lindex $args 0] + } else { + set arglist $args + } + array set define $arglist + if {[dict exists $arglist class]} { + my select + } + } + default { + array $submethod define {*}$args + } + } + } + + method graft args { + my variable organs + if {[llength $args] == 1} { + error "Need two arguments" + } + set object {} + foreach {stub object} $args { + dict set organs $stub $object + oo::objdefine [self] forward <${stub}> $object + oo::objdefine [self] export <${stub}> + } + return $object + } + + method organ {{stub all}} { + my variable organs + if {![info exists organs]} { + return {} + } + if { $stub eq "all" } { + return $organs + } + if {[dict exists $organs $stub]} { + return [dict get $organs $stub] + } + } + + method link {command args} { + my variable links + switch $command { + object { + foreach obj $args { + foreach linktype [$obj linktype] { + my link add $linktype $obj + } + } + } + add { + ### + # Add a link to an object that was externally created + ### + if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"} + lassign $args linktype object + if {[info exists links($linktype)] && $object in $links($linktype)} { + return + } + lappend links($linktype) $object + } + remove { + set object [lindex $args 0] + if {[llength $args]==1} { + set ltype * + } else { + set ltype [lindex $args 1] + } + foreach {linktype elements} [array get links $ltype] { + if {$object in $elements} { + set nlist {} + foreach e $elements { + if { $object ne $e } { lappend nlist $e } + } + set links($linktype) $nlist + } + } + } + list { + if {[llength $args]==0} { + return [array get links] + } + if {[llength $args] != 1} { error "Usage: link list LINKTYPE"} + set linktype [lindex $args 0] + if {![info exists links($linktype)]} { + return {} + } + return $links($linktype) + } + dump { + return [array get links] + } + } + } + + method select {} { + my variable define + set class {} + if {[info exists define(class)]} { + if {[info command $define(class)] ne {}} { + set class $define(class) + } elseif {[info command ::practcl::$define(class)] ne {}} { + set class ::practcl::$define(class) + } else { + switch $define(class) { + default { + set class ::practcl::object + } + } + } + } + if {$class ne {}} { + ::oo::objdefine [self] class $class + } + if {[::info exists define(oodefine)]} { + ::oo::objdefine [self] $define(oodefine) + unset define(oodefine) + } + } +} + +proc ::practcl::trigger {args} { + foreach name $args { + if {[dict exists $::make_objects $name]} { + [dict get $::make_objects $name] triggers + } + } +} + +proc ::practcl::depends {args} { + foreach name $args { + if {[dict exists $::make_objects $name]} { + [dict get $::make_objects $name] check + } + } +} + +proc ::practcl::target {name info} { + set obj [::practcl::target_obj new $name $info] + dict set ::make_objects $name $obj + if {[dict exists $info aliases]} { + foreach item [dict get $info aliases] { + if {![dict exists $::make_objects $item]} { + dict set ::make_objects $item $obj + } + } + } + set ::make($name) 0 + set ::trigger($name) 0 + set filename [$obj define get filename] + if {$filename ne {}} { + set ::target($name) $filename + } +} + +### Batch Tasks + +namespace eval ::practcl::build {} + +## method DEFS +# This method populates 4 variables: +# name - The name of the package +# version - The version of the package +# defs - C flags passed to the compiler +# includedir - A list of paths to feed to the compiler for finding headers +# +proc ::practcl::build::DEFS {PROJECT DEFS namevar versionvar defsvar} { + upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs + set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]] + set NAME [string toupper $name] + set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] + if {$version eq {}} { + set version 0.1a + } + set defs {} + append defs " -DPACKAGE_NAME=\"${name}\" -DPACKAGE_VERSION=\"${version}\"" + append defs " -DPACKAGE_TARNAME=\"${name}\" -DPACKAGE_STRING=\"${name}\x5c\x20${version}\"" + set NAME [string toupper $name] + set idx 0 + set count 0 + while {$idx>=0} { + set ndx [string first " -D" $DEFS $idx+1] + set item [string range $DEFS $idx $ndx] + set item [string trim $item] + set item [string trimleft $item -D] + if {[string range $item 0 7] eq "PACKAGE_"} { + set idx $ndx + continue + } + set eqidx [string first = $item ] + if {$eqidx < 0} { + append defs { } $item + set idx $ndx + continue + } + + set field [string range $item 0 [expr {$eqidx-1}]] + set value [string range $item [expr {$eqidx+1}] end] + set emap {} + lappend emap \x5c \x5c\x5c \x20 \x5c\x20 \x22 \x5c\x22 \x28 \x5c\x28 \x29 \x5c\x29 + if {[string is integer -strict $value]} { + append defs " -D${field}=$value" + } else { + append defs " -D${field}=[string map $emap $value]" + } + set idx $ndx + } + return $defs +} + +proc ::practcl::build::tclkit_main {PROJECT PKG_OBJS} { + ### + # Build static package list + ### + set statpkglist {} + dict set statpkglist Tk {autoload 0} + puts [list TCLKIT MAIN $PROJECT] + + foreach {ofile info} [${PROJECT} compile-products] { + puts [list * PROD $ofile $info] + if {![dict exists $info object]} continue + set cobj [dict get $info object] + foreach {pkg info} [$cobj static-packages] { + dict set statpkglist $pkg $info + } + } + foreach cobj [list {*}${PKG_OBJS} $PROJECT] { + puts [list * PROG $cobj] + foreach {pkg info} [$cobj static-packages] { + puts [list * PKG $pkg $info] + dict set statpkglist $pkg $info + } + } + + set result {} + $PROJECT include {} + $PROJECT include {"tclInt.h"} + $PROJECT include {"tclFileSystem.h"} + $PROJECT include {} + $PROJECT include {} + $PROJECT include {} + $PROJECT include {} + $PROJECT include {} + + $PROJECT code header { +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif + +/* +** Provide a dummy Tcl_InitStubs if we are using this as a static +** library. +*/ +#ifndef USE_TCL_STUBS +# undef Tcl_InitStubs +# define Tcl_InitStubs(a,b,c) TCL_VERSION +#endif +#define STATIC_BUILD 1 +#undef USE_TCL_STUBS + +/* Make sure the stubbed variants of those are never used. */ +#undef Tcl_ObjSetVar2 +#undef Tcl_NewStringObj +#undef Tk_Init +#undef Tk_MainEx +#undef Tk_SafeInit +} + + # Build an area of the file for #define directives and + # function declarations + set define {} + set mainhook [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] + set mainfunc [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit] + set mainscript [$PROJECT define get main.tcl main.tcl] + set vfsroot [$PROJECT define get vfsroot zipfs:/app] + set vfs_main "${vfsroot}/${mainscript}" + set vfs_tcl_library "${vfsroot}/boot/tcl" + set vfs_tk_library "${vfsroot}/boot/tk" + + set map {} + foreach var { + vfsroot mainhook mainfunc vfs_main vfs_tcl_library vfs_tk_library + } { + dict set map %${var}% [set $var] + } + set preinitscript { +set ::odie(boot_vfs) {%vfsroot%} +set ::SRCDIR {%vfsroot%} +if {[file exists {%vfs_tcl_library%}]} { + set ::tcl_library {%vfs_tcl_library%} + set ::auto_path {} +} +if {[file exists {%vfs_tk_library%}]} { + set ::tk_library {%vfs_tk_library%} +} +} ; # Preinitscript + + set zvfsboot { +/* + * %mainhook% -- + * Performs the argument munging for the shell + */ + } + ::practcl::cputs zvfsboot { + CONST char *archive; + Tcl_FindExecutable(*argv[0]); + archive=Tcl_GetNameOfExecutable(); + + Tclzipfs_Init(NULL); + } + # We have to initialize the virtual filesystem before calling + # Tcl_Init(). Otherwise, Tcl_Init() will not be able to find + # its startup script files. + $PROJECT include {"tclZipfs.h"} + + ::practcl::cputs zvfsboot " if(!TclZipfsMount(NULL, archive, \"%vfsroot%\", NULL)) \x7B " + ::practcl::cputs zvfsboot { + Tcl_Obj *vfsinitscript; + vfsinitscript=Tcl_NewStringObj("%vfs_main%",-1); + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } + } + ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c $preinitscript])\;" + ::practcl::cputs zvfsboot " \x7D else \x7B" + ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c { +foreach path { + ../tcl +} { + set p [file join $path library init.tcl] + if {[file exists [file join $path library init.tcl]]} { + set ::tcl_library [file normalize [file join $path library]] + break + } +} +foreach path { + ../tk +} { + if {[file exists [file join $path library tk.tcl]]} { + set ::tk_library [file normalize [file join $path library]] + break + } +} +}])\;" + + ::practcl::cputs zvfsboot " \x7D" + + ::practcl::cputs zvfsboot " return TCL_OK;" + + if {[$PROJECT define get os] eq "windows"} { + set header {int %mainhook%(int *argc, TCHAR ***argv)} + } else { + set header {int %mainhook%(int *argc, char ***argv)} + } + $PROJECT c_function [string map $map $header] [string map $map $zvfsboot] + + practcl::cputs appinit "int %mainfunc%(Tcl_Interp *interp) \x7B" + + # Build AppInit() + set appinit {} + practcl::cputs appinit { + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; + } +} + set main_init_script {} + + foreach {statpkg info} $statpkglist { + set initfunc {} + if {[dict exists $info initfunc]} { + set initfunc [dict get $info initfunc] + } + if {$initfunc eq {}} { + set initfunc [string totitle ${statpkg}]_Init + } + # We employ a NULL to prevent the package system from thinking the + # package is actually loaded into the interpreter + $PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n" + set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]] + append main_init_script \n [list set ::kitpkg(${statpkg}) $script] if {[dict get $info autoload]} { - ::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;" - ::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;" - } else { - ::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;" - append main_init_script \n $script - } - } - append main_init_script \n { -if {[file exists [file join $::SRCDIR packages.tcl]]} { - #In a wrapped exe, we don't go out to the environment - set dir $::SRCDIR - source [file join $::SRCDIR packages.tcl] -} -# Specify a user-specific startup file to invoke if the application -# is run interactively. Typically the startup file is "~/.apprc" -# where "app" is the name of the application. If this line is deleted -# then no user-specific startup file will be run under any conditions. - } - append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] - practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $main_init_script]);" - practcl::cputs appinit { return TCL_OK;} - $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] -} - -proc ::practcl::build::compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} { - set EXTERN_OBJS {} - set OBJECTS {} - set result {} - set builddir [$PROJECT define get builddir] - file mkdir [file join $builddir objs] - set debug [$PROJECT define get debug 0] - if {$CPPCOMPILE eq {}} { - set CPPCOMPILE $COMPILE - } - set task [${PROJECT} compile-products] - ### - # Compile the C sources - ### - foreach {ofile info} $task { - dict set task $ofile done 0 - if {[dict exists $info external] && [dict get $info external]==1} { - dict set task $ofile external 1 - } else { - dict set task $ofile external 0 - } - if {[dict exists $info library]} { - dict set task $ofile done 1 - continue - } - # Products with no cfile aren't compiled - if {![dict exists $info cfile] || [set cfile [dict get $info cfile]] eq {}} { - dict set task $ofile done 1 - continue - } - set cfile [dict get $info cfile] - set ofilename [file join $builddir objs [file tail $ofile]] - if {$debug} { - set ofilename [file join $builddir objs [file rootname [file tail $ofile]].debug.o] - } - dict set task $ofile filename $ofilename - if {[file exists $ofilename] && [file mtime $ofilename]>[file mtime $cfile]} { - lappend result $ofilename - dict set task $ofile done 1 - continue - } - if {![dict exist $info command]} { - if {[file extension $cfile] in {.c++ .cpp}} { - set cmd $CPPCOMPILE - } else { - set cmd $COMPILE - } - if {[dict exists $info extra]} { - append cmd " [dict get $info extra]" - } - append cmd " -c $cfile" - append cmd " -o $ofilename" - dict set task $ofile command $cmd - } - } - set completed 0 - while {$completed==0} { - set completed 1 - foreach {ofile info} $task { - set waiting {} - if {[dict exists $info done] && [dict get $info done]} continue - if {[dict exists $info depend]} { - foreach file [dict get $info depend] { - if {[dict exists $task $file command] && [dict exists $task $file done] && [dict get $task $file done] != 1} { - set waiting $file - break - } - } - } - if {$waiting ne {}} { - set completed 0 - puts "$ofile waiting for $waiting" - continue - } - if {[dict exists $info command]} { - set cmd [dict get $info command] - puts "$cmd" - exec {*}$cmd >&@ stdout - } - lappend result [dict get $info filename] - dict set task $ofile done 1 - } - } - return $result -} - -proc ::practcl::de_shell {data} { - set values {} - foreach flag {DEFS TCL_DEFS TK_DEFS} { - if {[dict exists $data $flag]} { - set value {} - foreach item [dict get $data $flag] { - append value " " [string map {{ } {\ }} $item] - } - dict set values $flag $value - } - } - set map {} - lappend map {${PKG_OBJECTS}} %LIBRARY_OBJECTS% - lappend map {$(PKG_OBJECTS)} %LIBRARY_OBJECTS% - lappend map {${PKG_STUB_OBJECTS}} %LIBRARY_STUB_OBJECTS% - lappend map {$(PKG_STUB_OBJECTS)} %LIBRARY_STUB_OBJECTS% - - lappend map %LIBRARY_NAME% [dict get $data name] - lappend map %LIBRARY_VERSION% [dict get $data version] - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} [dict get $data version]] - if {[dict exists $data libprefix]} { - lappend map %LIBRARY_PREFIX% [dict get $data libprefix] - } else { - lappend map %LIBRARY_PREFIX% [dict get $data prefix] - } - foreach flag [dict keys $data] { - if {$flag in {TCL_DEFS TK_DEFS DEFS}} continue - - dict set map "%${flag}%" [dict get $data $flag] - dict set map "\$\{${flag}\}" [dict get $data $flag] - dict set map "\$\(${flag}\)" [dict get $data $flag] - dict set values $flag [dict get $data $flag] - #dict set map "\$\{${flag}\}" $proj($flag) - } - set changed 1 - while {$changed} { - set changed 0 - foreach {field value} $values { - if {$field in {TCL_DEFS TK_DEFS DEFS}} continue - dict with values {} - set newval [string map $map $value] - if {$newval eq $value} continue - set changed 1 - dict set values $field $newval - } - } - return $values -} - -proc ::practcl::build::Makefile {path PROJECT} { - array set proj [$PROJECT define dump] - set path $proj(builddir) - cd $path - set includedir . - #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] - foreach include [$PROJECT generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - set INCLUDES "-I[join $includedir " -I"]" - set NAME [string toupper $proj(name)] - set result {} - set products {} - set libraries {} - set thisline {} - ::practcl::cputs result "${NAME}_DEFS = $proj(DEFS)\n" - ::practcl::cputs result "${NAME}_INCLUDES = -I\"[join $includedir "\" -I\""]\"\n" - ::practcl::cputs result "${NAME}_COMPILE = \$(CC) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" - ::practcl::cputs result "${NAME}_CPPCOMPILE = \$(CXX) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" - - foreach {ofile info} [$PROJECT compile-products] { - dict set products $ofile $info - if {[dict exists $info library]} { -lappend libraries $ofile -continue - } - if {[dict exists $info depend]} { - ::practcl::cputs result "\n${ofile}: [dict get $info depend]" - } else { - ::practcl::cputs result "\n${ofile}:" - } - set cfile [dict get $info cfile] - if {[file extension $cfile] in {.c++ .cpp}} { - set cmd "\t\$\(${NAME}_CPPCOMPILE\)" - } else { - set cmd "\t\$\(${NAME}_COMPILE\)" - } - if {[dict exists $info extra]} { - append cmd " [dict get $info extra]" - } - append cmd " -c [dict get $info cfile] -o \$@\n\t" - ::practcl::cputs result $cmd - } - - set map {} - lappend map %LIBRARY_NAME% $proj(name) - lappend map %LIBRARY_VERSION% $proj(version) - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] - lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix] - - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - set outfile [$PROJECT define get libfile] - } else { - set outfile [$PROJECT shared_library] - } - $PROJECT define set shared_library $outfile - ::practcl::cputs result " -${NAME}_SHLIB = $outfile -${NAME}_OBJS = [dict keys $products] -" - - #lappend map %OUTFILE% {\[$]@} - lappend map %OUTFILE% $outfile - lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)" - ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]" - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]" - } - ::practcl::cputs result {} - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - #set outfile [$PROJECT static_library] - set outfile $proj(name).a - } else { - set outfile [$PROJECT define get libfile] - } - $PROJECT define set static_library $outfile - dict set map %OUTFILE% $outfile - ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" - ::practcl::cputs result {} - return $result -} - -### -# Produce a dynamic library -### -proc ::practcl::build::library {outfile PROJECT} { - array set proj [$PROJECT define dump] - set path $proj(builddir) - cd $path - set includedir . - #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] - if {[$PROJECT define get tk 0]} { - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]] - lappend includedir [::practcl::file_relative $path [file normalize $proj(TK_BIN_DIR)]] - } - foreach include [$PROJECT generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - ::practcl::build::DEFS $PROJECT $proj(DEFS) name version defs - set NAME [string toupper $name] - set debug [$PROJECT define get debug 0] - set os [$PROJECT define get os] - - set INCLUDES "-I[join $includedir " -I"]" - if {$debug} { - set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ -$proj(CFLAGS_WARNING) $INCLUDES $defs" - - if {[info exists proc(CXX)]} { - set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS_DEBUG) -ggdb \ - $proj(DEFS) $proj(CFLAGS_WARNING)" - } else { - set COMPILECPP $COMPILE - } - } else { - set COMPILE "$proj(CC) $proj(CFLAGS) $defs $INCLUDES " - - if {[info exists proc(CXX)]} { - set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS) $proj(DEFS)" - } else { - set COMPILECPP $COMPILE - } - } - - set products [compile-sources $PROJECT $COMPILE $COMPILECPP] - - set map {} - lappend map %LIBRARY_NAME% $proj(name) - lappend map %LIBRARY_VERSION% $proj(version) - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] - lappend map %OUTFILE% $outfile - lappend map %LIBRARY_OBJECTS% $products - lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)" - - if {[string is true [$PROJECT define get SHARED_BUILD 1]]} { - set cmd [$PROJECT define get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT define get PRACTCL_LIBS]" - set cmd [string map $map $cmd] - puts $cmd - exec {*}$cmd >&@ stdout - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] - puts $cmd - exec {*}$cmd >&@ stdout - } - } else { - set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] - puts $cmd - exec {*}$cmd >&@ stdout - } -} - -### -# Produce a static executable -### -proc ::practcl::build::static-tclsh {outfile PROJECT} { - puts " BUILDING STATIC TCLSH " - set TCLOBJ [$PROJECT project TCLCORE] - set TKOBJ [$PROJECT project TKCORE] - set ODIEOBJ [$PROJECT project odie] - - set PKG_OBJS {} - foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { - lappend PKG_OBJS $item - } - } - array set TCL [$TCLOBJ config.sh] - array set TK [$TKOBJ config.sh] - set path [file dirname $outfile] - cd $path - ### - # For a static Tcl shell, we need to build all local sources - # with the same DEFS flags as the tcl core was compiled with. - # The DEFS produced by a TEA extension aren't intended to operate - # with the internals of a staticly linked Tcl - ### - ::practcl::build::DEFS $PROJECT $TCL(defs) name version defs - set debug [$PROJECT define get debug 0] - set NAME [string toupper $name] - set result {} - set libraries {} - set thisline {} - set OBJECTS {} - set EXTERN_OBJS {} - foreach obj $PKG_OBJS { - $obj compile - set config($obj) [$obj config.sh] - } - set os [$PROJECT define get os] - set TCLSRCDIR [$TCLOBJ define get srcroot] - set TKSRCDIR [$TKOBJ define get srcroot] - - set includedir . - foreach include [$TCLOBJ generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]] - foreach include [$PROJECT generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - - set INCLUDES "-I[join $includedir " -I"]" - if {$debug} { - set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) -ggdb \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } else { - set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } - append COMPILE " " $defs - lappend OBJECTS {*}[compile-sources $PROJECT $COMPILE $COMPILE] - - if {[${PROJECT} define get platform] eq "windows"} { - set RSOBJ [file join $path build tclkit.res.o] - set RCSRC [${PROJECT} define get kit_resource_file] - if {$RCSRC eq {} || ![file exists $RCSRC]} { - set RCSRC [file join $TKSRCDIR win rc wish.rc] - } - set cmd [list windres -o $RSOBJ -DSTATIC_BUILD] - set TCLSRC [file normalize $TCLSRCDIR] - set TKSRC [file normalize $TKSRCDIR] - - lappend cmd --include [::practcl::file_relative $path [file join $TCLSRC generic]] \ - --include [::practcl::file_relative $path [file join $TKSRC generic]] \ - --include [::practcl::file_relative $path [file join $TKSRC win]] \ - --include [::practcl::file_relative $path [file join $TKSRC win rc]] - foreach item [${PROJECT} define get resource_include] { - lappend cmd --include [::practcl::file_relative $path [file normalize $item]] - } - lappend cmd $RCSRC - doexec {*}$cmd - - lappend OBJECTS $RSOBJ - set LDFLAGS_CONSOLE {-mconsole -pipe -static-libgcc} - set LDFLAGS_WINDOW {-mwindows -pipe -static-libgcc} - } else { - set LDFLAGS_CONSOLE {} - set LDFLAGS_WINDOW {} - } - puts "***" - if {$debug} { - set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } else { - set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } - append cmd " $OBJECTS" - append cmd " $EXTERN_OBJS " - # On OSX it is impossibly to generate a completely static - # executable - if {[$PROJECT define get TEACUP_OS] ne "macosx"} { - append cmd " -static " - } - parray TCL - if {$debug} { - if {$os eq "windows"} { - append cmd " -L${TCL(src_dir)}/win -ltcl86g" - append cmd " -L${TK(src_dir)}/win -ltk86g" - } else { - append cmd " -L${TCL(src_dir)}/unix -ltcl86g" - append cmd " -L${TK(src_dir)}/unix -ltk86g" - } - } else { - append cmd " $TCL(build_lib_spec) $TK(build_lib_spec)" - } - foreach obj $PKG_OBJS { - append cmd " [$obj linker-products $config($obj)]" - } - append cmd " $TCL(libs) $TK(libs)" - foreach obj $PKG_OBJS { - append cmd " [$obj linker-external $config($obj)]" - } - if {$debug} { - if {$os eq "windows"} { - append cmd " -L${TCL(src_dir)}/win ${TCL(stub_lib_flag)}" - append cmd " -L${TK(src_dir)}/win ${TK(stub_lib_flag)}" - } else { - append cmd " -L${TCL(src_dir)}/unix ${TCL(stub_lib_flag)}" - append cmd " -L${TK(src_dir)}/unix ${TK(stub_lib_flag)}" - } - } else { - append cmd " $TCL(build_stub_lib_spec)" - append cmd " $TK(build_stub_lib_spec)" - } - append cmd " -o $outfile $LDFLAGS_CONSOLE" - puts "LINK: $cmd" - exec {*}$cmd >&@ stdout -} - -::oo::class create ::practcl::target_obj { - superclass ::practcl::metaclass - - constructor {name info} { - my variable define triggered domake - set triggered 0 - set domake 0 - set define(name) $name - set data [uplevel 2 [list subst $info]] - array set define $data - my select - my initialize - } - - method do {} { - my variable domake - return $domake - } - - method check {} { - my variable needs_make domake - if {$domake} { - return 1 - } - if {[info exists needs_make]} { - return $needs_make - } - set needs_make 0 - foreach item [my define get depends] { - if {![dict exists $::make_objects $item]} continue - set depobj [dict get $::make_objects $item] - if {$depobj eq [self]} { - puts "WARNING [self] depends on itself" - continue - } - if {[$depobj check]} { - set needs_make 1 - } - } - if {!$needs_make} { - set filename [my define get filename] - if {$filename ne {} && ![file exists $filename]} { - set needs_make 1 - } - } - return $needs_make - } - - method triggers {} { - my variable triggered domake define - if {$triggered} { - return $domake - } - set triggered 1 - foreach item [my define get depends] { - puts [list $item [dict exists $::make_objects $item]] - if {![dict exists $::make_objects $item]} continue - set depobj [dict get $::make_objects $item] - if {$depobj eq [self]} { - puts "WARNING [self] triggers itself" - continue - } else { - set r [$depobj check] - puts [list $depobj check $r] - if {$r} { - puts [list $depobj TRIGGER] - $depobj triggers - } - } - } - if {[info exists ::make($define(name))] && $::make($define(name))} { - return - } - set ::make($define(name)) 1 - ::practcl::trigger {*}[my define get triggers] - } -} - - -### -# Define the metaclass -### -::oo::class create ::practcl::object { - superclass ::practcl::metaclass - - constructor {parent args} { - my variable links define - set organs [$parent child organs] - my graft {*}$organs - array set define $organs - array set define [$parent child define] - array set links {} - if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my InitializeSourceFile [lindex $args 0] - } elseif {[llength $args] == 1} { - set data [uplevel 1 [list subst [lindex $args 0]]] - array set define $data - my select - my initialize - } else { - array set define [uplevel 1 [list subst $args]] - my select - my initialize - } - } - - - method include_dir args { - my define add include_dir {*}$args - } - - method include_directory args { - my define add include_dir {*}$args - } - - method Collate_Source CWD {} - - - method child {method} { - return {} - } - - method InitializeSourceFile filename { - my define set filename $filename - set class {} - switch [file extension $filename] { - .tcl { - set class ::practcl::dynamic - } - .h { - set class ::practcl::cheader - } - .c { - set class ::practcl::csource - } - .ini { - switch [file tail $filename] { - module.ini { - set class ::practcl::module - } - library.ini { - set class ::practcl::subproject - } - } - } - .so - - .dll - - .dylib - - .a { - set class ::practcl::clibrary - } - } - if {$class ne {}} { - oo::objdefine [self] class $class - my initialize - } - } - - method add args { - my variable links - set object [::practcl::object new [self] {*}$args] - foreach linktype [$object linktype] { - lappend links($linktype) $object - } - return $object - } - - method go {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable links - foreach {linktype objs} [array get links] { - foreach obj $objs { - $obj go - } - } - debug [list /[self] [self method] [self class]] - } - - method code {section body} { - my variable code - ::practcl::cputs code($section) $body - } - - method Ofile filename { - set lpath [my define get localpath] - if {$lpath eq {}} { - set lpath [my define get name] - } - return ${lpath}_[file rootname [file tail $filename]].o - } - - method compile-products {} { - set filename [my define get filename] - set result {} - if {$filename ne {}} { - if {[my define exists ofile]} { - set ofile [my define get ofile] - } else { - set ofile [my Ofile $filename] - my define set ofile $ofile - } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] - } - foreach item [my link list subordinate] { - lappend result {*}[$item compile-products] - } - return $result - } - - method generate-include-directory {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result [my define get include_dir] - foreach obj [my link list product] { - foreach path [$obj generate-include-directory] { - lappend result $path - } - } - return $result - } - - method generate-debug {{spaces {}}} { - set result {} - ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" - foreach item [my link list subordinate] { - practcl::cputs result [$item generate-debug "$spaces "] - } - return $result - } - - # Empty template methods - method generate-cheader {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct cstruct methods tcltype tclprocs - set result {} - if {[info exists code(header)]} { - ::practcl::cputs result $code(header) - } - foreach obj [my link list product] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cheader */" - ::practcl::cputs result [$obj generate-cheader] - ::practcl::cputs result "/* END [$obj define get filename] generate-cheader */" - } - debug [list cfunct [info exists cfunct]] - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - if {[dict get $info public]} continue - ::practcl::cputs result "[dict get $info header]\;" - } - } - debug [list tclprocs [info exists tclprocs]] - if {[info exists tclprocs]} { - foreach {name info} $tclprocs { - if {[dict exists $info header]} { - ::practcl::cputs result "[dict get $info header]\;" - } - } - } - debug [list methods [info exists methods] [my define get cclass]] - - if {[info exists methods]} { - set thisclass [my define get cclass] - foreach {name info} $methods { - if {[dict exists $info header]} { - ::practcl::cputs result "[dict get $info header]\;" - } - } - # Add the initializer wrapper for the class - ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;" - } - return $result - } - - method generate-public-define {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code - set result {} - if {[info exists code(public-define)]} { - ::practcl::cputs result $code(public-define) - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-define] - } - return $result - } - - method generate-public-macro {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code - set result {} - if {[info exists code(public-macro)]} { - ::practcl::cputs result $code(public-macro) - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-macro] - } - return $result - } - - method generate-public-typedef {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cstruct - set result {} - if {[info exists code(public-typedef)]} { - ::practcl::cputs result $code(public-typedef) - } - if {[info exists cstruct]} { - # Add defintion for native c data structures - foreach {name info} $cstruct { - ::practcl::cputs result "typedef struct $name ${name}\;" - if {[dict exists $info aliases]} { - foreach n [dict get $info aliases] { - ::practcl::cputs result "typedef struct $name ${n}\;" - } - } - } - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-typedef] - } - return $result - } - - method generate-public-structure {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cstruct - set result {} - if {[info exists code(public-structure)]} { - ::practcl::cputs result $code(public-structure) - } - if {[info exists cstruct]} { - foreach {name info} $cstruct { - if {[dict exists $info comment]} { - ::practcl::cputs result [dict get $info comment] - } - ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" - } - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-structure] - } - return $result - } - method generate-public-headers {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code tcltype - set result {} - if {[info exists code(public-header)]} { - ::practcl::cputs result $code(public-header) - } - if {[info exists tcltype]} { - foreach {type info} $tcltype { - if {![dict exists $info cname]} { - set cname [string tolower ${type}]_tclobjtype - dict set tcltype $type cname $cname - } else { - set cname [dict get $info cname] - } - ::practcl::cputs result "extern const Tcl_ObjType $cname\;" - } - } - if {[info exists code(public)]} { - ::practcl::cputs result $code(public) - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-headers] - } - return $result - } - - method generate-stub-function {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct tcltype - set result {} - foreach mod [my link list product] { - foreach {funct def} [$mod generate-stub-function] { - dict set result $funct $def - } - } - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - if {![dict get $info export]} continue - dict set result $funcname [dict get $info header] - } - } - return $result - } - - method generate-public-function {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct tcltype - set result {} - - if {[my define get initfunc] ne {}} { - ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" - } - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - if {![dict get $info public]} continue - ::practcl::cputs result "[dict get $info header]\;" - } - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-function] - } - return $result - } - - method generate-public-includes {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set includes {} - foreach item [my define get public-include] { - if {$item ni $includes} { - lappend includes $item - } - } - foreach mod [my link list product] { - foreach item [$mod generate-public-includes] { - if {$item ni $includes} { - lappend includes $item - } - } - } - return $includes - } - method generate-public-verbatim {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set includes {} - foreach item [my define get public-verbatim] { - if {$item ni $includes} { - lappend includes $item - } - } - foreach mod [my link list subordinate] { - foreach item [$mod generate-public-verbatim] { - if {$item ni $includes} { - lappend includes $item - } - } - } - return $includes - } - ### - # This methods generates the contents of an amalgamated .h file - # which describes the public API of this module - ### - method generate-h {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - set includes [my generate-public-includes] - foreach inc $includes { - if {[string index $inc 0] ni {< \"}} { - ::practcl::cputs result "#include \"$inc\"" - } else { - ::practcl::cputs result "#include $inc" - } - } - foreach file [my generate-public-verbatim] { - ::practcl::cputs result "/* BEGIN $file */" - ::practcl::cputs result [::practcl::cat $file] - ::practcl::cputs result "/* END $file */" - } - foreach method { - generate-public-define - generate-public-macro - generate-public-typedef - generate-public-structure - generate-public-headers - generate-public-function - } { - ::practcl::cputs result "/* BEGIN SECTION $method */" - ::practcl::cputs result [my $method] - ::practcl::cputs result "/* END SECTION $method */" - } - return $result - } - - ### - # This methods generates the contents of an amalgamated .c file - # which implements the loader for a batch of tools - ### - method generate-c {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result { -/* This file was generated by practcl */ - } - set includes {} - lappend headers - if {[my define get tk 0]} { - lappend headers - } - lappend headers {*}[my define get include] - if {[my define get output_h] ne {}} { - lappend headers "\"[my define get output_h]\"" - } - foreach mod [my link list product] { - # Signal modules to formulate final implementation - $mod go - } - foreach mod [my link list dynamic] { - foreach inc [$mod define get include] { - if {$inc ni $headers} { - lappend headers $inc - } - } - } - foreach inc $headers { - if {[string index $inc 0] ni {< \"}} { - ::practcl::cputs result "#include \"$inc\"" - } else { - ::practcl::cputs result "#include $inc" - } - } - foreach {method} { - generate-cheader - generate-cstruct - generate-constant - generate-cfunct - generate-cmethod - } { - ::practcl::cputs result "/* BEGIN $method [my define get filename] */" - ::practcl::cputs result [my $method] - ::practcl::cputs result "/* END $method [my define get filename] */" - } - debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] - return $result - } - - - method generate-loader {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - if {[my define get initfunc] eq {}} return - ::practcl::cputs result " -extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" - ::practcl::cputs result { - /* Initialise the stubs tables. */ - #ifdef USE_TCL_STUBS - if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR; - if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR; -} - if {[my define get tk 0]} { - ::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;} - } - ::practcl::cputs result { #endif} - set TCLINIT [my generate-tcl] - ::practcl::cputs result " if(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR ;" - foreach item [my link list product] { - if {[$item define get output_c] ne {}} { - ::practcl::cputs result [$item generate-cinit-external] - } else { - ::practcl::cputs result [$item generate-cinit] - } - } - if {[my define exists pkg_name]} { - ::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" - } - ::practcl::cputs result " return TCL_OK\;\n\}\n" - return $result - } - - ### - # This methods generates any Tcl script file - # which is required to pre-initialize the C library - ### - method generate-tcl {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - my variable code - if {[info exists code(tcl)]} { - ::practcl::cputs result $code(tcl) - } - set result [::practcl::_tagblock $result tcl [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-tcl] - } - return $result - } - - method static-packages {} { - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] - if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] - if {$pkg_name ne {}} { - dict set result $pkg_name initfunc $initfunc - dict set result $pkg_name version [my define get version [my define get pkg_vers]] - dict set result $pkg_name autoload [my define get autoload 0] - } - } - foreach item [my link list subordinate] { - foreach {pkg info} [$item static-packages] { - dict set result $pkg $info - } - } - return $result - } - - method target {method args} { - switch $method { - is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] } - } - } - -} - -::oo::class create ::practcl::product { - superclass ::practcl::object - - method linktype {} { - return {subordinate product} - } - - method include header { - my define add include $header - } - - method cstructure {name definition {argdat {}}} { - my variable cstruct - dict set cstruct $name body $definition - foreach {f v} $argdat { - dict set cstruct $name $f $v - } - } - - method generate-cinit {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code - set result {} - if {[info exists code(cinit)]} { - ::practcl::cputs result $code(cinit) - } - if {[my define get initfunc] ne {}} { - ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach obj [my link list product] { - ::practcl::cputs result [$obj generate-cinit] - } - return $result - } -} - -### -# Dynamic blocks do not generate their own .c files, -# instead the contribute to the amalgamation -# of the main library file -### -::oo::class create ::practcl::dynamic { - superclass ::practcl::product - - # Retrieve any additional source files required - - method compile-products {} { - set filename [my define get output_c] - set result {} - if {$filename ne {}} { - if {[my define exists ofile]} { - set ofile [my define get ofile] - } else { - set ofile [my Ofile $filename] - my define set ofile $ofile - } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] - } else { - set filename [my define get cfile] - if {$filename ne {}} { - if {[my define exists ofile]} { - set ofile [my define get ofile] - } else { - set ofile [my Ofile $filename] - my define set ofile $ofile - } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] - } - } - foreach item [my link list subordinate] { - lappend result {*}[$item compile-products] - } - return $result - } - - method implement path { - my go - my Collate_Source $path - if {[my define get output_c] eq {}} return - set filename [file join $path [my define get output_c]] - my define set cfile $filename - set fout [open $filename w] - puts $fout [my generate-c] - puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" - puts $fout [my generate-cinit] - if {[my define get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" - } - puts $fout " return TCL_OK\;" - puts $fout "\x7D" - close $fout - } - - method initialize {} { - set filename [my define get filename] - if {$filename eq {}} { - return - } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] - } - if {[my define get localpath] eq {}} { - my define set localpath [my define get localpath]_[my define get name] - } - ::source $filename - } - - method linktype {} { - return {subordinate product dynamic} - } - - ### - # Populate const static data structures - ### - method generate-cstruct {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cstruct methods tcltype - set result {} - if {[info exists code(struct)]} { - ::practcl::cputs result $code(struct) - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result [$obj generate-cstruct] - } - return $result - } - - method generate-constant {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - my variable code cstruct methods tcltype - if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" - ::practcl::cputs result $code(constant) - } - if {[info exists cstruct]} { - foreach {name info} $cstruct { - set map {} - lappend map @NAME@ $name - lappend map @MACRO@ GET[string toupper $name] - - if {[dict exists $info deleteproc]} { - lappend map @DELETEPROC@ [dict get $info deleteproc] - } else { - lappend map @DELETEPROC@ NULL - } - if {[dict exists $info cloneproc]} { - lappend map @CLONEPROC@ [dict get $info cloneproc] - } else { - lappend map @CLONEPROC@ NULL - } - ::practcl::cputs result [string map $map { -const static Tcl_ObjectMetadataType @NAME@DataType = { - TCL_OO_METADATA_VERSION_CURRENT, - "@NAME@", - @DELETEPROC@, - @CLONEPROC@ -}; -#define @MACRO@(OBJCONTEXT) (@NAME@ *) Tcl_ObjectGetMetadata(OBJCONTEXT,&@NAME@DataType) -}] - } - } - if {[info exists tcltype]} { - foreach {type info} $tcltype { - dict with info {} - ::practcl::cputs result "const Tcl_ObjType $cname = \{\n .freeIntRepProc = &${freeproc},\n .dupIntRepProc = &${dupproc},\n .updateStringProc = &${updatestringproc},\n .setFromAnyProc = &${setfromanyproc}\n\}\;" - } - } - - if {[info exists methods]} { - set mtypes {} - foreach {name info} $methods { - set callproc [dict get $info callproc] - set methodtype [dict get $info methodtype] - if {$methodtype in $mtypes} continue - lappend mtypes $methodtype - ### - # Build the data struct for this method - ### - ::practcl::cputs result "const static Tcl_MethodType $methodtype = \{" - ::practcl::cputs result " .version = TCL_OO_METADATA_VERSION_CURRENT,\n .name = \"$name\",\n .callProc = $callproc," - if {[dict exists $info deleteproc]} { - set deleteproc [dict get $info deleteproc] - } else { - set deleteproc NULL - } - if {$deleteproc ni { {} NULL }} { - ::practcl::cputs result " .deleteProc = $deleteproc," - } else { - ::practcl::cputs result " .deleteProc = NULL," - } - if {[dict exists $info cloneproc]} { - set cloneproc [dict get $info cloneproc] - } else { - set cloneproc NULL - } - if {$cloneproc ni { {} NULL }} { - ::practcl::cputs result " .cloneProc = $cloneproc\n\}\;" - } else { - ::practcl::cputs result " .cloneProc = NULL\n\}\;" - } - dict set methods $name methodtype $methodtype - } - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result [$obj generate-constant] - } - return $result - } - - ### - # Generate code that provides subroutines called by - # Tcl API methods - ### - method generate-cfunct {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct - set result {} - if {[info exists code(funct)]} { - ::practcl::cputs result $code(funct) - } - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - ::practcl::cputs result "[dict get $info header]\{[dict get $info body]\}\;" - } - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { - continue - } - ::practcl::cputs result [$obj generate-cfunct] - } - return $result - } - - ### - # Generate code that provides implements Tcl API - # calls - ### - method generate-cmethod {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code methods tclprocs - set result {} - if {[info exists code(method)]} { - ::practcl::cputs result $code(method) - } - - if {[info exists tclprocs]} { - foreach {name info} $tclprocs { - if {![dict exists $info body]} continue - set callproc [dict get $info callproc] - set header [dict get $info header] - set body [dict get $info body] - ::practcl::cputs result "${header} \{${body}\}" - } - } - - - if {[info exists methods]} { - set thisclass [my define get cclass] - foreach {name info} $methods { - if {![dict exists $info body]} continue - set callproc [dict get $info callproc] - set header [dict get $info header] - set body [dict get $info body] - ::practcl::cputs result "${header} \{${body}\}" - } - # Build the OO_Init function - ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{" - ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my define get class]] { - /* - ** Build the "@TCLCLASS@" class - */ - Tcl_Obj* nameObj; /* Name of a class or method being looked up */ - Tcl_Object curClassObject; /* Tcl_Object representing the current class */ - Tcl_Class curClass; /* Tcl_Class representing the current class */ - - /* - * Find the "@TCLCLASS@" class, and attach an 'init' method to it. - */ - - nameObj = Tcl_NewStringObj("@TCLCLASS@", -1); - Tcl_IncrRefCount(nameObj); - if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { - Tcl_DecrRefCount(nameObj); - return TCL_ERROR; - } - Tcl_DecrRefCount(nameObj); - curClass = Tcl_GetObjectAsClass(curClassObject); -}] - if {[dict exists $methods constructor]} { - set mtype [dict get $methods constructor methodtype] - ::practcl::cputs result [string map [list @MTYPE@ $mtype] { - /* Attach the constructor to the class */ - Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &@MTYPE@, NULL)); - }] - } - foreach {name info} $methods { - dict with info {} - if {$name in {constructor destructor}} continue - ::practcl::cputs result [string map [list @NAME@ $name @MTYPE@ $methodtype] { - nameObj=Tcl_NewStringObj("@NAME@",-1); - Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); - Tcl_DecrRefCount(nameObj); -}] - if {[dict exists $info aliases]} { - foreach alias [dict get $info aliases] { - if {[dict exists $methods $alias]} continue - ::practcl::cputs result [string map [list @NAME@ $alias @MTYPE@ $methodtype] { - nameObj=Tcl_NewStringObj("@NAME@",-1); - Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); - Tcl_DecrRefCount(nameObj); -}] - } - } - } - ::practcl::cputs result " return TCL_OK\;\n\}\n" - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result [$obj generate-cmethod] - } - return $result - } - - method generate-cinit-external {} { - if {[my define get initfunc] eq {}} { - return "/* [my define get filename] declared not initfunc */" - } - return " if([my define get initfunc](interp)) return TCL_ERROR\;" - } - - ### - # Generate code that runs when the package/module is - # initialized into the interpreter - ### - method generate-cinit {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - my variable code methods tclprocs - if {[info exists code(nspace)]} { - ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" - foreach nspace $code(nspace) { - ::practcl::cputs result [string map [list @NSPACE@ $nspace] { - modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); - if(!modPtr) { - modPtr = Tcl_CreateNamespace(interp, "@NSPACE@", NULL, NULL); - } -}] - } - ::practcl::cputs result " \}" - } - if {[info exists code(tclinit)]} { - ::practcl::cputs result $code(tclinit) - } - if {[info exists code(cinit)]} { - ::practcl::cputs result $code(cinit) - } - if {[info exists code(initfuncts)]} { - foreach func $code(initfuncts) { - ::practcl::cputs result " if (${func}(interp) != TCL_OK) return TCL_ERROR\;" - } - } - if {[info exists tclprocs]} { - foreach {name info} $tclprocs { - set map [list @NAME@ $name @CALLPROC@ [dict get $info callproc]] - ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] - if {[dict exists $info aliases]} { - foreach alias [dict get $info aliases] { - set map [list @NAME@ $alias @CALLPROC@ [dict get $info callproc]] - ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] - } - } - } - } - - if {[info exists code(nspace)]} { - ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" - foreach nspace $code(nspace) { - ::practcl::cputs result [string map [list @NSPACE@ $nspace] { - modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); - Tcl_CreateEnsemble(interp, modPtr->fullName, modPtr, TCL_ENSEMBLE_PREFIX); - Tcl_Export(interp, modPtr, "[a-z]*", 1); -}] - } - ::practcl::cputs result " \}" - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach obj [my link list product] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { - ::practcl::cputs result [$obj generate-cinit-external] - } else { - ::practcl::cputs result [$obj generate-cinit] - } - } - return $result - } - - method c_header body { - my variable code - ::practcl::cputs code(header) $body - } - - method c_code body { - my variable code - ::practcl::cputs code(funct) $body - } - method c_function {header body} { - my variable code cfunct - foreach regexp { - {(.*) ([a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} - {(.*) (\x2a[a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} - } { - if {[regexp $regexp $header all keywords funcname arglist]} { - dict set cfunct $funcname header $header - dict set cfunct $funcname body $body - dict set cfunct $funcname keywords $keywords - dict set cfunct $funcname arglist $arglist - dict set cfunct $funcname public [expr {"static" ni $keywords}] - dict set cfunct $funcname export [expr {"STUB_EXPORT" in $keywords}] - - return - } - } - ::practcl::cputs code(header) "$header\;" - # Could not parse that block as a function - # append it verbatim to our c_implementation - ::practcl::cputs code(funct) "$header [list $body]" - } - - - method cmethod {name body {arginfo {}}} { - my variable methods code - foreach {f v} $arginfo { - dict set methods $name $f $v - } - dict set methods $name body "Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ -$body" - } - - method c_tclproc_nspace nspace { - my variable code - if {![info exists code(nspace)]} { - set code(nspace) {} - } - if {$nspace ni $code(nspace)} { - lappend code(nspace) $nspace - } - } - - method c_tclproc_raw {name body {arginfo {}}} { - my variable tclprocs code - - foreach {f v} $arginfo { - dict set tclprocs $name $f $v - } - dict set tclprocs $name body $body - } - - method go {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - next - my variable methods code cstruct tclprocs - if {[info exists methods]} { - debug [self] methods [my define get cclass] - set thisclass [my define get cclass] - foreach {name info} $methods { - # Provide a callproc - if {![dict exists $info callproc]} { - set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]] - dict set methods $name callproc $callproc - } else { - set callproc [dict get $info callproc] - } - if {[dict exists $info body] && ![dict exists $info header]} { - dict set methods $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)" - } - if {![dict exists $info methodtype]} { - set methodtype [string map {{ } _ : _} MethodType_${thisclass}_${name}] - dict set methods $name methodtype $methodtype - } - } - if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { - lappend code(initfuncts) "${thisclass}_OO_Init" - } - } - set thisnspace [my define get nspace] - - if {[info exists tclprocs]} { - debug [self] tclprocs [dict keys $tclprocs] - foreach {name info} $tclprocs { - if {![dict exists $info callproc]} { - set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} Tclcmd_${thisnspace}_${name}]] - dict set tclprocs $name callproc $callproc - } else { - set callproc [dict get $info callproc] - } - if {[dict exists $info body] && ![dict exists $info header]} { - dict set tclprocs $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv\[\])" - } - } - } - debug [list /[self] [self method] [self class]] - } - - # Once an object marks itself as some - # flavor of dynamic, stop trying to morph - # it into something else - method select {} {} - - - method tcltype {name argdat} { - my variable tcltype - foreach {f v} $argdat { - dict set tcltype $name $f $v - } - if {![dict exists tcltype $name cname]} { - dict set tcltype $name cname [string tolower $name]_tclobjtype - } - lappend map @NAME@ $name - set info [dict get $tcltype $name] - foreach {f v} $info { - lappend map @[string toupper $f]@ $v - } - foreach {func fpat template} { - freeproc {@Name@Obj_freeIntRepProc} {void @FNAME@(Tcl_Obj *objPtr)} - dupproc {@Name@Obj_dupIntRepProc} {void @FNAME@(Tcl_Obj *srcPtr,Tcl_Obj *dupPtr)} - updatestringproc {@Name@Obj_updateStringRepProc} {void @FNAME@(Tcl_Obj *objPtr)} - setfromanyproc {@Name@Obj_setFromAnyProc} {int @FNAME@(Tcl_Interp *interp,Tcl_Obj *objPtr)} - } { - if {![dict exists $info $func]} { - error "$name does not define $func" - } - set body [dict get $info $func] - # We were given a function name to call - if {[llength $body] eq 1} continue - set fname [string map [list @Name@ [string totitle $name]] $fpat] - my c_function [string map [list @FNAME@ $fname] $template] [string map $map $body] - dict set tcltype $name $func $fname - } - } -} - -::oo::class create ::practcl::cheader { - superclass ::practcl::product - - method compile-products {} {} - method generate-cinit {} {} -} - -::oo::class create ::practcl::csource { - superclass ::practcl::product -} - -::oo::class create ::practcl::clibrary { - superclass ::practcl::product - - method linker-products {configdict} { - return [my define get filename] - } - -} - -### -# In the end, all C code must be loaded into a module -# This will either be a dynamically loaded library implementing -# a tcl extension, or a compiled in segment of a custom shell/app -### -::oo::class create ::practcl::module { - superclass ::practcl::dynamic - - method child which { - switch $which { - organs { - return [list project [my define get project] module [self]] - } - } - } - - method initialize {} { - set filename [my define get filename] - if {$filename eq {}} { - return - } - if {[my define get name] eq {}} { - my define set name [file tail [file dirname $filename]] - } - if {[my define get localpath] eq {}} { - my define set localpath [my define get name]_[my define get name] - } - debug [self] SOURCE $filename - my source $filename - } - - method implement path { - my go - my Collate_Source $path - foreach item [my link list dynamic] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - foreach item [my link list module] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set filename [my define get output_c] - if {$filename eq {}} { - debug [list /[self] [self method] [self class]] - return - } - set cout [open [file join $path [file rootname $filename].c] w] - puts $cout [subst {/* -** This file is generated by the [info script] script -** any changes will be overwritten the next time it is run -*/}] - puts $cout [my generate-c] - puts $cout [my generate-loader] - close $cout - debug [list /[self] [self method] [self class]] - } - - method linktype {} { - return {subordinate product dynamic module} - } -} - -::oo::class create ::practcl::autoconf { - - ### - # find or fake a key/value list describing this project - ### - method config.sh {} { - my variable conf_result - if {[info exists conf_result]} { - return $conf_result - } - set result {} - set name [my define get name] - set PWD $::CWD - set builddir [my define get builddir] - my unpack - set srcroot [my define get srcroot] - if {![file exists $builddir]} { - my Configure - } - set filename [file join $builddir config.tcl] - # Project uses the practcl template. Use the leavings from autoconf - if {[file exists $filename]} { - set dat [::practcl::config.tcl $builddir] - foreach {item value} [lsort -stride 2 -dictionary $dat] { - dict set result $item $value - } - set conf_result $result - return $result - } - set filename [file join $builddir ${name}Config.sh] - if {[file exists $filename]} { - set l [expr {[string length $name]+1}] - foreach {field dat} [::practcl::read_Config.sh $filename] { - set field [string tolower $field] - if {[string match ${name}_* $field]} { - set field [string range $field $l end] - } - dict set result $field $dat - } - set conf_result $result - return $result - } - ### - # Oh man... we have to guess - ### - set filename [file join $builddir Makefile] - if {![file exists $filename]} { - error "Could not locate any configuration data in $srcroot" - } - foreach {field dat} [::practcl::read_Makefile $filename] { - dict set result $field $dat - } - set conf_result $result - cd $PWD - return $result - } -} - - -::oo::class create ::practcl::project { - superclass ::practcl::module ::practcl::autoconf - - constructor args { - my variable define - if {[llength $args] == 1} { - if {[catch {uplevel 1 [list subst [lindex $args 0]]} contents]} { - set contents [lindex $args 0] - } - } else { - if {[catch {uplevel 1 [list subst $args]} contents]} { - set contents $args - } - } - array set define $contents - my select - my initialize - } - - - method add_project {pkg info {oodefine {}}} { - set os [my define get os] - if {$os eq {}} { - set os [::practcl::os] - my define set os $os - } - set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] - if {[dict exists $info os] && ($os ni [dict get $info os])} return - # Select which tag to use here. - # For production builds: tag-release - if {[::info exists ::env(FOSSIL_MIRROR)]} { - dict set info localmirror $::env(FOSSIL_MIRROR) - } - set profile [my define get profile release]: - if {[dict exists $info profile $profile]} { - dict set info tag [dict get $info profile $profile] - } - set obj [namespace current]::PROJECT.$pkg - if {[info command $obj] eq {}} { - set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]] - } - my link object $obj - oo::objdefine $obj $oodefine - $obj define set masterpath $::CWD - $obj go - return $obj - } - - method child which { - switch $which { - organs { - # A library can be a project, it can be a module. Any - # subordinate modules will indicate their existance - return [list project [self] module [self]] - } - } - } - - method linktype {} { - return project - } - - # Exercise the methods of a sub-object - method project {pkg args} { - set obj [namespace current]::PROJECT.$pkg - if {[llength $args]==0} { - return $obj - } - tailcall ${obj} {*}$args - } -} - -::oo::class create ::practcl::library { - superclass ::practcl::project - - method compile-products {} { - set result {} - foreach item [my link list subordinate] { - lappend result {*}[$item compile-products] - } - set filename [my define get output_c] - if {$filename ne {}} { - set ofile [file rootname [file tail $filename]]_main.o - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] - } - return $result - } - - method generate-tcl-loader {} { - set result {} - set PKGINIT [my define get pkginit] - set PKG_NAME [my define get name [my define get pkg_name]] - set PKG_VERSION [my define get pkg_vers [my define get version]] - if {[string is true [my define get SHARED_BUILD 0]]} { - set LIBFILE [my define get libfile] - ::practcl::cputs result [string map \ - [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { -# Shared Library Style -load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ -package provide @PKG_NAME@ @PKG_VERSION@ -}] - } else { - ::practcl::cputs result [string map \ - [list @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { -# Tclkit Style -load {} @PKGINIT@ -package provide @PKG_NAME@ @PKG_VERSION@ -}] - } - return $result - } - - method go {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set name [my define getnull name] - if {$name eq {}} { - set name generic - my define name generic - } - if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { - my define set tk 0 - } - set output_c [my define getnull output_c] - if {$output_c eq {}} { - set output_c [file rootname $name].c - my define set output_c $output_c - } - set output_h [my define getnull output_h] - if {$output_h eq {}} { - set output_h [file rootname $output_c].h - my define set output_h $output_h - } - set output_tcl [my define getnull output_tcl] - #if {$output_tcl eq {}} { - # set output_tcl [file rootname $output_c].tcl - # my define set output_tcl $output_tcl - #} - #set output_mk [my define getnull output_mk] - #if {$output_mk eq {}} { - # set output_mk [file rootname $output_c].mk - # my define set output_mk $output_mk - #} - set initfunc [my define getnull initfunc] - if {$initfunc eq {}} { - set initfunc [string totitle $name]_Init - my define set initfunc $initfunc - } - set output_decls [my define getnull output_decls] - if {$output_decls eq {}} { - set output_decls [file rootname $output_c].decls - my define set output_decls $output_decls - } - my variable links - foreach {linktype objs} [array get links] { - foreach obj $objs { - $obj go - } - } - debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] - } - - method implement path { - my go - my Collate_Source $path - foreach item [my link list dynamic] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - foreach item [my link list module] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - set cout [open [file join $path [my define get output_c]] w] - puts $cout [subst {/* -** This file is generated by the [info script] script -** any changes will be overwritten the next time it is run -*/}] - puts $cout [my generate-c] - puts $cout [my generate-loader] - close $cout - - set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H - set hout [open [file join $path [my define get output_h]] w] - puts $hout [subst {/* -** This file is generated by the [info script] script -** any changes will be overwritten the next time it is run -*/}] - puts $hout "#ifndef ${macro}" - puts $hout "#define ${macro}" - puts $hout [my generate-h] - puts $hout "#endif" - close $hout - - set output_tcl [my define get output_tcl] - if {$output_tcl ne {}} { - set tclout [open [file join $path [my define get output_tcl]] w] - puts $tclout "### -# This file is generated by the [info script] script -# any changes will be overwritten the next time it is run -###" - puts $tclout [my generate-tcl] - puts $tclout [my generate-tcl-loader] - close $tclout - } - } - - method generate-decls {pkgname path} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set outfile [file join $path/$pkgname.decls] - - ### - # Build the decls file - ### - set fout [open $outfile w] - puts $fout [subst {### - # $outfile - # - # This file was generated by [info script] - ### - - library $pkgname - interface $pkgname - }] - - ### - # Generate list of functions - ### - set stubfuncts [my generate-stub-function] - set thisline {} - set functcount 0 - foreach {func header} $stubfuncts { - puts $fout [list declare [incr functcount] $header] - } - puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"] - puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] - - close $fout - - ### - # Build [package]Decls.h - ### - set hout [open [file join $path ${pkgname}Decls.h] w] - - close $hout - - set cout [open [file join $path ${pkgname}StubInit.c] w] -puts $cout [string map [list %pkgname% $pkgname %PkgName% [string totitle $pkgname]] { -#ifndef USE_TCL_STUBS -#define USE_TCL_STUBS -#endif -#undef USE_TCL_STUB_PROCS - -#include "tcl.h" -#include "%pkgname%.h" - - /* - ** Ensure that Tdom_InitStubs is built as an exported symbol. The other stub - ** functions should be built as non-exported symbols. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -%PkgName%Stubs *%pkgname%StubsPtr; - - /* - **---------------------------------------------------------------------- - ** - ** %PkgName%_InitStubs -- - ** - ** Checks that the correct version of %PkgName% is loaded and that it - ** supports stubs. It then initialises the stub table pointers. - ** - ** Results: - ** The actual version of %PkgName% that satisfies the request, or - ** NULL to indicate that an error occurred. - ** - ** Side effects: - ** Sets the stub table pointers. - ** - **---------------------------------------------------------------------- - */ - -char * -%PkgName%_InitStubs (Tcl_Interp *interp, char *version, int exact) -{ - char *actualVersion; - actualVersion = Tcl_PkgRequireEx(interp, "%pkgname%", version, exact,(ClientData *) &%pkgname%StubsPtr); - if (!actualVersion) { - return NULL; - } - if (!%pkgname%StubsPtr) { - Tcl_SetResult(interp,"This implementation of %PkgName% does not support stubs",TCL_STATIC); - return NULL; - } - return actualVersion; -} -}] - close $cout - } - - # Backward compadible call - method generate-make path { - ::practcl::build::Makefile $path [self] - } - - method install-headers {} { - set result {} - return $result - } - - method linktype {} { - return library - } - - # Create a "package ifneeded" - # Args are a list of aliases for which this package will answer to - method package-ifneeded {args} { - set result {} - set name [my define get pkg_name [my define get name]] - set version [my define get pkg_vers [my define get version]] - if {$version eq {}} { - set version 0.1a - } - set output_tcl [my define get output_tcl] - if {$output_tcl ne {}} { - set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[string is true -strict [my define get SHARED_BUILD]]} { - set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" - } else { - # Provide a null passthrough - set script [list package provide $name $version] - } - set result "package ifneeded [list $name] [list $version] $script" - foreach alias $args { - set script "package require $name $version \; package provide $alias $version" - append result \n\n [list package ifneeded $alias $version $script] - } - return $result - } - - - method shared_library {} { - set name [string tolower [my define get name [my define get pkg_name]]] - set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] - set map {} - lappend map %LIBRARY_NAME% $name - lappend map %LIBRARY_VERSION% $version - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] - lappend map %LIBRARY_PREFIX% [my define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] - return $outfile - } -} - -::oo::class create ::practcl::tclkit { - superclass ::practcl::library - - method Collate_Source CWD { - my define set SHARED_BUILD 0 - set name [my define get name] - - if {![my define exists TCL_LOCAL_APPINIT]} { - my define set TCL_LOCAL_APPINIT Tclkit_AppInit - } - if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook - } - - set PROJECT [self] - set os [$PROJECT define get os] - set TCLOBJ [$PROJECT project TCLCORE] - set TKOBJ [$PROJECT project TKCORE] - set ODIEOBJ [$PROJECT project odie] - - set TCLSRCDIR [$TCLOBJ define get srcroot] - set TKSRCDIR [$TKOBJ define get srcroot] - set PKG_OBJS {} - foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { - lappend PKG_OBJS $item - } - } - # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK - if {$os eq "windows"} { - set PLATFORM_SRC_DIR win - my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 - my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 - my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] - } else { - set PLATFORM_SRC_DIR unix - my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] - } - ### - # Add local static Zlib implementation - ### - set cdir [file join $TCLSRCDIR compat zlib] - foreach file { - adler32.c compress.c crc32.c - deflate.c infback.c inffast.c - inflate.c inftrees.c trees.c - uncompr.c zutil.c - } { - my add [file join $cdir $file] - } - - ### - # Pre 8.7, Tcl doesn't include a Zipfs implementation - # in the core. Grab the one from odielib - ### - set zipfs [file join $TCLSRCDIR generic zvfs.c] - if {![file exists $zipfs]} { - # The Odie project maintains a mirror of the version - # released with the Tcl core - my add_project odie { - tag trunk - class subproject - vfsinstall 0 - } - my project odie unpack - set ODIESRCROOT [my project odie define get srcroot] - set cdir [file join $ODIESRCROOT compat zipfs] - my define add include_dir $cdir - set zipfs [file join $cdir zvfs.c] - } - - my add class csource filename $zipfs initfunc Tclzipfs_Init pkg_name zipfs pkg_vers 1.0 autoload 1 - - my define add include_dir [file join $TKSRCDIR generic] - my define add include_dir [file join $TKSRCDIR $PLATFORM_SRC_DIR] - my define add include_dir [file join $TKSRCDIR bitmaps] - my define add include_dir [file join $TKSRCDIR xlib] - my define add include_dir [file join $TCLSRCDIR generic] - my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] - my define add include_dir [file join $TCLSRCDIR compat zlib] - # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK - ::practcl::build::tclkit_main $PROJECT $PKG_OBJS - } - - ## Wrap an executable - # - method wrap {PWD exename vfspath args} { - cd $PWD - if {![file exists $vfspath]} { - file mkdir $vfspath - } - foreach item [my link list core.library] { - set name [$item define get name] - set libsrcroot [$item define get srcroot] - if {[file exists [file join $libsrcroot library]]} { - ::practcl::copyDir [file join $libsrcroot library] [file join $vfspath boot $name] - } - } - if {[my define get installdir] ne {}} { - ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] - } - foreach arg $args { - ::practcl::copyDir $arg $vfspath - } - - set fout [open [file join $vfspath packages.tcl] w] - puts $fout { - set ::PKGIDXFILE [info script] - set dir [file dirname $::PKGIDXFILE] - } - #set BASEVFS [my define get BASEVFS] - set EXEEXT [my define get EXEEXT] - - set tclkit_bare [my define get tclkit_bare] - - set buffer [::practcl::pkgindex_path $vfspath] - puts $fout $buffer - puts $fout { - # Advertise statically linked packages - foreach {pkg script} [array get ::kitpkg] { - eval $script - } - } - close $fout - package require zipfile::mkzip - ::zipfile::mkzip::mkzip ${exename}${EXEEXT} -runtime $tclkit_bare -directory $vfspath - if { [my define get platform] ne "windows" } { - file attributes ${exename}${EXEEXT} -permissions a+x - } - } -} - -### -# Meta repository -# The default is an inert source code block -### -oo::class create ::practcl::subproject { - superclass ::practcl::object - - method compile {} {} - - method go {} { - set platform [my define get platform] - my define get USEMSVC [my define get USEMSVC] - set name [my define get name] - if {![my define exists srcroot]} { - my define set srcroot [file join [my define get sandbox] $name] - } - set srcroot [my define get srcroot] - my define set localsrcdir $srcroot - my define add include_dir [file join $srcroot generic] - my sources - } - - # Install project into the local build system - method install-local {} { - my unpack - } - - # Install project into the virtual file system - method install-vfs {} {} - - method linktype {} { - return {subordinate package} - } - - method linker-products {configdict} {} - - method linker-external {configdict} { - if {[dict exists $configdict PRACTCL_LIBS]} { - return [dict get $configdict PRACTCL_LIBS] - } - } - - method sources {} {} - - method unpack {} { - set name [my define get name] - puts [list $name [self] UNPACK] - my define set [::practcl::fossil_sandbox $name [my define dump]] - } - - method update {} { - set name [my define get name] - my define set [::practcl::fossil_sandbox $name [dict merge [my define dump] {update 1}]] - } -} - -### -# A project which the kit compiles and integrates -# the source for itself -### -oo::class create ::practcl::subproject.source { - superclass ::practcl::subproject ::practcl::library - - method linktype {} { - return {subordinate package source} - } - -} - -# a copy from the teapot -oo::class create ::practcl::subproject.teapot { - superclass ::practcl::subproject - - method install-local {} { - my install-vfs - } - - method install-vfs {} { - set pkg [my define get pkg_name [my define get name]] - set download [my define get download] - my unpack - set DEST [my define get installdir] - set prefix [string trimleft [my define get prefix] /] - # Get tcllib from our destination - set dir [file join $DEST $prefix lib tcllib] - source [file join $DEST $prefix lib tcllib pkgIndex.tcl] - package require zipfile::decode - ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] - } -} - -oo::class create ::practcl::subproject.sak { - superclass ::practcl::subproject - - method install-local {} { - my install-vfs - } - - method install-vfs {} { - ### - # Handle teapot installs - ### - set pkg [my define get pkg_name [my define get name]] - my unpack - set DEST [my define get installdir] - set prefix [string trimleft [my define get prefix] /] - set srcroot [my define get srcroot] - ::dotclexec [file join $srcroot installer.tcl] \ - -pkg-path [file join $DEST $prefix lib $pkg] \ - -no-examples -no-html -no-nroff \ - -no-wait -no-gui -no-apps - } -} - -### -# A binary package -### -oo::class create ::practcl::subproject.binary { - superclass ::practcl::subproject ::practcl::autoconf - - - method compile-products {} {} - - method ConfigureOpts {} { - set opts {} - set builddir [my define get builddir] - if {[my define get broken_destroot 0]} { - set PREFIX [my define get prefix_broken_destdir] - } else { - set PREFIX [my define get prefix] - } - if {[my define get HOST] != [my define get TARGET]} { - lappend opts --host=[my define get TARGET] - } - if {[my define exists tclsrcdir]} { - set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir]]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir] .. generic]]] - lappend opts --with-tcl=$TCLSRCDIR --with-tclinclude=$TCLGENERIC - } - if {[my define exists tksrcdir]} { - set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir]]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir] .. generic]]] - lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC - } - lappend opts {*}[my define get config_opts] - lappend opts --prefix=$PREFIX - #--exec_prefix=$PREFIX - #if {$::tcl_platform(platform) eq "windows"} { - # lappend opts --disable-64bit - #} - if {[my define get static 1]} { - lappend opts --disable-shared --disable-stubs - # - } else { - lappend opts --enable-shared - } - return $opts - } - - method go {} { - next - my define set builddir [my BuildDir [my define get masterpath]] - } - - method linker-products {configdict} { - if {![my define get static 0]} { - return {} - } - set srcdir [my define get builddir] - if {[dict exists $configdict libfile]} { - return " [file join $srcdir [dict get $configdict libfile]]" - } - } - - method static-packages {} { - if {![my define get static 0]} { - return {} - } - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] - if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] - if {$pkg_name ne {}} { - dict set result $pkg_name initfunc $initfunc - set version [my define get version] - if {$version eq {}} { - set info [my config.sh] - set version [dict get $info version] - set pl {} - if {[dict exists $info patch_level]} { - set pl [dict get $info patch_level] - append version $pl - } - my define set version $version - } - dict set result $pkg_name version $version - dict set result $pkg_name autoload [my define get autoload 0] - } - } - foreach item [my link list subordinate] { - foreach {pkg info} [$item static-packages] { - dict set result $pkg $info - } - } - return $result - } - - method BuildDir {PWD} { - set name [my define get name] - return [my define get builddir [file join $PWD pkg.$name]] - } - - method compile {} { - set name [my define get name] - set PWD $::CWD - cd $PWD - my go - set srcroot [file normalize [my define get srcroot]] - my Collate_Source $PWD - - ### - # Build a starter VFS for both Tcl and wish - ### - set srcroot [my define get srcroot] - if {[my define get static 1]} { - puts "BUILDING Static $name $srcroot" - } else { - puts "BUILDING Dynamic $name $srcroot" - } - if {[my define get USEMSVC 0]} { - cd $srcroot - doexec nmake -f makefile.vc INSTALLDIR=[my define get installdir] release - } else { - cd $::CWD - set builddir [file normalize [my define get builddir]] - file mkdir $builddir - if {![file exists [file join $builddir Makefile]]} { - my Configure - } - if {[file exists [file join $builddir make.tcl]]} { - domake.tcl $builddir library - } else { - domake $builddir all - } - } - cd $PWD - } - - - method Configure {} { - cd $::CWD - my unpack - my TeaConfig - set builddir [file normalize [my define get builddir]] - file mkdir $builddir - set srcroot [file normalize [my define get srcroot]] - if {[my define get USEMSVC 0]} { - return - } - set opts [my ConfigureOpts] - puts [list [self] CONFIGURE] - puts [list PWD [pwd]] - puts [list LOCALSRC $srcroot] - puts [list BUILDDIR $builddir] - puts [list CONFIGURE {*}$opts] - cd $builddir - exec sh [file join $srcroot configure] {*}$opts >& [file join $builddir practcl.log] - cd $::CWD - } - - method install-vfs {} { - set PWD [pwd] - set PKGROOT [my define get installdir] - set PREFIX [my define get prefix] - - ### - # Handle teapot installs - ### - set pkg [my define get pkg_name [my define get name]] - if {[my define get teapot] ne {}} { - set TEAPOT [my define get teapot] - set found 0 - foreach ver [my define get pkg_vers [my define get version]] { - set teapath [file join $TEAPOT $pkg$ver] - if {[file exists $teapath]} { - set dest [file join $PKGROOT [string trimleft $PREFIX /] lib [file tail $teapath]] - ::practcl::copyDir $teapath $dest - return - } - } - } - my compile - if {[my define get USEMSVC 0]} { - set srcroot [my define get srcroot] - cd $srcroot - puts "[self] VFS INSTALL $PKGROOT" - doexec nmake -f makefile.vc INSTALLDIR=$PKGROOT install - } else { - set builddir [my define get builddir] - if {[file exists [file join $builddir make.tcl]]} { - # Practcl builds can inject right to where we need them - puts "[self] VFS INSTALL $PKGROOT (Practcl)" - domake.tcl $builddir install-package $PKGROOT - } elseif {[my define get broken_destroot 0] == 0} { - # Most modern TEA projects understand DESTROOT in the makefile - puts "[self] VFS INSTALL $PKGROOT (TEA)" - domake $builddir install DESTDIR=$PKGROOT - } else { - # But some require us to do an install into a fictitious filesystem - # and then extract the gooey parts within. - # (*cough*) TkImg - set PREFIX [my define get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my define get prefix_broken_destdir]] - file delete -force $BROKENROOT - file mkdir $BROKENROOT - domake $builddir $install - ::practcl::copyDir $BROKENROOT [file join $PKGROOT [string trimleft $PREFIX /]] - file delete -force $BROKENROOT - } - } - cd $PWD - } - - method TeaConfig {} { - set srcroot [file normalize [my define get srcroot]] - set copytea 0 - if {![file exists [file join $srcroot tclconfig]]} { - set copytea 1 - } else { - if {![file exists [file join $srcroot tclconfig practcl.tcl]] || ![file exists [file join $srcroot tclconfig config.tcl.in]]} { - set copytea 1 - } - } - # ensure we have tclconfig with all of the trimming - if {$copytea} { - set tclconfiginfo [::practcl::fossil_sandbox tclconfig [list sandbox [my define get sandbox]]] - ::practcl::copyDir [dict get $tclconfiginfo srcroot] [file join $srcroot tclconfig] - if {$::tcl_platform(platform) ne "windows"} { - set pwd [pwd] - cd $srcroot - # On windows there's no practical way to execute - # autoconf. We'll have to trust that configure - # us up to date - foreach template {configure.ac configure.in} { - set input [file join $srcroot $template] - if {[file exists $input]} { - puts "autoconf -f $input > [file join $srcroot configure]" - exec autoconf -f $input > [file join $srcroot configure] - } - } - cd $pwd - } - } - } -} - -oo::class create ::practcl::subproject.core { - superclass ::practcl::subproject.binary - - # On the windows platform MinGW must build - # from the platform directory in the source repo - method BuildDir {PWD} { - return [my define get localsrcdir] - } - - method Configure {} { - if {[my define get USEMSVC 0]} { - return - } - set opts [my ConfigureOpts] - puts [list PWD [pwd]] - puts [list [self] CONFIGURE] - set builddir [file normalize [my define get builddir]] - set localsrcdir [file normalize [my define get localsrcdir]] - puts [list LOCALSRC $localsrcdir] - puts [list BUILDDIR $builddir] - puts [list CONFIGURE {*}$opts] - cd $localsrcdir - exec sh [file join $localsrcdir configure] {*}$opts >& [file join $builddir practcl.log] - } - - method ConfigureOpts {} { - set opts {} - set builddir [file normalize [my define get builddir]] - set PREFIX [my define get prefix] - if {[my define get HOST] != [my define get TARGET]} { - lappend opts --host=[my define get TARGET] - } - lappend opts {*}[my define get config_opts] - lappend opts --prefix=$PREFIX - #--exec_prefix=$PREFIX - lappend opts --disable-shared - return $opts - } - - method go {} { - set name [my define get name] - set platform [my define get platform] - if {![my define exists srcroot]} { - my define set srcroot [file join [my define get sandbox] $name] - } - set srcroot [my define get srcroot] - my define add include_dir [file join $srcroot generic] - switch $platform { - windows { - my define set localsrcdir [file join $srcroot win] - my define add include_dir [file join $srcroot win] - } - default { - my define set localsrcdir [file join $srcroot unix] - my define add include_dir [file join $srcroot $name unix] - } - } - my define set builddir [my BuildDir [my define get masterpath]] - } - - method linktype {} { - return {subordinate core.library} - } -} - -package provide practcl 0.5 + ::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;" + ::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;" + } else { + ::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;" + append main_init_script \n $script + } + } + append main_init_script \n { +if {[file exists [file join $::SRCDIR packages.tcl]]} { + #In a wrapped exe, we don't go out to the environment + set dir $::SRCDIR + source [file join $::SRCDIR packages.tcl] +} +# Specify a user-specific startup file to invoke if the application +# is run interactively. Typically the startup file is "~/.apprc" +# where "app" is the name of the application. If this line is deleted +# then no user-specific startup file will be run under any conditions. + } + append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] + practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $main_init_script]);" + practcl::cputs appinit { return TCL_OK;} + $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] +} + +proc ::practcl::build::compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} { + set EXTERN_OBJS {} + set OBJECTS {} + set result {} + set builddir [$PROJECT define get builddir] + file mkdir [file join $builddir objs] + set debug [$PROJECT define get debug 0] + if {$CPPCOMPILE eq {}} { + set CPPCOMPILE $COMPILE + } + set task [${PROJECT} compile-products] + ### + # Compile the C sources + ### + foreach {ofile info} $task { + dict set task $ofile done 0 + if {[dict exists $info external] && [dict get $info external]==1} { + dict set task $ofile external 1 + } else { + dict set task $ofile external 0 + } + if {[dict exists $info library]} { + dict set task $ofile done 1 + continue + } + # Products with no cfile aren't compiled + if {![dict exists $info cfile] || [set cfile [dict get $info cfile]] eq {}} { + dict set task $ofile done 1 + continue + } + set cfile [dict get $info cfile] + set ofilename [file join $builddir objs [file tail $ofile]] + if {$debug} { + set ofilename [file join $builddir objs [file rootname [file tail $ofile]].debug.o] + } + dict set task $ofile filename $ofilename + if {[file exists $ofilename] && [file mtime $ofilename]>[file mtime $cfile]} { + lappend result $ofilename + dict set task $ofile done 1 + continue + } + if {![dict exist $info command]} { + if {[file extension $cfile] in {.c++ .cpp}} { + set cmd $CPPCOMPILE + } else { + set cmd $COMPILE + } + if {[dict exists $info extra]} { + append cmd " [dict get $info extra]" + } + append cmd " -c $cfile" + append cmd " -o $ofilename" + dict set task $ofile command $cmd + } + } + set completed 0 + while {$completed==0} { + set completed 1 + foreach {ofile info} $task { + set waiting {} + if {[dict exists $info done] && [dict get $info done]} continue + if {[dict exists $info depend]} { + foreach file [dict get $info depend] { + if {[dict exists $task $file command] && [dict exists $task $file done] && [dict get $task $file done] != 1} { + set waiting $file + break + } + } + } + if {$waiting ne {}} { + set completed 0 + puts "$ofile waiting for $waiting" + continue + } + if {[dict exists $info command]} { + set cmd [dict get $info command] + puts "$cmd" + exec {*}$cmd >&@ stdout + } + lappend result [dict get $info filename] + dict set task $ofile done 1 + } + } + return $result +} + +proc ::practcl::de_shell {data} { + set values {} + foreach flag {DEFS TCL_DEFS TK_DEFS} { + if {[dict exists $data $flag]} { + set value {} + foreach item [dict get $data $flag] { + append value " " [string map {{ } {\ }} $item] + } + dict set values $flag $value + } + } + set map {} + lappend map {${PKG_OBJECTS}} %LIBRARY_OBJECTS% + lappend map {$(PKG_OBJECTS)} %LIBRARY_OBJECTS% + lappend map {${PKG_STUB_OBJECTS}} %LIBRARY_STUB_OBJECTS% + lappend map {$(PKG_STUB_OBJECTS)} %LIBRARY_STUB_OBJECTS% + + lappend map %LIBRARY_NAME% [dict get $data name] + lappend map %LIBRARY_VERSION% [dict get $data version] + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} [dict get $data version]] + if {[dict exists $data libprefix]} { + lappend map %LIBRARY_PREFIX% [dict get $data libprefix] + } else { + lappend map %LIBRARY_PREFIX% [dict get $data prefix] + } + foreach flag [dict keys $data] { + if {$flag in {TCL_DEFS TK_DEFS DEFS}} continue + + dict set map "%${flag}%" [dict get $data $flag] + dict set map "\$\{${flag}\}" [dict get $data $flag] + dict set map "\$\(${flag}\)" [dict get $data $flag] + dict set values $flag [dict get $data $flag] + #dict set map "\$\{${flag}\}" $proj($flag) + } + set changed 1 + while {$changed} { + set changed 0 + foreach {field value} $values { + if {$field in {TCL_DEFS TK_DEFS DEFS}} continue + dict with values {} + set newval [string map $map $value] + if {$newval eq $value} continue + set changed 1 + dict set values $field $newval + } + } + return $values +} + +proc ::practcl::build::Makefile {path PROJECT} { + array set proj [$PROJECT define dump] + set path $proj(builddir) + cd $path + set includedir . + #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] + foreach include [$PROJECT generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + set INCLUDES "-I[join $includedir " -I"]" + set NAME [string toupper $proj(name)] + set result {} + set products {} + set libraries {} + set thisline {} + ::practcl::cputs result "${NAME}_DEFS = $proj(DEFS)\n" + ::practcl::cputs result "${NAME}_INCLUDES = -I\"[join $includedir "\" -I\""]\"\n" + ::practcl::cputs result "${NAME}_COMPILE = \$(CC) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" + ::practcl::cputs result "${NAME}_CPPCOMPILE = \$(CXX) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" + + foreach {ofile info} [$PROJECT compile-products] { + dict set products $ofile $info + if {[dict exists $info library]} { +lappend libraries $ofile +continue + } + if {[dict exists $info depend]} { + ::practcl::cputs result "\n${ofile}: [dict get $info depend]" + } else { + ::practcl::cputs result "\n${ofile}:" + } + set cfile [dict get $info cfile] + if {[file extension $cfile] in {.c++ .cpp}} { + set cmd "\t\$\(${NAME}_CPPCOMPILE\)" + } else { + set cmd "\t\$\(${NAME}_COMPILE\)" + } + if {[dict exists $info extra]} { + append cmd " [dict get $info extra]" + } + append cmd " -c [dict get $info cfile] -o \$@\n\t" + ::practcl::cputs result $cmd + } + + set map {} + lappend map %LIBRARY_NAME% $proj(name) + lappend map %LIBRARY_VERSION% $proj(version) + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] + lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix] + + if {[string is true [$PROJECT define get SHARED_BUILD]]} { + set outfile [$PROJECT define get libfile] + } else { + set outfile [$PROJECT shared_library] + } + $PROJECT define set shared_library $outfile + ::practcl::cputs result " +${NAME}_SHLIB = $outfile +${NAME}_OBJS = [dict keys $products] +" + + #lappend map %OUTFILE% {\[$]@} + lappend map %OUTFILE% $outfile + lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)" + ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]" + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]" + } + ::practcl::cputs result {} + if {[string is true [$PROJECT define get SHARED_BUILD]]} { + #set outfile [$PROJECT static_library] + set outfile $proj(name).a + } else { + set outfile [$PROJECT define get libfile] + } + $PROJECT define set static_library $outfile + dict set map %OUTFILE% $outfile + ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result {} + return $result +} + +### +# Produce a dynamic library +### +proc ::practcl::build::library {outfile PROJECT} { + array set proj [$PROJECT define dump] + set path $proj(builddir) + cd $path + set includedir . + #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] + if {[$PROJECT define get tk 0]} { + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]] + lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]] + lappend includedir [::practcl::file_relative $path [file normalize $proj(TK_BIN_DIR)]] + } + foreach include [$PROJECT generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + ::practcl::build::DEFS $PROJECT $proj(DEFS) name version defs + set NAME [string toupper $name] + set debug [$PROJECT define get debug 0] + set os [$PROJECT define get os] + + set INCLUDES "-I[join $includedir " -I"]" + if {$debug} { + set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ +$proj(CFLAGS_WARNING) $INCLUDES $defs" + + if {[info exists proc(CXX)]} { + set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS_DEBUG) -ggdb \ + $proj(DEFS) $proj(CFLAGS_WARNING)" + } else { + set COMPILECPP $COMPILE + } + } else { + set COMPILE "$proj(CC) $proj(CFLAGS) $defs $INCLUDES " + + if {[info exists proc(CXX)]} { + set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS) $proj(DEFS)" + } else { + set COMPILECPP $COMPILE + } + } + + set products [compile-sources $PROJECT $COMPILE $COMPILECPP] + + set map {} + lappend map %LIBRARY_NAME% $proj(name) + lappend map %LIBRARY_VERSION% $proj(version) + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] + lappend map %OUTFILE% $outfile + lappend map %LIBRARY_OBJECTS% $products + lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)" + + if {[string is true [$PROJECT define get SHARED_BUILD 1]]} { + set cmd [$PROJECT define get PRACTCL_SHARED_LIB] + append cmd " [$PROJECT define get PRACTCL_LIBS]" + set cmd [string map $map $cmd] + puts $cmd + exec {*}$cmd >&@ stdout + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] + puts $cmd + exec {*}$cmd >&@ stdout + } + } else { + set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] + puts $cmd + exec {*}$cmd >&@ stdout + } +} + +### +# Produce a static executable +### +proc ::practcl::build::static-tclsh {outfile PROJECT} { + puts " BUILDING STATIC TCLSH " + set TCLOBJ [$PROJECT project TCLCORE] + set TKOBJ [$PROJECT project TKCORE] + set ODIEOBJ [$PROJECT project odie] + + set PKG_OBJS {} + foreach item [$PROJECT link list package] { + if {[string is true [$item define get static]]} { + lappend PKG_OBJS $item + } + } + array set TCL [$TCLOBJ config.sh] + array set TK [$TKOBJ config.sh] + set path [file dirname $outfile] + cd $path + ### + # For a static Tcl shell, we need to build all local sources + # with the same DEFS flags as the tcl core was compiled with. + # The DEFS produced by a TEA extension aren't intended to operate + # with the internals of a staticly linked Tcl + ### + ::practcl::build::DEFS $PROJECT $TCL(defs) name version defs + set debug [$PROJECT define get debug 0] + set NAME [string toupper $name] + set result {} + set libraries {} + set thisline {} + set OBJECTS {} + set EXTERN_OBJS {} + foreach obj $PKG_OBJS { + $obj compile + set config($obj) [$obj config.sh] + } + set os [$PROJECT define get os] + set TCLSRCDIR [$TCLOBJ define get srcroot] + set TKSRCDIR [$TKOBJ define get srcroot] + + set includedir . + foreach include [$TCLOBJ generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]] + foreach include [$PROJECT generate-include-directory] { + set cpath [::practcl::file_relative $path [file normalize $include]] + if {$cpath ni $includedir} { + lappend includedir $cpath + } + } + + set INCLUDES "-I[join $includedir " -I"]" + if {$debug} { + set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) -ggdb \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } else { + set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } + append COMPILE " " $defs + lappend OBJECTS {*}[compile-sources $PROJECT $COMPILE $COMPILE] + + if {[${PROJECT} define get platform] eq "windows"} { + set RSOBJ [file join $path build tclkit.res.o] + set RCSRC [${PROJECT} define get kit_resource_file] + if {$RCSRC eq {} || ![file exists $RCSRC]} { + set RCSRC [file join $TKSRCDIR win rc wish.rc] + } + set cmd [list windres -o $RSOBJ -DSTATIC_BUILD] + set TCLSRC [file normalize $TCLSRCDIR] + set TKSRC [file normalize $TKSRCDIR] + + lappend cmd --include [::practcl::file_relative $path [file join $TCLSRC generic]] \ + --include [::practcl::file_relative $path [file join $TKSRC generic]] \ + --include [::practcl::file_relative $path [file join $TKSRC win]] \ + --include [::practcl::file_relative $path [file join $TKSRC win rc]] + foreach item [${PROJECT} define get resource_include] { + lappend cmd --include [::practcl::file_relative $path [file normalize $item]] + } + lappend cmd $RCSRC + doexec {*}$cmd + + lappend OBJECTS $RSOBJ + set LDFLAGS_CONSOLE {-mconsole -pipe -static-libgcc} + set LDFLAGS_WINDOW {-mwindows -pipe -static-libgcc} + } else { + set LDFLAGS_CONSOLE {} + set LDFLAGS_WINDOW {} + } + puts "***" + if {$debug} { + set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } else { + set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ +$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" + } + append cmd " $OBJECTS" + append cmd " $EXTERN_OBJS " + # On OSX it is impossibly to generate a completely static + # executable + if {[$PROJECT define get TEACUP_OS] ne "macosx"} { + append cmd " -static " + } + parray TCL + if {$debug} { + if {$os eq "windows"} { + append cmd " -L${TCL(src_dir)}/win -ltcl86g" + append cmd " -L${TK(src_dir)}/win -ltk86g" + } else { + append cmd " -L${TCL(src_dir)}/unix -ltcl86g" + append cmd " -L${TK(src_dir)}/unix -ltk86g" + } + } else { + append cmd " $TCL(build_lib_spec) $TK(build_lib_spec)" + } + foreach obj $PKG_OBJS { + append cmd " [$obj linker-products $config($obj)]" + } + append cmd " $TCL(libs) $TK(libs)" + foreach obj $PKG_OBJS { + append cmd " [$obj linker-external $config($obj)]" + } + if {$debug} { + if {$os eq "windows"} { + append cmd " -L${TCL(src_dir)}/win ${TCL(stub_lib_flag)}" + append cmd " -L${TK(src_dir)}/win ${TK(stub_lib_flag)}" + } else { + append cmd " -L${TCL(src_dir)}/unix ${TCL(stub_lib_flag)}" + append cmd " -L${TK(src_dir)}/unix ${TK(stub_lib_flag)}" + } + } else { + append cmd " $TCL(build_stub_lib_spec)" + append cmd " $TK(build_stub_lib_spec)" + } + append cmd " -o $outfile $LDFLAGS_CONSOLE" + puts "LINK: $cmd" + exec {*}$cmd >&@ stdout +} + +::oo::class create ::practcl::target_obj { + superclass ::practcl::metaclass + + constructor {name info} { + my variable define triggered domake + set triggered 0 + set domake 0 + set define(name) $name + set data [uplevel 2 [list subst $info]] + array set define $data + my select + my initialize + } + + method do {} { + my variable domake + return $domake + } + + method check {} { + my variable needs_make domake + if {$domake} { + return 1 + } + if {[info exists needs_make]} { + return $needs_make + } + set needs_make 0 + foreach item [my define get depends] { + if {![dict exists $::make_objects $item]} continue + set depobj [dict get $::make_objects $item] + if {$depobj eq [self]} { + puts "WARNING [self] depends on itself" + continue + } + if {[$depobj check]} { + set needs_make 1 + } + } + if {!$needs_make} { + set filename [my define get filename] + if {$filename ne {} && ![file exists $filename]} { + set needs_make 1 + } + } + return $needs_make + } + + method triggers {} { + my variable triggered domake define + if {$triggered} { + return $domake + } + set triggered 1 + foreach item [my define get depends] { + puts [list $item [dict exists $::make_objects $item]] + if {![dict exists $::make_objects $item]} continue + set depobj [dict get $::make_objects $item] + if {$depobj eq [self]} { + puts "WARNING [self] triggers itself" + continue + } else { + set r [$depobj check] + puts [list $depobj check $r] + if {$r} { + puts [list $depobj TRIGGER] + $depobj triggers + } + } + } + if {[info exists ::make($define(name))] && $::make($define(name))} { + return + } + set ::make($define(name)) 1 + ::practcl::trigger {*}[my define get triggers] + } +} + + +### +# Define the metaclass +### +::oo::class create ::practcl::object { + superclass ::practcl::metaclass + + constructor {parent args} { + my variable links define + set organs [$parent child organs] + my graft {*}$organs + array set define $organs + array set define [$parent child define] + array set links {} + if {[llength $args]==1 && [file exists [lindex $args 0]]} { + my InitializeSourceFile [lindex $args 0] + } elseif {[llength $args] == 1} { + set data [uplevel 1 [list subst [lindex $args 0]]] + array set define $data + my select + my initialize + } else { + array set define [uplevel 1 [list subst $args]] + my select + my initialize + } + } + + + method include_dir args { + my define add include_dir {*}$args + } + + method include_directory args { + my define add include_dir {*}$args + } + + method Collate_Source CWD {} + + + method child {method} { + return {} + } + + method InitializeSourceFile filename { + my define set filename $filename + set class {} + switch [file extension $filename] { + .tcl { + set class ::practcl::dynamic + } + .h { + set class ::practcl::cheader + } + .c { + set class ::practcl::csource + } + .ini { + switch [file tail $filename] { + module.ini { + set class ::practcl::module + } + library.ini { + set class ::practcl::subproject + } + } + } + .so - + .dll - + .dylib - + .a { + set class ::practcl::clibrary + } + } + if {$class ne {}} { + oo::objdefine [self] class $class + my initialize + } + } + + method add args { + my variable links + set object [::practcl::object new [self] {*}$args] + foreach linktype [$object linktype] { + lappend links($linktype) $object + } + return $object + } + + method go {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable links + foreach {linktype objs} [array get links] { + foreach obj $objs { + $obj go + } + } + debug [list /[self] [self method] [self class]] + } + + method code {section body} { + my variable code + ::practcl::cputs code($section) $body + } + + method Ofile filename { + set lpath [my define get localpath] + if {$lpath eq {}} { + set lpath [my define get name] + } + return ${lpath}_[file rootname [file tail $filename]].o + } + + method compile-products {} { + set filename [my define get filename] + set result {} + if {$filename ne {}} { + if {[my define exists ofile]} { + set ofile [my define get ofile] + } else { + set ofile [my Ofile $filename] + my define set ofile $ofile + } + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] + } + foreach item [my link list subordinate] { + lappend result {*}[$item compile-products] + } + return $result + } + + method generate-include-directory {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result [my define get include_dir] + foreach obj [my link list product] { + foreach path [$obj generate-include-directory] { + lappend result $path + } + } + return $result + } + + method generate-debug {{spaces {}}} { + set result {} + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" + foreach item [my link list subordinate] { + practcl::cputs result [$item generate-debug "$spaces "] + } + return $result + } + + # Empty template methods + method generate-cheader {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct cstruct methods tcltype tclprocs + set result {} + if {[info exists code(header)]} { + ::practcl::cputs result $code(header) + } + foreach obj [my link list product] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cheader */" + ::practcl::cputs result [$obj generate-cheader] + ::practcl::cputs result "/* END [$obj define get filename] generate-cheader */" + } + debug [list cfunct [info exists cfunct]] + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + if {[dict get $info public]} continue + ::practcl::cputs result "[dict get $info header]\;" + } + } + debug [list tclprocs [info exists tclprocs]] + if {[info exists tclprocs]} { + foreach {name info} $tclprocs { + if {[dict exists $info header]} { + ::practcl::cputs result "[dict get $info header]\;" + } + } + } + debug [list methods [info exists methods] [my define get cclass]] + + if {[info exists methods]} { + set thisclass [my define get cclass] + foreach {name info} $methods { + if {[dict exists $info header]} { + ::practcl::cputs result "[dict get $info header]\;" + } + } + # Add the initializer wrapper for the class + ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;" + } + return $result + } + + method generate-public-define {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code + set result {} + if {[info exists code(public-define)]} { + ::practcl::cputs result $code(public-define) + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-define] + } + return $result + } + + method generate-public-macro {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code + set result {} + if {[info exists code(public-macro)]} { + ::practcl::cputs result $code(public-macro) + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-macro] + } + return $result + } + + method generate-public-typedef {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cstruct + set result {} + if {[info exists code(public-typedef)]} { + ::practcl::cputs result $code(public-typedef) + } + if {[info exists cstruct]} { + # Add defintion for native c data structures + foreach {name info} $cstruct { + ::practcl::cputs result "typedef struct $name ${name}\;" + if {[dict exists $info aliases]} { + foreach n [dict get $info aliases] { + ::practcl::cputs result "typedef struct $name ${n}\;" + } + } + } + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-typedef] + } + return $result + } + + method generate-public-structure {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cstruct + set result {} + if {[info exists code(public-structure)]} { + ::practcl::cputs result $code(public-structure) + } + if {[info exists cstruct]} { + foreach {name info} $cstruct { + if {[dict exists $info comment]} { + ::practcl::cputs result [dict get $info comment] + } + ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" + } + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-structure] + } + return $result + } + method generate-public-headers {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code tcltype + set result {} + if {[info exists code(public-header)]} { + ::practcl::cputs result $code(public-header) + } + if {[info exists tcltype]} { + foreach {type info} $tcltype { + if {![dict exists $info cname]} { + set cname [string tolower ${type}]_tclobjtype + dict set tcltype $type cname $cname + } else { + set cname [dict get $info cname] + } + ::practcl::cputs result "extern const Tcl_ObjType $cname\;" + } + } + if {[info exists code(public)]} { + ::practcl::cputs result $code(public) + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-headers] + } + return $result + } + + method generate-stub-function {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct tcltype + set result {} + foreach mod [my link list product] { + foreach {funct def} [$mod generate-stub-function] { + dict set result $funct $def + } + } + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + if {![dict get $info export]} continue + dict set result $funcname [dict get $info header] + } + } + return $result + } + + method generate-public-function {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct tcltype + set result {} + + if {[my define get initfunc] ne {}} { + ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" + } + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + if {![dict get $info public]} continue + ::practcl::cputs result "[dict get $info header]\;" + } + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-public-function] + } + return $result + } + + method generate-public-includes {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set includes {} + foreach item [my define get public-include] { + if {$item ni $includes} { + lappend includes $item + } + } + foreach mod [my link list product] { + foreach item [$mod generate-public-includes] { + if {$item ni $includes} { + lappend includes $item + } + } + } + return $includes + } + method generate-public-verbatim {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set includes {} + foreach item [my define get public-verbatim] { + if {$item ni $includes} { + lappend includes $item + } + } + foreach mod [my link list subordinate] { + foreach item [$mod generate-public-verbatim] { + if {$item ni $includes} { + lappend includes $item + } + } + } + return $includes + } + ### + # This methods generates the contents of an amalgamated .h file + # which describes the public API of this module + ### + method generate-h {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + set includes [my generate-public-includes] + foreach inc $includes { + if {[string index $inc 0] ni {< \"}} { + ::practcl::cputs result "#include \"$inc\"" + } else { + ::practcl::cputs result "#include $inc" + } + } + foreach file [my generate-public-verbatim] { + ::practcl::cputs result "/* BEGIN $file */" + ::practcl::cputs result [::practcl::cat $file] + ::practcl::cputs result "/* END $file */" + } + foreach method { + generate-public-define + generate-public-macro + generate-public-typedef + generate-public-structure + generate-public-headers + generate-public-function + } { + ::practcl::cputs result "/* BEGIN SECTION $method */" + ::practcl::cputs result [my $method] + ::practcl::cputs result "/* END SECTION $method */" + } + return $result + } + + ### + # This methods generates the contents of an amalgamated .c file + # which implements the loader for a batch of tools + ### + method generate-c {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result { +/* This file was generated by practcl */ + } + set includes {} + lappend headers + if {[my define get tk 0]} { + lappend headers + } + lappend headers {*}[my define get include] + if {[my define get output_h] ne {}} { + lappend headers "\"[my define get output_h]\"" + } + foreach mod [my link list product] { + # Signal modules to formulate final implementation + $mod go + } + foreach mod [my link list dynamic] { + foreach inc [$mod define get include] { + if {$inc ni $headers} { + lappend headers $inc + } + } + } + foreach inc $headers { + if {[string index $inc 0] ni {< \"}} { + ::practcl::cputs result "#include \"$inc\"" + } else { + ::practcl::cputs result "#include $inc" + } + } + foreach {method} { + generate-cheader + generate-cstruct + generate-constant + generate-cfunct + generate-cmethod + } { + ::practcl::cputs result "/* BEGIN $method [my define get filename] */" + ::practcl::cputs result [my $method] + ::practcl::cputs result "/* END $method [my define get filename] */" + } + debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + return $result + } + + + method generate-loader {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + if {[my define get initfunc] eq {}} return + ::practcl::cputs result " +extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" + ::practcl::cputs result { + /* Initialise the stubs tables. */ + #ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR; + if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR; +} + if {[my define get tk 0]} { + ::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;} + } + ::practcl::cputs result { #endif} + set TCLINIT [my generate-tcl] + ::practcl::cputs result " if(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR ;" + foreach item [my link list product] { + if {[$item define get output_c] ne {}} { + ::practcl::cputs result [$item generate-cinit-external] + } else { + ::practcl::cputs result [$item generate-cinit] + } + } + if {[my define exists pkg_name]} { + ::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" + } + ::practcl::cputs result " return TCL_OK\;\n\}\n" + return $result + } + + ### + # This methods generates any Tcl script file + # which is required to pre-initialize the C library + ### + method generate-tcl {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + my variable code + if {[info exists code(tcl)]} { + ::practcl::cputs result $code(tcl) + } + set result [::practcl::_tagblock $result tcl [my define get filename]] + foreach mod [my link list product] { + ::practcl::cputs result [$mod generate-tcl] + } + return $result + } + + method static-packages {} { + set result [my define get static_packages] + set statpkg [my define get static_pkg] + set initfunc [my define get initfunc] + if {$initfunc ne {}} { + set pkg_name [my define get pkg_name] + if {$pkg_name ne {}} { + dict set result $pkg_name initfunc $initfunc + dict set result $pkg_name version [my define get version [my define get pkg_vers]] + dict set result $pkg_name autoload [my define get autoload 0] + } + } + foreach item [my link list subordinate] { + foreach {pkg info} [$item static-packages] { + dict set result $pkg $info + } + } + return $result + } + + method target {method args} { + switch $method { + is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] } + } + } + +} + +::oo::class create ::practcl::product { + superclass ::practcl::object + + method linktype {} { + return {subordinate product} + } + + method include header { + my define add include $header + } + + method cstructure {name definition {argdat {}}} { + my variable cstruct + dict set cstruct $name body $definition + foreach {f v} $argdat { + dict set cstruct $name $f $v + } + } + + method generate-cinit {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code + set result {} + if {[info exists code(cinit)]} { + ::practcl::cputs result $code(cinit) + } + if {[my define get initfunc] ne {}} { + ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach obj [my link list product] { + ::practcl::cputs result [$obj generate-cinit] + } + return $result + } +} + +### +# Dynamic blocks do not generate their own .c files, +# instead the contribute to the amalgamation +# of the main library file +### +::oo::class create ::practcl::dynamic { + superclass ::practcl::product + + # Retrieve any additional source files required + + method compile-products {} { + set filename [my define get output_c] + set result {} + if {$filename ne {}} { + if {[my define exists ofile]} { + set ofile [my define get ofile] + } else { + set ofile [my Ofile $filename] + my define set ofile $ofile + } + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + } else { + set filename [my define get cfile] + if {$filename ne {}} { + if {[my define exists ofile]} { + set ofile [my define get ofile] + } else { + set ofile [my Ofile $filename] + my define set ofile $ofile + } + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + } + } + foreach item [my link list subordinate] { + lappend result {*}[$item compile-products] + } + return $result + } + + method implement path { + my go + my Collate_Source $path + if {[my define get output_c] eq {}} return + set filename [file join $path [my define get output_c]] + my define set cfile $filename + set fout [open $filename w] + puts $fout [my generate-c] + puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" + puts $fout [my generate-cinit] + if {[my define get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" + } + puts $fout " return TCL_OK\;" + puts $fout "\x7D" + close $fout + } + + method initialize {} { + set filename [my define get filename] + if {$filename eq {}} { + return + } + if {[my define get name] eq {}} { + my define set name [file tail [file rootname $filename]] + } + if {[my define get localpath] eq {}} { + my define set localpath [my define get localpath]_[my define get name] + } + ::source $filename + } + + method linktype {} { + return {subordinate product dynamic} + } + + ### + # Populate const static data structures + ### + method generate-cstruct {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cstruct methods tcltype + set result {} + if {[info exists code(struct)]} { + ::practcl::cputs result $code(struct) + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result [$obj generate-cstruct] + } + return $result + } + + method generate-constant {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + my variable code cstruct methods tcltype + if {[info exists code(constant)]} { + ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result $code(constant) + } + if {[info exists cstruct]} { + foreach {name info} $cstruct { + set map {} + lappend map @NAME@ $name + lappend map @MACRO@ GET[string toupper $name] + + if {[dict exists $info deleteproc]} { + lappend map @DELETEPROC@ [dict get $info deleteproc] + } else { + lappend map @DELETEPROC@ NULL + } + if {[dict exists $info cloneproc]} { + lappend map @CLONEPROC@ [dict get $info cloneproc] + } else { + lappend map @CLONEPROC@ NULL + } + ::practcl::cputs result [string map $map { +const static Tcl_ObjectMetadataType @NAME@DataType = { + TCL_OO_METADATA_VERSION_CURRENT, + "@NAME@", + @DELETEPROC@, + @CLONEPROC@ +}; +#define @MACRO@(OBJCONTEXT) (@NAME@ *) Tcl_ObjectGetMetadata(OBJCONTEXT,&@NAME@DataType) +}] + } + } + if {[info exists tcltype]} { + foreach {type info} $tcltype { + dict with info {} + ::practcl::cputs result "const Tcl_ObjType $cname = \{\n .freeIntRepProc = &${freeproc},\n .dupIntRepProc = &${dupproc},\n .updateStringProc = &${updatestringproc},\n .setFromAnyProc = &${setfromanyproc}\n\}\;" + } + } + + if {[info exists methods]} { + set mtypes {} + foreach {name info} $methods { + set callproc [dict get $info callproc] + set methodtype [dict get $info methodtype] + if {$methodtype in $mtypes} continue + lappend mtypes $methodtype + ### + # Build the data struct for this method + ### + ::practcl::cputs result "const static Tcl_MethodType $methodtype = \{" + ::practcl::cputs result " .version = TCL_OO_METADATA_VERSION_CURRENT,\n .name = \"$name\",\n .callProc = $callproc," + if {[dict exists $info deleteproc]} { + set deleteproc [dict get $info deleteproc] + } else { + set deleteproc NULL + } + if {$deleteproc ni { {} NULL }} { + ::practcl::cputs result " .deleteProc = $deleteproc," + } else { + ::practcl::cputs result " .deleteProc = NULL," + } + if {[dict exists $info cloneproc]} { + set cloneproc [dict get $info cloneproc] + } else { + set cloneproc NULL + } + if {$cloneproc ni { {} NULL }} { + ::practcl::cputs result " .cloneProc = $cloneproc\n\}\;" + } else { + ::practcl::cputs result " .cloneProc = NULL\n\}\;" + } + dict set methods $name methodtype $methodtype + } + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result [$obj generate-constant] + } + return $result + } + + ### + # Generate code that provides subroutines called by + # Tcl API methods + ### + method generate-cfunct {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code cfunct + set result {} + if {[info exists code(funct)]} { + ::practcl::cputs result $code(funct) + } + if {[info exists cfunct]} { + foreach {funcname info} $cfunct { + ::practcl::cputs result "[dict get $info header]\{[dict get $info body]\}\;" + } + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} { + continue + } + ::practcl::cputs result [$obj generate-cfunct] + } + return $result + } + + ### + # Generate code that provides implements Tcl API + # calls + ### + method generate-cmethod {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + my variable code methods tclprocs + set result {} + if {[info exists code(method)]} { + ::practcl::cputs result $code(method) + } + + if {[info exists tclprocs]} { + foreach {name info} $tclprocs { + if {![dict exists $info body]} continue + set callproc [dict get $info callproc] + set header [dict get $info header] + set body [dict get $info body] + ::practcl::cputs result "${header} \{${body}\}" + } + } + + + if {[info exists methods]} { + set thisclass [my define get cclass] + foreach {name info} $methods { + if {![dict exists $info body]} continue + set callproc [dict get $info callproc] + set header [dict get $info header] + set body [dict get $info body] + ::practcl::cputs result "${header} \{${body}\}" + } + # Build the OO_Init function + ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{" + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my define get class]] { + /* + ** Build the "@TCLCLASS@" class + */ + Tcl_Obj* nameObj; /* Name of a class or method being looked up */ + Tcl_Object curClassObject; /* Tcl_Object representing the current class */ + Tcl_Class curClass; /* Tcl_Class representing the current class */ + + /* + * Find the "@TCLCLASS@" class, and attach an 'init' method to it. + */ + + nameObj = Tcl_NewStringObj("@TCLCLASS@", -1); + Tcl_IncrRefCount(nameObj); + if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { + Tcl_DecrRefCount(nameObj); + return TCL_ERROR; + } + Tcl_DecrRefCount(nameObj); + curClass = Tcl_GetObjectAsClass(curClassObject); +}] + if {[dict exists $methods constructor]} { + set mtype [dict get $methods constructor methodtype] + ::practcl::cputs result [string map [list @MTYPE@ $mtype] { + /* Attach the constructor to the class */ + Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &@MTYPE@, NULL)); + }] + } + foreach {name info} $methods { + dict with info {} + if {$name in {constructor destructor}} continue + ::practcl::cputs result [string map [list @NAME@ $name @MTYPE@ $methodtype] { + nameObj=Tcl_NewStringObj("@NAME@",-1); + Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); + Tcl_DecrRefCount(nameObj); +}] + if {[dict exists $info aliases]} { + foreach alias [dict get $info aliases] { + if {[dict exists $methods $alias]} continue + ::practcl::cputs result [string map [list @NAME@ $alias @MTYPE@ $methodtype] { + nameObj=Tcl_NewStringObj("@NAME@",-1); + Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); + Tcl_DecrRefCount(nameObj); +}] + } + } + } + ::practcl::cputs result " return TCL_OK\;\n\}\n" + } + foreach obj [my link list dynamic] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} continue + ::practcl::cputs result [$obj generate-cmethod] + } + return $result + } + + method generate-cinit-external {} { + if {[my define get initfunc] eq {}} { + return "/* [my define get filename] declared not initfunc */" + } + return " if([my define get initfunc](interp)) return TCL_ERROR\;" + } + + ### + # Generate code that runs when the package/module is + # initialized into the interpreter + ### + method generate-cinit {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result {} + my variable code methods tclprocs + if {[info exists code(nspace)]} { + ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" + foreach nspace $code(nspace) { + ::practcl::cputs result [string map [list @NSPACE@ $nspace] { + modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); + if(!modPtr) { + modPtr = Tcl_CreateNamespace(interp, "@NSPACE@", NULL, NULL); + } +}] + } + ::practcl::cputs result " \}" + } + if {[info exists code(tclinit)]} { + ::practcl::cputs result $code(tclinit) + } + if {[info exists code(cinit)]} { + ::practcl::cputs result $code(cinit) + } + if {[info exists code(initfuncts)]} { + foreach func $code(initfuncts) { + ::practcl::cputs result " if (${func}(interp) != TCL_OK) return TCL_ERROR\;" + } + } + if {[info exists tclprocs]} { + foreach {name info} $tclprocs { + set map [list @NAME@ $name @CALLPROC@ [dict get $info callproc]] + ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] + if {[dict exists $info aliases]} { + foreach alias [dict get $info aliases] { + set map [list @NAME@ $alias @CALLPROC@ [dict get $info callproc]] + ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] + } + } + } + } + + if {[info exists code(nspace)]} { + ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" + foreach nspace $code(nspace) { + ::practcl::cputs result [string map [list @NSPACE@ $nspace] { + modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); + Tcl_CreateEnsemble(interp, modPtr->fullName, modPtr, TCL_ENSEMBLE_PREFIX); + Tcl_Export(interp, modPtr, "[a-z]*", 1); +}] + } + ::practcl::cputs result " \}" + } + set result [::practcl::_tagblock $result c [my define get filename]] + foreach obj [my link list product] { + # Exclude products that will generate their own C files + if {[$obj define get output_c] ne {}} { + ::practcl::cputs result [$obj generate-cinit-external] + } else { + ::practcl::cputs result [$obj generate-cinit] + } + } + return $result + } + + method c_header body { + my variable code + ::practcl::cputs code(header) $body + } + + method c_code body { + my variable code + ::practcl::cputs code(funct) $body + } + method c_function {header body} { + my variable code cfunct + foreach regexp { + {(.*) ([a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} + {(.*) (\x2a[a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} + } { + if {[regexp $regexp $header all keywords funcname arglist]} { + dict set cfunct $funcname header $header + dict set cfunct $funcname body $body + dict set cfunct $funcname keywords $keywords + dict set cfunct $funcname arglist $arglist + dict set cfunct $funcname public [expr {"static" ni $keywords}] + dict set cfunct $funcname export [expr {"STUB_EXPORT" in $keywords}] + + return + } + } + ::practcl::cputs code(header) "$header\;" + # Could not parse that block as a function + # append it verbatim to our c_implementation + ::practcl::cputs code(funct) "$header [list $body]" + } + + + method cmethod {name body {arginfo {}}} { + my variable methods code + foreach {f v} $arginfo { + dict set methods $name $f $v + } + dict set methods $name body "Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ +$body" + } + + method c_tclproc_nspace nspace { + my variable code + if {![info exists code(nspace)]} { + set code(nspace) {} + } + if {$nspace ni $code(nspace)} { + lappend code(nspace) $nspace + } + } + + method c_tclproc_raw {name body {arginfo {}}} { + my variable tclprocs code + + foreach {f v} $arginfo { + dict set tclprocs $name $f $v + } + dict set tclprocs $name body $body + } + + method go {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + next + my variable methods code cstruct tclprocs + if {[info exists methods]} { + debug [self] methods [my define get cclass] + set thisclass [my define get cclass] + foreach {name info} $methods { + # Provide a callproc + if {![dict exists $info callproc]} { + set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]] + dict set methods $name callproc $callproc + } else { + set callproc [dict get $info callproc] + } + if {[dict exists $info body] && ![dict exists $info header]} { + dict set methods $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)" + } + if {![dict exists $info methodtype]} { + set methodtype [string map {{ } _ : _} MethodType_${thisclass}_${name}] + dict set methods $name methodtype $methodtype + } + } + if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { + lappend code(initfuncts) "${thisclass}_OO_Init" + } + } + set thisnspace [my define get nspace] + + if {[info exists tclprocs]} { + debug [self] tclprocs [dict keys $tclprocs] + foreach {name info} $tclprocs { + if {![dict exists $info callproc]} { + set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} Tclcmd_${thisnspace}_${name}]] + dict set tclprocs $name callproc $callproc + } else { + set callproc [dict get $info callproc] + } + if {[dict exists $info body] && ![dict exists $info header]} { + dict set tclprocs $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv\[\])" + } + } + } + debug [list /[self] [self method] [self class]] + } + + # Once an object marks itself as some + # flavor of dynamic, stop trying to morph + # it into something else + method select {} {} + + + method tcltype {name argdat} { + my variable tcltype + foreach {f v} $argdat { + dict set tcltype $name $f $v + } + if {![dict exists tcltype $name cname]} { + dict set tcltype $name cname [string tolower $name]_tclobjtype + } + lappend map @NAME@ $name + set info [dict get $tcltype $name] + foreach {f v} $info { + lappend map @[string toupper $f]@ $v + } + foreach {func fpat template} { + freeproc {@Name@Obj_freeIntRepProc} {void @FNAME@(Tcl_Obj *objPtr)} + dupproc {@Name@Obj_dupIntRepProc} {void @FNAME@(Tcl_Obj *srcPtr,Tcl_Obj *dupPtr)} + updatestringproc {@Name@Obj_updateStringRepProc} {void @FNAME@(Tcl_Obj *objPtr)} + setfromanyproc {@Name@Obj_setFromAnyProc} {int @FNAME@(Tcl_Interp *interp,Tcl_Obj *objPtr)} + } { + if {![dict exists $info $func]} { + error "$name does not define $func" + } + set body [dict get $info $func] + # We were given a function name to call + if {[llength $body] eq 1} continue + set fname [string map [list @Name@ [string totitle $name]] $fpat] + my c_function [string map [list @FNAME@ $fname] $template] [string map $map $body] + dict set tcltype $name $func $fname + } + } +} + +::oo::class create ::practcl::cheader { + superclass ::practcl::product + + method compile-products {} {} + method generate-cinit {} {} +} + +::oo::class create ::practcl::csource { + superclass ::practcl::product +} + +::oo::class create ::practcl::clibrary { + superclass ::practcl::product + + method linker-products {configdict} { + return [my define get filename] + } + +} + +### +# In the end, all C code must be loaded into a module +# This will either be a dynamically loaded library implementing +# a tcl extension, or a compiled in segment of a custom shell/app +### +::oo::class create ::practcl::module { + superclass ::practcl::dynamic + + method child which { + switch $which { + organs { + return [list project [my define get project] module [self]] + } + } + } + + method initialize {} { + set filename [my define get filename] + if {$filename eq {}} { + return + } + if {[my define get name] eq {}} { + my define set name [file tail [file dirname $filename]] + } + if {[my define get localpath] eq {}} { + my define set localpath [my define get name]_[my define get name] + } + debug [self] SOURCE $filename + my source $filename + } + + method implement path { + my go + my Collate_Source $path + foreach item [my link list dynamic] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + foreach item [my link list module] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set filename [my define get output_c] + if {$filename eq {}} { + debug [list /[self] [self method] [self class]] + return + } + set cout [open [file join $path [file rootname $filename].c] w] + puts $cout [subst {/* +** This file is generated by the [info script] script +** any changes will be overwritten the next time it is run +*/}] + puts $cout [my generate-c] + puts $cout [my generate-loader] + close $cout + debug [list /[self] [self method] [self class]] + } + + method linktype {} { + return {subordinate product dynamic module} + } +} + +::oo::class create ::practcl::autoconf { + + ### + # find or fake a key/value list describing this project + ### + method config.sh {} { + my variable conf_result + if {[info exists conf_result]} { + return $conf_result + } + set result {} + set name [my define get name] + set PWD $::CWD + set builddir [my define get builddir] + my unpack + set srcroot [my define get srcroot] + if {![file exists $builddir]} { + my Configure + } + set filename [file join $builddir config.tcl] + # Project uses the practcl template. Use the leavings from autoconf + if {[file exists $filename]} { + set dat [::practcl::config.tcl $builddir] + foreach {item value} [lsort -stride 2 -dictionary $dat] { + dict set result $item $value + } + set conf_result $result + return $result + } + set filename [file join $builddir ${name}Config.sh] + if {[file exists $filename]} { + set l [expr {[string length $name]+1}] + foreach {field dat} [::practcl::read_Config.sh $filename] { + set field [string tolower $field] + if {[string match ${name}_* $field]} { + set field [string range $field $l end] + } + dict set result $field $dat + } + set conf_result $result + return $result + } + ### + # Oh man... we have to guess + ### + set filename [file join $builddir Makefile] + if {![file exists $filename]} { + error "Could not locate any configuration data in $srcroot" + } + foreach {field dat} [::practcl::read_Makefile $filename] { + dict set result $field $dat + } + set conf_result $result + cd $PWD + return $result + } +} + + +::oo::class create ::practcl::project { + superclass ::practcl::module ::practcl::autoconf + + constructor args { + my variable define + if {[llength $args] == 1} { + if {[catch {uplevel 1 [list subst [lindex $args 0]]} contents]} { + set contents [lindex $args 0] + } + } else { + if {[catch {uplevel 1 [list subst $args]} contents]} { + set contents $args + } + } + array set define $contents + my select + my initialize + } + + + method add_project {pkg info {oodefine {}}} { + set os [my define get os] + if {$os eq {}} { + set os [::practcl::os] + my define set os $os + } + set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] + if {[dict exists $info os] && ($os ni [dict get $info os])} return + # Select which tag to use here. + # For production builds: tag-release + if {[::info exists ::env(FOSSIL_MIRROR)]} { + dict set info localmirror $::env(FOSSIL_MIRROR) + } + set profile [my define get profile release]: + if {[dict exists $info profile $profile]} { + dict set info tag [dict get $info profile $profile] + } + set obj [namespace current]::PROJECT.$pkg + if {[info command $obj] eq {}} { + set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]] + } + my link object $obj + oo::objdefine $obj $oodefine + $obj define set masterpath $::CWD + $obj go + return $obj + } + + method child which { + switch $which { + organs { + # A library can be a project, it can be a module. Any + # subordinate modules will indicate their existance + return [list project [self] module [self]] + } + } + } + + method linktype {} { + return project + } + + # Exercise the methods of a sub-object + method project {pkg args} { + set obj [namespace current]::PROJECT.$pkg + if {[llength $args]==0} { + return $obj + } + tailcall ${obj} {*}$args + } +} + +::oo::class create ::practcl::library { + superclass ::practcl::project + + method compile-products {} { + set result {} + foreach item [my link list subordinate] { + lappend result {*}[$item compile-products] + } + set filename [my define get output_c] + if {$filename ne {}} { + set ofile [file rootname [file tail $filename]]_main.o + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + } + return $result + } + + method generate-tcl-loader {} { + set result {} + set PKGINIT [my define get pkginit] + set PKG_NAME [my define get name [my define get pkg_name]] + set PKG_VERSION [my define get pkg_vers [my define get version]] + if {[string is true [my define get SHARED_BUILD 0]]} { + set LIBFILE [my define get libfile] + ::practcl::cputs result [string map \ + [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { +# Shared Library Style +load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ +package provide @PKG_NAME@ @PKG_VERSION@ +}] + } else { + ::practcl::cputs result [string map \ + [list @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { +# Tclkit Style +load {} @PKGINIT@ +package provide @PKG_NAME@ @PKG_VERSION@ +}] + } + return $result + } + + method go {} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set name [my define getnull name] + if {$name eq {}} { + set name generic + my define name generic + } + if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { + my define set tk 0 + } + set output_c [my define getnull output_c] + if {$output_c eq {}} { + set output_c [file rootname $name].c + my define set output_c $output_c + } + set output_h [my define getnull output_h] + if {$output_h eq {}} { + set output_h [file rootname $output_c].h + my define set output_h $output_h + } + set output_tcl [my define getnull output_tcl] + #if {$output_tcl eq {}} { + # set output_tcl [file rootname $output_c].tcl + # my define set output_tcl $output_tcl + #} + #set output_mk [my define getnull output_mk] + #if {$output_mk eq {}} { + # set output_mk [file rootname $output_c].mk + # my define set output_mk $output_mk + #} + set initfunc [my define getnull initfunc] + if {$initfunc eq {}} { + set initfunc [string totitle $name]_Init + my define set initfunc $initfunc + } + set output_decls [my define getnull output_decls] + if {$output_decls eq {}} { + set output_decls [file rootname $output_c].decls + my define set output_decls $output_decls + } + my variable links + foreach {linktype objs} [array get links] { + foreach obj $objs { + $obj go + } + } + debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + } + + method implement path { + my go + my Collate_Source $path + foreach item [my link list dynamic] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + foreach item [my link list module] { + if {[catch {$item implement $path} err]} { + puts "Skipped $item: $err" + } + } + set cout [open [file join $path [my define get output_c]] w] + puts $cout [subst {/* +** This file is generated by the [info script] script +** any changes will be overwritten the next time it is run +*/}] + puts $cout [my generate-c] + puts $cout [my generate-loader] + close $cout + + set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H + set hout [open [file join $path [my define get output_h]] w] + puts $hout [subst {/* +** This file is generated by the [info script] script +** any changes will be overwritten the next time it is run +*/}] + puts $hout "#ifndef ${macro}" + puts $hout "#define ${macro}" + puts $hout [my generate-h] + puts $hout "#endif" + close $hout + + set output_tcl [my define get output_tcl] + if {$output_tcl ne {}} { + set tclout [open [file join $path [my define get output_tcl]] w] + puts $tclout "### +# This file is generated by the [info script] script +# any changes will be overwritten the next time it is run +###" + puts $tclout [my generate-tcl] + puts $tclout [my generate-tcl-loader] + close $tclout + } + } + + method generate-decls {pkgname path} { + debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set outfile [file join $path/$pkgname.decls] + + ### + # Build the decls file + ### + set fout [open $outfile w] + puts $fout [subst {### + # $outfile + # + # This file was generated by [info script] + ### + + library $pkgname + interface $pkgname + }] + + ### + # Generate list of functions + ### + set stubfuncts [my generate-stub-function] + set thisline {} + set functcount 0 + foreach {func header} $stubfuncts { + puts $fout [list declare [incr functcount] $header] + } + puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"] + puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] + + close $fout + + ### + # Build [package]Decls.h + ### + set hout [open [file join $path ${pkgname}Decls.h] w] + + close $hout + + set cout [open [file join $path ${pkgname}StubInit.c] w] +puts $cout [string map [list %pkgname% $pkgname %PkgName% [string totitle $pkgname]] { +#ifndef USE_TCL_STUBS +#define USE_TCL_STUBS +#endif +#undef USE_TCL_STUB_PROCS + +#include "tcl.h" +#include "%pkgname%.h" + + /* + ** Ensure that Tdom_InitStubs is built as an exported symbol. The other stub + ** functions should be built as non-exported symbols. + */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +%PkgName%Stubs *%pkgname%StubsPtr; + + /* + **---------------------------------------------------------------------- + ** + ** %PkgName%_InitStubs -- + ** + ** Checks that the correct version of %PkgName% is loaded and that it + ** supports stubs. It then initialises the stub table pointers. + ** + ** Results: + ** The actual version of %PkgName% that satisfies the request, or + ** NULL to indicate that an error occurred. + ** + ** Side effects: + ** Sets the stub table pointers. + ** + **---------------------------------------------------------------------- + */ + +char * +%PkgName%_InitStubs (Tcl_Interp *interp, char *version, int exact) +{ + char *actualVersion; + actualVersion = Tcl_PkgRequireEx(interp, "%pkgname%", version, exact,(ClientData *) &%pkgname%StubsPtr); + if (!actualVersion) { + return NULL; + } + if (!%pkgname%StubsPtr) { + Tcl_SetResult(interp,"This implementation of %PkgName% does not support stubs",TCL_STATIC); + return NULL; + } + return actualVersion; +} +}] + close $cout + } + + # Backward compadible call + method generate-make path { + ::practcl::build::Makefile $path [self] + } + + method install-headers {} { + set result {} + return $result + } + + method linktype {} { + return library + } + + # Create a "package ifneeded" + # Args are a list of aliases for which this package will answer to + method package-ifneeded {args} { + set result {} + set name [my define get pkg_name [my define get name]] + set version [my define get pkg_vers [my define get version]] + if {$version eq {}} { + set version 0.1a + } + set output_tcl [my define get output_tcl] + if {$output_tcl ne {}} { + set script "\[list source \[file join \$dir $output_tcl\]\]" + } elseif {[string is true -strict [my define get SHARED_BUILD]]} { + set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" + } else { + # Provide a null passthrough + set script [list package provide $name $version] + } + set result "package ifneeded [list $name] [list $version] $script" + foreach alias $args { + set script "package require $name $version \; package provide $alias $version" + append result \n\n [list package ifneeded $alias $version $script] + } + return $result + } + + + method shared_library {} { + set name [string tolower [my define get name [my define get pkg_name]]] + set NAME [string toupper $name] + set version [my define get version [my define get pkg_vers]] + set map {} + lappend map %LIBRARY_NAME% $name + lappend map %LIBRARY_VERSION% $version + lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] + lappend map %LIBRARY_PREFIX% [my define getnull libprefix] + set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] + return $outfile + } +} + +::oo::class create ::practcl::tclkit { + superclass ::practcl::library + + method Collate_Source CWD { + my define set SHARED_BUILD 0 + set name [my define get name] + + if {![my define exists TCL_LOCAL_APPINIT]} { + my define set TCL_LOCAL_APPINIT Tclkit_AppInit + } + if {![my define exists TCL_LOCAL_MAIN_HOOK]} { + my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + } + + set PROJECT [self] + set os [$PROJECT define get os] + set TCLOBJ [$PROJECT project TCLCORE] + set TKOBJ [$PROJECT project TKCORE] + set ODIEOBJ [$PROJECT project odie] + + set TCLSRCDIR [$TCLOBJ define get srcroot] + set TKSRCDIR [$TKOBJ define get srcroot] + set PKG_OBJS {} + foreach item [$PROJECT link list package] { + if {[string is true [$item define get static]]} { + lappend PKG_OBJS $item + } + } + # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK + if {$os eq "windows"} { + set PLATFORM_SRC_DIR win + my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 + my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 + my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] + } else { + set PLATFORM_SRC_DIR unix + my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] + } + ### + # Add local static Zlib implementation + ### + set cdir [file join $TCLSRCDIR compat zlib] + foreach file { + adler32.c compress.c crc32.c + deflate.c infback.c inffast.c + inflate.c inftrees.c trees.c + uncompr.c zutil.c + } { + my add [file join $cdir $file] + } + + ### + # Pre 8.7, Tcl doesn't include a Zipfs implementation + # in the core. Grab the one from odielib + ### + set zipfs [file join $TCLSRCDIR generic zvfs.c] + if {![file exists $zipfs]} { + # The Odie project maintains a mirror of the version + # released with the Tcl core + my add_project odie { + tag trunk + class subproject + vfsinstall 0 + } + my project odie unpack + set ODIESRCROOT [my project odie define get srcroot] + set cdir [file join $ODIESRCROOT compat zipfs] + my define add include_dir $cdir + set zipfs [file join $cdir zvfs.c] + } + + my add class csource filename $zipfs initfunc Tclzipfs_Init pkg_name zipfs pkg_vers 1.0 autoload 1 + + my define add include_dir [file join $TKSRCDIR generic] + my define add include_dir [file join $TKSRCDIR $PLATFORM_SRC_DIR] + my define add include_dir [file join $TKSRCDIR bitmaps] + my define add include_dir [file join $TKSRCDIR xlib] + my define add include_dir [file join $TCLSRCDIR generic] + my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my define add include_dir [file join $TCLSRCDIR compat zlib] + # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK + ::practcl::build::tclkit_main $PROJECT $PKG_OBJS + } + + ## Wrap an executable + # + method wrap {PWD exename vfspath args} { + cd $PWD + if {![file exists $vfspath]} { + file mkdir $vfspath + } + foreach item [my link list core.library] { + set name [$item define get name] + set libsrcroot [$item define get srcroot] + if {[file exists [file join $libsrcroot library]]} { + ::practcl::copyDir [file join $libsrcroot library] [file join $vfspath boot $name] + } + } + if {[my define get installdir] ne {}} { + ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] + } + foreach arg $args { + ::practcl::copyDir $arg $vfspath + } + + set fout [open [file join $vfspath packages.tcl] w] + puts $fout { + set ::PKGIDXFILE [info script] + set dir [file dirname $::PKGIDXFILE] + } + #set BASEVFS [my define get BASEVFS] + set EXEEXT [my define get EXEEXT] + + set tclkit_bare [my define get tclkit_bare] + + set buffer [::practcl::pkgindex_path $vfspath] + puts $fout $buffer + puts $fout { + # Advertise statically linked packages + foreach {pkg script} [array get ::kitpkg] { + eval $script + } + } + close $fout + package require zipfile::mkzip + ::zipfile::mkzip::mkzip ${exename}${EXEEXT} -runtime $tclkit_bare -directory $vfspath + if { [my define get platform] ne "windows" } { + file attributes ${exename}${EXEEXT} -permissions a+x + } + } +} + +### +# Meta repository +# The default is an inert source code block +### +oo::class create ::practcl::subproject { + superclass ::practcl::object + + method compile {} {} + + method go {} { + set platform [my define get platform] + my define get USEMSVC [my define get USEMSVC] + set name [my define get name] + if {![my define exists srcroot]} { + my define set srcroot [file join [my define get sandbox] $name] + } + set srcroot [my define get srcroot] + my define set localsrcdir $srcroot + my define add include_dir [file join $srcroot generic] + my sources + } + + # Install project into the local build system + method install-local {} { + my unpack + } + + # Install project into the virtual file system + method install-vfs {} {} + + method linktype {} { + return {subordinate package} + } + + method linker-products {configdict} {} + + method linker-external {configdict} { + if {[dict exists $configdict PRACTCL_LIBS]} { + return [dict get $configdict PRACTCL_LIBS] + } + } + + method sources {} {} + + method unpack {} { + set name [my define get name] + puts [list $name [self] UNPACK] + my define set [::practcl::fossil_sandbox $name [my define dump]] + } + + method update {} { + set name [my define get name] + my define set [::practcl::fossil_sandbox $name [dict merge [my define dump] {update 1}]] + } +} + +### +# A project which the kit compiles and integrates +# the source for itself +### +oo::class create ::practcl::subproject.source { + superclass ::practcl::subproject ::practcl::library + + method linktype {} { + return {subordinate package source} + } + +} + +# a copy from the teapot +oo::class create ::practcl::subproject.teapot { + superclass ::practcl::subproject + + method install-local {} { + my install-vfs + } + + method install-vfs {} { + set pkg [my define get pkg_name [my define get name]] + set download [my define get download] + my unpack + set DEST [my define get installdir] + set prefix [string trimleft [my define get prefix] /] + # Get tcllib from our destination + set dir [file join $DEST $prefix lib tcllib] + source [file join $DEST $prefix lib tcllib pkgIndex.tcl] + package require zipfile::decode + ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] + } +} + +oo::class create ::practcl::subproject.sak { + superclass ::practcl::subproject + + method install-local {} { + my install-vfs + } + + method install-vfs {} { + ### + # Handle teapot installs + ### + set pkg [my define get pkg_name [my define get name]] + my unpack + set DEST [my define get installdir] + set prefix [string trimleft [my define get prefix] /] + set srcroot [my define get srcroot] + ::dotclexec [file join $srcroot installer.tcl] \ + -pkg-path [file join $DEST $prefix lib $pkg] \ + -no-examples -no-html -no-nroff \ + -no-wait -no-gui -no-apps + } +} + +### +# A binary package +### +oo::class create ::practcl::subproject.binary { + superclass ::practcl::subproject ::practcl::autoconf + + + method compile-products {} {} + + method ConfigureOpts {} { + set opts {} + set builddir [my define get builddir] + if {[my define get broken_destroot 0]} { + set PREFIX [my define get prefix_broken_destdir] + } else { + set PREFIX [my define get prefix] + } + if {[my define get HOST] != [my define get TARGET]} { + lappend opts --host=[my define get TARGET] + } + if {[my define exists tclsrcdir]} { + set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir]]]] + set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir] .. generic]]] + lappend opts --with-tcl=$TCLSRCDIR --with-tclinclude=$TCLGENERIC + } + if {[my define exists tksrcdir]} { + set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir]]]] + set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir] .. generic]]] + lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC + } + lappend opts {*}[my define get config_opts] + lappend opts --prefix=$PREFIX + #--exec_prefix=$PREFIX + #if {$::tcl_platform(platform) eq "windows"} { + # lappend opts --disable-64bit + #} + if {[my define get static 1]} { + lappend opts --disable-shared --disable-stubs + # + } else { + lappend opts --enable-shared + } + return $opts + } + + method go {} { + next + my define set builddir [my BuildDir [my define get masterpath]] + } + + method linker-products {configdict} { + if {![my define get static 0]} { + return {} + } + set srcdir [my define get builddir] + if {[dict exists $configdict libfile]} { + return " [file join $srcdir [dict get $configdict libfile]]" + } + } + + method static-packages {} { + if {![my define get static 0]} { + return {} + } + set result [my define get static_packages] + set statpkg [my define get static_pkg] + set initfunc [my define get initfunc] + if {$initfunc ne {}} { + set pkg_name [my define get pkg_name] + if {$pkg_name ne {}} { + dict set result $pkg_name initfunc $initfunc + set version [my define get version] + if {$version eq {}} { + set info [my config.sh] + set version [dict get $info version] + set pl {} + if {[dict exists $info patch_level]} { + set pl [dict get $info patch_level] + append version $pl + } + my define set version $version + } + dict set result $pkg_name version $version + dict set result $pkg_name autoload [my define get autoload 0] + } + } + foreach item [my link list subordinate] { + foreach {pkg info} [$item static-packages] { + dict set result $pkg $info + } + } + return $result + } + + method BuildDir {PWD} { + set name [my define get name] + return [my define get builddir [file join $PWD pkg.$name]] + } + + method compile {} { + set name [my define get name] + set PWD $::CWD + cd $PWD + my go + set srcroot [file normalize [my define get srcroot]] + my Collate_Source $PWD + + ### + # Build a starter VFS for both Tcl and wish + ### + set srcroot [my define get srcroot] + if {[my define get static 1]} { + puts "BUILDING Static $name $srcroot" + } else { + puts "BUILDING Dynamic $name $srcroot" + } + if {[my define get USEMSVC 0]} { + cd $srcroot + doexec nmake -f makefile.vc INSTALLDIR=[my define get installdir] release + } else { + cd $::CWD + set builddir [file normalize [my define get builddir]] + file mkdir $builddir + if {![file exists [file join $builddir Makefile]]} { + my Configure + } + if {[file exists [file join $builddir make.tcl]]} { + domake.tcl $builddir library + } else { + domake $builddir all + } + } + cd $PWD + } + + + method Configure {} { + cd $::CWD + my unpack + my TeaConfig + set builddir [file normalize [my define get builddir]] + file mkdir $builddir + set srcroot [file normalize [my define get srcroot]] + if {[my define get USEMSVC 0]} { + return + } + set opts [my ConfigureOpts] + puts [list [self] CONFIGURE] + puts [list PWD [pwd]] + puts [list LOCALSRC $srcroot] + puts [list BUILDDIR $builddir] + puts [list CONFIGURE {*}$opts] + cd $builddir + exec sh [file join $srcroot configure] {*}$opts >& [file join $builddir practcl.log] + cd $::CWD + } + + method install-vfs {} { + set PWD [pwd] + set PKGROOT [my define get installdir] + set PREFIX [my define get prefix] + + ### + # Handle teapot installs + ### + set pkg [my define get pkg_name [my define get name]] + if {[my define get teapot] ne {}} { + set TEAPOT [my define get teapot] + set found 0 + foreach ver [my define get pkg_vers [my define get version]] { + set teapath [file join $TEAPOT $pkg$ver] + if {[file exists $teapath]} { + set dest [file join $PKGROOT [string trimleft $PREFIX /] lib [file tail $teapath]] + ::practcl::copyDir $teapath $dest + return + } + } + } + my compile + if {[my define get USEMSVC 0]} { + set srcroot [my define get srcroot] + cd $srcroot + puts "[self] VFS INSTALL $PKGROOT" + doexec nmake -f makefile.vc INSTALLDIR=$PKGROOT install + } else { + set builddir [my define get builddir] + if {[file exists [file join $builddir make.tcl]]} { + # Practcl builds can inject right to where we need them + puts "[self] VFS INSTALL $PKGROOT (Practcl)" + domake.tcl $builddir install-package $PKGROOT + } elseif {[my define get broken_destroot 0] == 0} { + # Most modern TEA projects understand DESTROOT in the makefile + puts "[self] VFS INSTALL $PKGROOT (TEA)" + domake $builddir install DESTDIR=$PKGROOT + } else { + # But some require us to do an install into a fictitious filesystem + # and then extract the gooey parts within. + # (*cough*) TkImg + set PREFIX [my define get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my define get prefix_broken_destdir]] + file delete -force $BROKENROOT + file mkdir $BROKENROOT + domake $builddir $install + ::practcl::copyDir $BROKENROOT [file join $PKGROOT [string trimleft $PREFIX /]] + file delete -force $BROKENROOT + } + } + cd $PWD + } + + method TeaConfig {} { + set srcroot [file normalize [my define get srcroot]] + set copytea 0 + if {![file exists [file join $srcroot tclconfig]]} { + set copytea 1 + } else { + if {![file exists [file join $srcroot tclconfig practcl.tcl]] || ![file exists [file join $srcroot tclconfig config.tcl.in]]} { + set copytea 1 + } + } + # ensure we have tclconfig with all of the trimming + if {$copytea} { + set tclconfiginfo [::practcl::fossil_sandbox tclconfig [list sandbox [my define get sandbox]]] + ::practcl::copyDir [dict get $tclconfiginfo srcroot] [file join $srcroot tclconfig] + if {$::tcl_platform(platform) ne "windows"} { + set pwd [pwd] + cd $srcroot + # On windows there's no practical way to execute + # autoconf. We'll have to trust that configure + # us up to date + foreach template {configure.ac configure.in} { + set input [file join $srcroot $template] + if {[file exists $input]} { + puts "autoconf -f $input > [file join $srcroot configure]" + exec autoconf -f $input > [file join $srcroot configure] + } + } + cd $pwd + } + } + } +} + +oo::class create ::practcl::subproject.core { + superclass ::practcl::subproject.binary + + # On the windows platform MinGW must build + # from the platform directory in the source repo + method BuildDir {PWD} { + return [my define get localsrcdir] + } + + method Configure {} { + if {[my define get USEMSVC 0]} { + return + } + set opts [my ConfigureOpts] + puts [list PWD [pwd]] + puts [list [self] CONFIGURE] + set builddir [file normalize [my define get builddir]] + set localsrcdir [file normalize [my define get localsrcdir]] + puts [list LOCALSRC $localsrcdir] + puts [list BUILDDIR $builddir] + puts [list CONFIGURE {*}$opts] + cd $localsrcdir + exec sh [file join $localsrcdir configure] {*}$opts >& [file join $builddir practcl.log] + } + + method ConfigureOpts {} { + set opts {} + set builddir [file normalize [my define get builddir]] + set PREFIX [my define get prefix] + if {[my define get HOST] != [my define get TARGET]} { + lappend opts --host=[my define get TARGET] + } + lappend opts {*}[my define get config_opts] + lappend opts --prefix=$PREFIX + #--exec_prefix=$PREFIX + lappend opts --disable-shared + return $opts + } + + method go {} { + set name [my define get name] + set platform [my define get platform] + if {![my define exists srcroot]} { + my define set srcroot [file join [my define get sandbox] $name] + } + set srcroot [my define get srcroot] + my define add include_dir [file join $srcroot generic] + switch $platform { + windows { + my define set localsrcdir [file join $srcroot win] + my define add include_dir [file join $srcroot win] + } + default { + my define set localsrcdir [file join $srcroot unix] + my define add include_dir [file join $srcroot $name unix] + } + } + my define set builddir [my BuildDir [my define get masterpath]] + } + + method linktype {} { + return {subordinate core.library} + } +} + +package provide practcl 0.5 -- cgit v0.12 From 5bf83d86b6b6d8581410139efdc0312b88b99831 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 14 Sep 2016 15:04:41 +0000 Subject: Further adaptations and improvements to practcl. And get, tclsh make.tcl basekit even works now --- library/practcl/practcl.tcl | 62 +++++++++++++++++++++++++++------------------ 1 file changed, 38 insertions(+), 24 deletions(-) diff --git a/library/practcl/practcl.tcl b/library/practcl/practcl.tcl index f285116..77d1181 100644 --- a/library/practcl/practcl.tcl +++ b/library/practcl/practcl.tcl @@ -1121,11 +1121,16 @@ proc ::practcl::build::DEFS {PROJECT DEFS namevar versionvar defsvar} { set field [string range $item 0 [expr {$eqidx-1}]] set value [string range $item [expr {$eqidx+1}] end] set emap {} - lappend emap \x5c \x5c\x5c \x20 \x5c\x20 \x22 \x5c\x22 \x28 \x5c\x28 \x29 \x5c\x29 - if {[string is integer -strict $value]} { - append defs " -D${field}=$value" + # On Windows we need to do some munging of escape characters + if {[practcl::os]=="windows"} { + lappend emap \x5c \x5c\x5c \x20 \x5c\x20 \x22 \x5c\x22 \x28 \x5c\x28 \x29 \x5c\x29 + if {[string is integer -strict $value]} { + append defs " -D${field}=$value" + } else { + append defs " -D${field}=[string map $emap $value]" + } } else { - append defs " -D${field}=[string map $emap $value]" + append defs " -D${field}=$value" } set idx $ndx } @@ -1229,13 +1234,18 @@ if {[file exists {%vfs_tk_library%}]} { CONST char *archive; Tcl_FindExecutable(*argv[0]); archive=Tcl_GetNameOfExecutable(); - +} + if {![$PROJECT define get CORE_ZIPFS 0]} { + ::practcl::cputs zvfsboot { + /* + ** We have to initialize the virtual filesystem before calling + ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find + ** its startup script files. + */ Tclzipfs_Init(NULL); +} + $PROJECT include {"tclZipfs.h"} } - # We have to initialize the virtual filesystem before calling - # Tcl_Init(). Otherwise, Tcl_Init() will not be able to find - # its startup script files. - $PROJECT include {"tclZipfs.h"} ::practcl::cputs zvfsboot " if(!TclZipfsMount(NULL, archive, \"%vfsroot%\", NULL)) \x7B " ::practcl::cputs zvfsboot { @@ -1656,6 +1666,7 @@ proc ::practcl::build::static-tclsh {outfile PROJECT} { # with the internals of a staticly linked Tcl ### ::practcl::build::DEFS $PROJECT $TCL(defs) name version defs + set debug [$PROJECT define get debug 0] set NAME [string toupper $name] set result {} @@ -3481,27 +3492,30 @@ char * set PLATFORM_SRC_DIR unix my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] } - ### - # Add local static Zlib implementation - ### - set cdir [file join $TCLSRCDIR compat zlib] - foreach file { - adler32.c compress.c crc32.c - deflate.c infback.c inffast.c - inflate.c inftrees.c trees.c - uncompr.c zutil.c - } { - my add [file join $cdir $file] - } ### # Pre 8.7, Tcl doesn't include a Zipfs implementation # in the core. Grab the one from odielib ### - set zipfs [file join $TCLSRCDIR generic zvfs.c] - if {![file exists $zipfs]} { + set zipfs [file join $TCLSRCDIR generic tclZipfs.c] + if {[file exists $zipfs]} { + my define set CORE_ZIPFS 1 + } else { + ### + # Add local static Zlib implementation + ### + set cdir [file join $TCLSRCDIR compat zlib] + foreach file { + adler32.c compress.c crc32.c + deflate.c infback.c inffast.c + inflate.c inftrees.c trees.c + uncompr.c zutil.c + } { + my add [file join $cdir $file] + } # The Odie project maintains a mirror of the version # released with the Tcl core + my define set CORE_ZIPFS 0 my add_project odie { tag trunk class subproject @@ -3512,9 +3526,9 @@ char * set cdir [file join $ODIESRCROOT compat zipfs] my define add include_dir $cdir set zipfs [file join $cdir zvfs.c] + my add class csource filename $zipfs initfunc Tclzipfs_Init pkg_name zipfs pkg_vers 1.0 autoload 1 } - my add class csource filename $zipfs initfunc Tclzipfs_Init pkg_name zipfs pkg_vers 1.0 autoload 1 my define add include_dir [file join $TKSRCDIR generic] my define add include_dir [file join $TKSRCDIR $PLATFORM_SRC_DIR] -- cgit v0.12 From a4dbdda70039562e22ccf70611cf68cfe09f41c1 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 14 Sep 2016 15:11:12 +0000 Subject: Adding build scripts to implement Tip#453 --- pkgs/make.tcl | 165 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ pkgs/packages.tcl | 92 ++++++++++++++++++++++++++++++ 2 files changed, 257 insertions(+) create mode 100644 pkgs/make.tcl create mode 100644 pkgs/packages.tcl diff --git a/pkgs/make.tcl b/pkgs/make.tcl new file mode 100644 index 0000000..94a4050 --- /dev/null +++ b/pkgs/make.tcl @@ -0,0 +1,165 @@ +### +# This file contains instructions for how to build the Odielib library +# It will produce the following files in whatever directory it was called from: +# +# * odielibc.mk - A Makefile snippet needed to compile the odielib sources +# * odielibc.c - A C file which acts as the loader for odielibc +# * logicset.c/h - A c +# * (several .c and .h files) - C sources that are generated on the fly by automation +### +# Ad a "just in case" version or practcl we ship locally + +set ::CWD [pwd] +set ::project(builddir) $::CWD +set ::project(srcdir) [file dirname [file dirname [file normalize [info script]]]] +set ::project(sandbox) [file dirname $::project(srcdir)] +set ::project(download) [file join $::project(sandbox) download] +set ::project(teapot) [file join $::project(sandbox) teapot] +source [file join $::CWD .. library practcl practcl.tcl] +array set ::project [::practcl::config.tcl $CWD] + +set SRCPATH $::project(srcdir) +set SANDBOX $::project(sandbox) +file mkdir $CWD/build + +::practcl::target implement { + triggers {} +} +::practcl::target tcltk { + depends deps + triggers {script-packages script-pkgindex} +} +::practcl::target basekit { + depends {deps tcltk} + triggers {} + filename [file join $CWD tclkit_bare$::project(EXEEXT)] +} +::practcl::target packages { + depends {deps tcltk} +} +::practcl::target distclean {} +::practcl::target example { + depends basekit +} + +switch [lindex $argv 0] { + autoconf - + pre - + deps { + ::practcl::trigger implement + } + os { + puts "OS: [practcl::os]" + parray ::project + exit 0 + } + wrap { + ::practcl::depends basekit + } + all { + # Auto detect missing bits + foreach {item obj} $::make_objects { + if {[$obj check]} { + $obj trigger + } + } + } + package { + ::practcl::trigger packages + } + default { + ::practcl::trigger {*}$argv + } +} + +parray make + +set ::CWD [pwd] +::practcl::tclkit create BASEKIT {} +BASEKIT define set name tclkit +BASEKIT define set pkg_name tclkit +BASEKIT define set pkg_version 8.7.0a +BASEKIT define set localpath tclkit +BASEKIT define set profile devel +BASEKIT source [file join $::CWD packages.tcl] + +if {$make(distclean)} { + # Clean all source code back to it's pristine state from fossil + foreach item [BASEKIT link list package] { + $item go + set projdir [$item define get localsrcdir] + if {$projdir ne {} && [file exists $projdir]} { + fossil $projdir clean -force + } + } +} + +file mkdir [file join $CWD build] + +if {$make(tcltk)} { + ### + # Download our required packages + ### + set tcl_config_opts {} + set tk_config_opts {} + switch [::practcl::os] { + windows { + #lappend tcl_config_opts --disable-stubs + } + linux { + lappend tk_config_opts --enable-xft=no --enable-xss=no + } + macosx { + lappend tcl_config_opts --enable-corefoundation=yes --enable-framework=no + lappend tk_config_opts --enable-aqua=yes + } + } + lappend tcl_config_opts --with-tzdata --prefix [BASEKIT define get prefix] + BASEKIT project TCLCORE define set config_opts $tcl_config_opts + BASEKIT project TCLCORE go + set _TclSrcDir [BASEKIT project TCLCORE define get localsrcdir] + BASEKIT define set tclsrcdir $_TclSrcDir + lappend tk_config_opts --with-tcl=$_TclSrcDir + BASEKIT project TKCORE define set config_opts $tk_config_opts + BASEKIT project TCLCORE compile + BASEKIT project TKCORE compile +} + +if {$make(basekit)} { + BASEKIT implement $CWD + ::practcl::build::static-tclsh $target(basekit) BASEKIT +} + +if {[lindex $argv 0] eq "package"} { + #set result {} + foreach item [lrange $argv 1 end] { + set obj [BASEKIT project $item] + puts [list build $item [$obj define get static] [info object class $obj]] + if {[string is true [$obj define get static]]} { + $obj compile + } + if {[string is true [$obj define get vfsinstall]]} { + $obj install-vfs + } + } + #puts "RESULT: $result" +} elseif {$make(packages)} { + foreach item [BASEKIT link list package] { + if {[string is true [$item define get static]]} { + $item compile + } + if {[string is true [$item define get vfsinstall]]} { + $item install-vfs + } + } +} + + +if {$make(example)} { + file mkdir [file join $CWD example.vfs] + BASEKIT wrap $CWD example example.vfs +} + +if {[lindex $argv 0] eq "wrap"} { + BASEKIT wrap $CWD {*}[lrange $argv 1 end] +} diff --git a/pkgs/packages.tcl b/pkgs/packages.tcl new file mode 100644 index 0000000..2a84971 --- /dev/null +++ b/pkgs/packages.tcl @@ -0,0 +1,92 @@ +### +# This script implements a basic TclTkit with statically linked +# Tk, sqlite, threads, udp, and mmtk (which includes canvas3d and tkhtml) +### + +set CWD [pwd] + +my define set [array get ::project] +set os [::practcl::os] +my define set os $os +puts [list BASEKIT SANDBOX $::project(sandbox)] +my define set platform $::project(TEA_PLATFORM) +my define set prefix /zvfs +my define set sandbox [file normalize $::project(sandbox)] +my define set installdir [file join $::project(sandbox) pkg] +my define set teapot [file join $::project(sandbox) teapot] +my define set USEMSVC [info exists env(VisualStudioVersion)] +my define set prefix_broken_destdir [file join $::project(sandbox) tmp] +my define set HOST $os +my define set TARGET $os +my define set tclkit_bare [file join $CWD tclkit_bare$::project(EXEEXT)] + +my define set name tclkit +my define set output_c tclkit.c +my define set libs {} + +my add_project TCLCORE { + class subproject.core + name tcl + tag release + static 1 +} +my project TCLCORE define set srcdir [file dirname $::project(sandbox)] + +my add_project TKCORE { + class subproject.core + name tk + tag release + static 1 + autoload 0 + pkg_name Tk + initfunc Tk_Init +} + +my add_project tclconfig { + profile { + release: 3dfb97da548fae506374ac0015352ac0921d0cc9 + devel: practcl + } + class subproject + preload 1 + vfsinstall 0 +} + +my add_project thread { + profile { + release: 2a36d0a6c31569bfb3562e3d58e9e8204f447a7e + devel: practcl + } + class subproject.binary + pkg_name Thread + autoload 1 + initfunc Thread_Init + static 1 +} + +my add_project sqlite { + profile { + release: 40ffdfb26af3e7443b2912e1039c06bf9ed75846 + devel: practcl + } + class subproject.binary + pkg_name sqlite3 + autoload 1 + initfunc Sqlite3_Init + static 1 + vfsinstall 0 +} + +my add_project udp { + profile { + release: 7c396e1a767db57b07b48daa8e0cfc0ea622bbe9 + devel: practcl + } + class subproject.binary + static 1 + autoload 1 + initfunc Udp_Init + pkg_name udp + vfsinstall 0 +} + -- cgit v0.12 From e58a9dabbe2ced71aab80cdcb05f5db244dccd94 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sun, 2 Oct 2016 18:30:43 +0000 Subject: Typo fix for Makefile.in --- unix/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index ca15312..0a138ed 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -464,7 +464,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclVar.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclZlib.c \ - $(GENERIC_DIR)/zipfs.c + $(GENERIC_DIR)/tclZipfs.c OO_SRCS = \ $(GENERIC_DIR)/tclOO.c \ -- cgit v0.12 From 9dfe53af4ac9a368f01fd80c5c67fbe842d387df Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sun, 2 Oct 2016 18:42:56 +0000 Subject: Re-created the build mods for tip#340. Something I was doing was screwing with building a proper shell --- win/Makefile.in | 20 +++-------- win/makefile.vc | 8 ++--- win/tclkit.exe.manifest.in | 51 ---------------------------- win/tclkit.rc | 82 ---------------------------------------------- 4 files changed, 6 insertions(+), 155 deletions(-) delete mode 100644 win/tclkit.exe.manifest.in delete mode 100644 win/tclkit.rc diff --git a/win/Makefile.in b/win/Makefile.in index 7e371c8..b6533a4 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -152,7 +152,6 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} -TCLKIT = tclkit$(VER)${EXESUFFIX} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -303,8 +302,8 @@ GENERIC_OBJS = \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ - tclZlib.$(OBJEXT) \ - tclZipfs.$(OBJEXT) + tclZipfs.$(OBJEXT) \ + tclZlib.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -400,8 +399,6 @@ STUB_OBJS = \ TCLSH_OBJS = tclAppInit.$(OBJEXT) -TCLKIT_OBJS = tclkitMain.${OBJEXT} tclkit.${OBJEXT} - ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ @@ -423,7 +420,7 @@ all: binaries libraries doc packages tcltest: $(TCLSH) $(TEST_DLL_FILE) -binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) $(TCLKIT) +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} @@ -436,11 +433,6 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -$(TCLKIT): $(TCLKIT_OBJ) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLKIT_OBJ) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - @VC_MANIFEST_EMBED_EXE@ - cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -504,9 +496,6 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) -tclkitMain.${OBJEXT}: tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_LOCAL_MAIN_HOOK="Tclkit_MainHook" -DTCL_LOCAL_APPINIT="Tclkit_AppInit" @DEPARG@ $(CC_OBJNAME) - # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -647,7 +636,6 @@ install-libraries: libraries install-tzdata install-msgs @echo "Installing header files"; @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ - "$(GENERIC_DIR)/tclZipfs.h" \ "$(GENERIC_DIR)/tclPlatDecls.h" \ "$(GENERIC_DIR)/tclTomMath.h" \ "$(GENERIC_DIR)/tclTomMathDecls.h"; \ @@ -762,7 +750,7 @@ clean: cleanhelp clean-packages distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - tcl.hpj config.status.lineno tclsh.exe.manifest + tcl.hpj config.status.lineno # # Bundled package targets diff --git a/win/makefile.vc b/win/makefile.vc index d360e67..dd7b061 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -344,8 +344,8 @@ COREOBJS = \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ - $(TMP_DIR)\tclZlib.obj \ - $(TMP_DIR)\tclZipfs.obj + $(TMP_DIR)\tclZipfs.obj \ + $(TMP_DIR)\tclZlib.obj ZLIBOBJS = \ $(TMP_DIR)\adler32.obj \ @@ -945,9 +945,6 @@ $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? -$(TMP_DIR)\zipfs.obj: $(GENERICDIR)\zipfs.c - $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? - $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ @@ -1121,7 +1118,6 @@ install-libraries: tclConfig install-msgs install-tzdata @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tclZipfs.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" diff --git a/win/tclkit.exe.manifest.in b/win/tclkit.exe.manifest.in deleted file mode 100644 index 13c1d24..0000000 --- a/win/tclkit.exe.manifest.in +++ /dev/null @@ -1,51 +0,0 @@ - - - - Tcl self-contained executable (tclkit) - - - - - - - - - - - - - - - - - - - - - - true - - - - - - - - diff --git a/win/tclkit.rc b/win/tclkit.rc deleted file mode 100644 index ebe37e1..0000000 --- a/win/tclkit.rc +++ /dev/null @@ -1,82 +0,0 @@ -// -// Version Resource Script -// - -#include -#include - -// -// build-up the name suffix that defines the type of build this is. -// -#if TCL_THREADS -#define SUFFIX_THREADS "t" -#else -#define SUFFIX_THREADS "" -#endif - -#if STATIC_BUILD -#define SUFFIX_STATIC "s" -#else -#define SUFFIX_STATIC "" -#endif - -#if DEBUG && !UNCHECKED -#define SUFFIX_DEBUG "g" -#else -#define SUFFIX_DEBUG "" -#endif - -#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG - - -LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ - -VS_VERSION_INFO VERSIONINFO - FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL - PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL - FILEFLAGSMASK 0x3fL -#ifdef DEBUG - FILEFLAGS VS_FF_DEBUG -#else - FILEFLAGS 0x0L -#endif - FILEOS VOS__WINDOWS32 - FILETYPE VFT_APP - FILESUBTYPE 0x0L -BEGIN - BLOCK "StringFileInfo" - BEGIN - BLOCK "040904b0" - BEGIN - VALUE "FileDescription", "Tclkit Application\0" - VALUE "OriginalFilename", "tclkit" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" - VALUE "CompanyName", "ActiveState Corporation\0" - VALUE "FileVersion", TCL_PATCH_LEVEL - VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0" - VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" - VALUE "ProductVersion", TCL_PATCH_LEVEL - END - END - BLOCK "VarFileInfo" - BEGIN - VALUE "Translation", 0x409, 1200 - END -END - -// -// Icon -// - -tclsh ICON DISCARDABLE "tclsh.ico" - -// -// This is needed for Windows 8.1 onwards. -// - -#ifndef RT_MANIFEST -#define RT_MANIFEST 24 -#endif -#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID -#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 -#endif -CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclkit.exe.manifest" -- cgit v0.12 From d0002e5394b792fd71045acc4a43ef1c500009ee Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Oct 2016 16:36:42 +0000 Subject: New routine Tcl_HasStringRep() and first conversion of callers. --- generic/tcl.decls | 3 +++ generic/tclBasic.c | 14 ++++++++------ generic/tclDecls.h | 5 +++++ generic/tclInt.h | 12 ++++++++++++ generic/tclObj.c | 19 +++++++++++++++++++ generic/tclStubInit.c | 1 + 6 files changed, 48 insertions(+), 6 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 953102b..d435fe4 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2341,6 +2341,9 @@ declare 634 { void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr) } +declare 635 { + int Tcl_HasStringRep(Tcl_Obj *objPtr) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9de8d1d..e17a831 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5791,7 +5791,7 @@ TclArgumentGet( * up by the caller. It knows better than us. */ - if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) { + if (!TclHasStringRep(obj) || TclListObjIsCanonical(obj)) { return; } @@ -7413,14 +7413,16 @@ ExprAbsFunc( if (l > (long)0) { goto unChanged; } else if (l == (long)0) { - const char *string = objv[1]->bytes; - if (string) { - while (*string != '0') { - if (*string == '-') { + if (TclHasStringRep(objv[1])) { + int numBytes; + const char *bytes = TclGetStringFromObj(objv[1], &numBytes); + + while (numBytes) { + if (*bytes == '-') { Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; } - string++; + bytes++; numBytes--; } } goto unChanged; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ed1e326..71598ab 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1828,6 +1828,8 @@ EXTERN Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr, EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); +/* 635 */ +EXTERN int Tcl_HasStringRep(Tcl_Obj *objPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2498,6 +2500,7 @@ typedef struct TclStubs { char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 632 */ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 633 */ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 634 */ + int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 635 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3798,6 +3801,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FetchIntRep) /* 633 */ #define Tcl_StoreIntRep \ (tclStubsPtr->tcl_StoreIntRep) /* 634 */ +#define Tcl_HasStringRep \ + (tclStubsPtr->tcl_HasStringRep) /* 635 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 6796949..89d9f32 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4295,6 +4295,18 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, /* *---------------------------------------------------------------- + * Macro used by the Tcl core to test whether an object has a + * string representation (or is a 'pure' internal value). + * The ANSI C "prototype" for this macro is: + * + * MODULE_SCOPE int TclHasStringRep(Tcl_Obj *objPtr); + *---------------------------------------------------------------- + */ + +#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL) + +/* + *---------------------------------------------------------------- * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C * "prototype" for this macro is: diff --git a/generic/tclObj.c b/generic/tclObj.c index 368ba52..387f92b 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1810,6 +1810,25 @@ Tcl_InvalidateStringRep( /* *---------------------------------------------------------------------- * + * Tcl_HasStringRep -- + * + * This function reports whether object has a string representation. + * + * Results: + * Boolean. + *---------------------------------------------------------------------- + */ + +int +Tcl_HasStringRep( + Tcl_Obj *objPtr) /* Object to test */ +{ + return TclHasStringRep(objPtr); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_StoreIntRep -- * * This function is called to set the object's internal diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 2af47b7..c5c8e80 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1419,6 +1419,7 @@ const TclStubs tclStubs = { Tcl_InitStringRep, /* 632 */ Tcl_FetchIntRep, /* 633 */ Tcl_StoreIntRep, /* 634 */ + Tcl_HasStringRep, /* 635 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12 From 7b2a90493f10dc61b00ab07a3057b23b4b2dc7d2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Oct 2016 19:04:44 +0000 Subject: Use the new purity test. --- generic/tclCmdMZ.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3b81cbe..9398e47 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1876,7 +1876,8 @@ StringMapCmd( * inconsistencies (see test string-10.20.1 for illustration why!) */ - if (Tcl_FetchIntRep(objv[objc-2], &tclDictType) && objv[objc-2]->bytes == NULL){ + if (!TclHasStringRep(objv[objc-2]) + && Tcl_FetchIntRep(objv[objc-2], &tclDictType)){ int i, done; Tcl_DictSearch search; -- cgit v0.12 From ec7df3f449d90d7fd7a81b27d7b6264f13596629 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Oct 2016 21:06:04 +0000 Subject: Purge more direct accesses to bytes field. --- generic/tclCompExpr.c | 8 +++++--- generic/tclDisassemble.c | 4 +--- generic/tclEncoding.c | 2 +- generic/tclListObj.c | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 83bb883..7ad39f9 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2476,11 +2476,13 @@ CompileExprTree( * already, then use it to share via the literal table. */ - if (objPtr->bytes) { + if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; + int numBytes; + const char *bytes + = Tcl_GetStringFromObj(objPtr, &numBytes); - index = TclRegisterLiteral(envPtr, objPtr->bytes, - objPtr->length, 0); + index = TclRegisterLiteral(envPtr, bytes, numBytes, 0); tableValue = TclFetchLiteral(envPtr, index); if ((tableValue->typePtr == NULL) && (objPtr->typePtr != NULL)) { diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 92e5c2e..a727413 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -815,9 +815,7 @@ TclNewInstNameObj( { Tcl_Obj *objPtr = Tcl_NewObj(); - /* Optimized Tcl_InvalidateStringRep */ - objPtr->bytes = NULL; - + TclInvalidateStringRep(objPtr); InstNameSetIntRep(objPtr, (long) inst); return objPtr; diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 5db6859..6beb10c 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -370,7 +370,7 @@ DupEncodingIntRep( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - Tcl_Encoding encoding = Tcl_GetEncoding(NULL, srcPtr->bytes); + Tcl_Encoding encoding = Tcl_GetEncoding(NULL, TclGetString(srcPtr)); EncodingSetIntRep(dupPtr, encoding); } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 0b6473b..e2e0f63 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1877,7 +1877,7 @@ SetListFromAny( * describe duplicate keys). */ - if (Tcl_FetchIntRep(objPtr, &tclDictType) && !objPtr->bytes) { + if (!TclHasStringRep(objPtr) && Tcl_FetchIntRep(objPtr, &tclDictType)) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done, size; -- cgit v0.12 From 46cdee3dc8c8d96cb6a47aa9060de398693d9783 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 11 Oct 2016 18:22:08 +0000 Subject: Update new tests in light of octal death. --- tests/get.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/get.test b/tests/get.test index 7aa06c1..c82b7e5 100644 --- a/tests/get.test +++ b/tests/get.test @@ -102,13 +102,13 @@ test get-3.3 {tcl_GetInt with iffy numbers} testgetint { catch {testgetint 44 $x} x set x } -} {44 44 44 44 54 52 52 46} +} {44 44 44 44 54 54 52 46} test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } -} {0.0 0.0 0.0 0.0 0.0 {expected floating-point number but got "09" (looks like invalid octal number)} {expected floating-point number but got "- 0"} 0.0 10.0 2.0} +} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} # cleanup ::tcltest::cleanupTests -- cgit v0.12 From e97fab49d3893f5cc7879b765cc345bf32349096 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Oct 2016 15:14:51 +0000 Subject: Purge another direct access to bytes field. --- generic/tclUtil.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 57604f8..b2749c3 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1976,7 +1976,7 @@ Tcl_ConcatObj( resPtr = NULL; for (i = 0; i < objc; i++) { objPtr = objv[i]; - if (objPtr->bytes && objPtr->length == 0) { + if (!TclListObjIsCanonical(objPtr)) { continue; } if (resPtr) { -- cgit v0.12 From aec96db0167170b47c7f0dd132fd530354aa4ac7 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Oct 2016 16:58:20 +0000 Subject: Reduce direct use of the tclEmptyStringRep. --- generic/tclPathObj.c | 3 +-- generic/tclUtil.c | 6 +++--- unix/tclUnixSock.c | 15 +++++++++------ 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index ce371bd..fcf4dee 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2608,8 +2608,7 @@ UpdateStringOfFsPath( pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; - copy->bytes = tclEmptyStringRep; - copy->length = 0; + TclInitStringRep(copy, NULL, 0); TclDecrRefCount(copy); } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index b2749c3..c726174 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1383,9 +1383,9 @@ TclConvertElement( */ if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) { - src = tclEmptyStringRep; - length = 0; - conversion = CONVERT_BRACE; + p[0] = '{'; + p[1] = '}'; + return 2; } /* diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 5d11a28..44825fc 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -239,9 +239,6 @@ InitializeHostName( native = u.nodename; } } - if (native == NULL) { - native = tclEmptyStringRep; - } #else /* !NO_UNAME */ /* * Uname doesn't exist; try gethostname instead. @@ -270,9 +267,15 @@ InitializeHostName( #endif /* NO_UNAME */ *encodingPtr = Tcl_GetEncoding(NULL, NULL); - *lengthPtr = strlen(native); - *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1); + if (native) { + *lengthPtr = strlen(native); + *valuePtr = ckalloc((*lengthPtr) + 1); + memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1); + } else { + *lengthPtr = 0; + *valuePtr = ckalloc(1); + *valuePtr[0] = '\0'; + } } /* -- cgit v0.12 From 9fde0d3e5ad6558c526c51a8dc07fae6835cf30d Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Oct 2016 17:31:48 +0000 Subject: Correct improper NULL return from initializing Tcl_InitStringRep(o, b, 0). Go ahead and return pointer to space where 0 bytes can be written. --- generic/tclObj.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 387f92b..412ecfc 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1766,8 +1766,7 @@ Tcl_InitStringRep( objPtr->length = (int) numBytes; } } else { - objPtr->bytes = tclEmptyStringRep; - return NULL; + TclInitStringRep(objPtr, NULL, 0); } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ -- cgit v0.12 From 6b83d829a89a6bd022138f88ff25afca45fdeb2c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Dec 2016 11:20:52 +0000 Subject: More internal use of size_t. Eliminate unused "isBin" argument from TclpSysAlloc() --- generic/tcl.h | 22 +++++----- generic/tclAlloc.c | 8 ++-- generic/tclBasic.c | 4 +- generic/tclCompile.h | 4 +- generic/tclDictObj.c | 24 +++++----- generic/tclEnsemble.c | 62 +++++++++++++------------- generic/tclExecute.c | 2 +- generic/tclHash.c | 47 ++++++++++---------- generic/tclIndexObj.c | 20 +++++---- generic/tclInt.decls | 6 +-- generic/tclInt.h | 30 ++++++------- generic/tclIntDecls.h | 8 ++-- generic/tclLiteral.c | 106 +++++++++++++++++++++++---------------------- generic/tclNamesp.c | 17 ++++---- generic/tclOO.h | 4 +- generic/tclObj.c | 2 +- generic/tclProc.c | 2 +- generic/tclStringObj.c | 18 +++++--- generic/tclTest.c | 2 +- generic/tclThreadAlloc.c | 8 ++-- generic/tclThreadStorage.c | 4 +- generic/tclVar.c | 2 +- unix/tclUnixPort.h | 4 +- unix/tclUnixThrd.c | 2 +- win/tclWinPort.h | 2 +- win/tclWinThrd.c | 2 +- 26 files changed, 211 insertions(+), 201 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 3d571a6..c488c20 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -960,10 +960,8 @@ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ - void *hash; /* Hash value, stored as pointer to ensure - * that the offsets of the fields in this - * structure are not changed. */ - ClientData clientData; /* Application stores something here with + size_t hash; /* Hash value. */ + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1051,16 +1049,16 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ + size_t mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ - int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the @@ -1081,7 +1079,7 @@ struct Tcl_HashTable { typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - int nextIndex; /* Index of next bucket to be enumerated after + size_t nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ @@ -1099,9 +1097,9 @@ typedef struct Tcl_HashSearch { * TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the * pointer is stored in the entry. * - * While maintaining binary compatability the above have to be distinct values + * While maintaining binary compatibility the above have to be distinct values * as they are used to differentiate between old versions of the hash table - * which don't have a typePtr and new ones which do. Once binary compatability + * which don't have a typePtr and new ones which do. Once binary compatibility * is discarded in favour of making more wide spread changes TCL_STRING_KEYS * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is @@ -2348,7 +2346,7 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ #define Tcl_GetHashValue(h) ((h)->clientData) -#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value)) +#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value)) #define Tcl_GetHashKey(tablePtr, h) \ ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index cda1f38..3319c06 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -274,8 +274,8 @@ TclpAlloc( if (numBytes >= MAXMALLOC - OVERHEAD) { if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) { - bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) - (sizeof(struct block) + OVERHEAD + numBytes), 0); + bigBlockPtr = (struct block *) TclpSysAlloc( + sizeof(struct block) + OVERHEAD + numBytes); } if (bigBlockPtr == NULL) { Tcl_MutexUnlock(allocMutexPtr); @@ -405,8 +405,8 @@ MoreCore( numBlocks = amount / size; ASSERT(numBlocks*size == amount); - blockPtr = (struct block *) TclpSysAlloc((unsigned) - (sizeof(struct block) + amount), 1); + blockPtr = (struct block *) TclpSysAlloc( + sizeof(struct block) + amount); /* no more room! */ if (blockPtr == NULL) { return; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 19c9829..9ee8ef7 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -698,8 +698,8 @@ Tcl_CreateInterp(void) */ iPtr->ensembleRewrite.sourceObjs = NULL; - iPtr->ensembleRewrite.numRemovedObjs = 0; - iPtr->ensembleRewrite.numInsertedObjs = 0; + iPtr->ensembleRewrite.numRemovedObjs1 = 0; + iPtr->ensembleRewrite.numInsertedObjs1 = 0; /* * TIP#143: Initialise the resource limit support. diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 0681097..915e1e7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1096,7 +1096,7 @@ MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, - size_t length, TCL_HASH_TYPE hash, int *newPtr, + size_t length, size_t hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); @@ -1110,7 +1110,7 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); -MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index); +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, size_t index); MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index ea3be1a..29ab973 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -235,7 +235,7 @@ AllocChainEntry( cPtr = ckalloc(sizeof(ChainEntry)); cPtr->entry.key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); - cPtr->entry.clientData = NULL; + Tcl_SetHashValue(&cPtr->entry, NULL); cPtr->prevPtr = cPtr->nextPtr = NULL; return &cPtr->entry; @@ -492,7 +492,7 @@ UpdateStringOfDict( Dict *dict = DICT(dictPtr); ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - int i, length, bytesNeeded = 0; + size_t i, length, bytesNeeded = 0; const char *elem; char *dst; @@ -501,7 +501,7 @@ UpdateStringOfDict( * is not exposed by any API function... */ - int numElems = dict->table.numEntries * 2; + size_t numElems = dict->table.numEntries * 2; /* Handle empty list case first, simplifies what follows */ if (numElems == 0) { @@ -527,7 +527,8 @@ UpdateStringOfDict( flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); - elem = TclGetStringFromObj(keyPtr, &length); + elem = TclGetString(keyPtr); + length = keyPtr->length; bytesNeeded += TclScanElement(elem, length, flagPtr+i); if (bytesNeeded < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); @@ -535,14 +536,9 @@ UpdateStringOfDict( flagPtr[i+1] = TCL_DONT_QUOTE_HASH; valuePtr = Tcl_GetHashValue(&cPtr->entry); - elem = TclGetStringFromObj(valuePtr, &length); + elem = TclGetString(valuePtr); + length = valuePtr->length; bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - numElems + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; @@ -556,13 +552,15 @@ UpdateStringOfDict( for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); - elem = TclGetStringFromObj(keyPtr, &length); + elem = TclGetString(keyPtr); + length = keyPtr->length; dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; valuePtr = Tcl_GetHashValue(&cPtr->entry); - elem = TclGetStringFromObj(valuePtr, &length); + elem = TclGetString(valuePtr); + length = valuePtr->length; dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 605f66f..ecf6563 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1661,7 +1661,7 @@ NsEnsembleImplementationCmdNR( int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ Tcl_Obj *subObj; - int subIdx; + size_t subIdx; /* * Must recheck objc, since numParameters might have changed. Cf. test @@ -1670,7 +1670,7 @@ NsEnsembleImplementationCmdNR( restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; - if (objc < subIdx + 1) { + if ((size_t)objc < subIdx + 1) { /* * We don't have a subcommand argument. Make error message. */ @@ -1767,15 +1767,16 @@ NsEnsembleImplementationCmdNR( * it (will be an error for a non-unique * prefix). */ char *fullName = NULL; /* Full name of the subcommand. */ - int stringLength, i; - int tableLength = ensemblePtr->subcommandTable.numEntries; + size_t stringLength, i; + size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; - subcmdName = TclGetStringFromObj(subObj, &stringLength); + subcmdName = TclGetString(subObj); + stringLength = subObj->length; for (i=0 ; isubcommandArrayPtr[i], - (unsigned) stringLength); + stringLength); if (cmp == 0) { if (fullName != NULL) { @@ -1931,7 +1932,7 @@ NsEnsembleImplementationCmdNR( if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { - int i; + size_t i; for (i=0 ; isubcommandTable.numEntries-1 ; i++) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); @@ -1976,8 +1977,8 @@ TclClearRootEnsemble( int TclInitRewriteEnsemble( Tcl_Interp *interp, - int numRemoved, - int numInserted, + size_t numRemoved, + size_t numInserted, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -1986,16 +1987,16 @@ TclInitRewriteEnsemble( if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = numRemoved; - iPtr->ensembleRewrite.numInsertedObjs = numInserted; + iPtr->ensembleRewrite.numRemovedObjs1 = numRemoved; + iPtr->ensembleRewrite.numInsertedObjs1 = numInserted; } else { - int numIns = iPtr->ensembleRewrite.numInsertedObjs; + size_t numIns = iPtr->ensembleRewrite.numInsertedObjs1; if (numIns < numRemoved) { - iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; - iPtr->ensembleRewrite.numInsertedObjs = numInserted; + iPtr->ensembleRewrite.numRemovedObjs1 += numRemoved - numIns; + iPtr->ensembleRewrite.numInsertedObjs1 = numInserted; } else { - iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved; + iPtr->ensembleRewrite.numInsertedObjs1 += numInserted - numRemoved; } } return isRootEnsemble; @@ -2028,8 +2029,8 @@ TclResetRewriteEnsemble( if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = NULL; - iPtr->ensembleRewrite.numRemovedObjs = 0; - iPtr->ensembleRewrite.numInsertedObjs = 0; + iPtr->ensembleRewrite.numRemovedObjs1 = 0; + iPtr->ensembleRewrite.numInsertedObjs1 = 0; } } @@ -2068,7 +2069,7 @@ TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, - int badIdx, + size_t badIdx, Tcl_Obj *bad, Tcl_Obj *fix) { @@ -2080,14 +2081,14 @@ TclSpellFix( if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 0; - iPtr->ensembleRewrite.numInsertedObjs = 0; + iPtr->ensembleRewrite.numRemovedObjs1 = 0; + iPtr->ensembleRewrite.numInsertedObjs1 = 0; } /* Compute the valid length of the ensemble root */ - size = iPtr->ensembleRewrite.numRemovedObjs + objc - - iPtr->ensembleRewrite.numInsertedObjs; + size = iPtr->ensembleRewrite.numRemovedObjs1 + objc + - iPtr->ensembleRewrite.numInsertedObjs1; search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { @@ -2095,7 +2096,7 @@ TclSpellFix( search = (Tcl_Obj *const *) search[1]; } - if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) { + if (badIdx < iPtr->ensembleRewrite.numInsertedObjs1) { /* * Misspelled value was inserted. We cannot directly jump * to the bad value, but have to search. @@ -2112,8 +2113,8 @@ TclSpellFix( } } else { /* Jump to the misspelled value. */ - idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx - - iPtr->ensembleRewrite.numInsertedObjs; + idx = iPtr->ensembleRewrite.numRemovedObjs1 + badIdx + - iPtr->ensembleRewrite.numInsertedObjs1; /* Verify */ if (search[idx] != bad) { @@ -2168,8 +2169,8 @@ TclFetchEnsembleRoot( Interp *iPtr = (Interp *) interp; if (iPtr->ensembleRewrite.sourceObjs) { - *objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs - - iPtr->ensembleRewrite.numInsertedObjs; + *objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs1 + - iPtr->ensembleRewrite.numInsertedObjs1; return iPtr->ensembleRewrite.sourceObjs; } *objcPtr = objc; @@ -2502,7 +2503,8 @@ BuildEnsembleConfig( Tcl_HashSearch search; /* Used for scanning the set of commands in * the namespace that backs up this * ensemble. */ - int i, j, isNew; + size_t i, j; + int isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; @@ -2535,7 +2537,7 @@ BuildEnsembleConfig( TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc, &subcmdv); - for (i=0 ; inumEntries > 1) { - qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries, + qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries, sizeof(char *), NsEnsembleStringOrder); } } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b845d38..7f8d6a1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -73,7 +73,7 @@ int tclTraceExec = 0; * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is - * disjoint for backward-compatability reasons. + * disjoint for backward-compatibility reasons. */ static const char *const operatorStrings[] = { diff --git a/generic/tclHash.c b/generic/tclHash.c index 49e0d1e..5f7908e 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -243,8 +243,7 @@ CreateHashEntry( { register Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; - unsigned int hash; - int index; + size_t hash, index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -265,7 +264,7 @@ CreateHashEntry( index = hash & tablePtr->mask; } } else { - hash = PTR2UINT(key); + hash = (size_t) key; index = RANDOM_INDEX(tablePtr, hash); } @@ -278,7 +277,7 @@ CreateHashEntry( for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) { @@ -291,7 +290,7 @@ CreateHashEntry( } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (key == hPtr->key.oneWordValue) { @@ -317,11 +316,11 @@ CreateHashEntry( } else { hPtr = ckalloc(sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); } hPtr->tablePtr = tablePtr; - hPtr->hash = UINT2PTR(hash); + hPtr->hash = hash; hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; tablePtr->numEntries++; @@ -363,7 +362,7 @@ Tcl_DeleteHashEntry( const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; - int index; + size_t index; tablePtr = entryPtr->tablePtr; @@ -380,9 +379,9 @@ Tcl_DeleteHashEntry( if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); + index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -432,7 +431,7 @@ Tcl_DeleteHashTable( { register Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - int i; + size_t i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -581,7 +580,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; register Tcl_HashEntry *hPtr; char *result, *p; @@ -616,16 +615,16 @@ Tcl_HashStats( */ result = ckalloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%d entries in table, %d buckets\n", - tablePtr->numEntries, tablePtr->numBuckets); + sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n", + (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", - i, count[i]); + sprintf(p, "number of buckets with %d entries: %" TCL_LL_MODIFIER "d\n", + (int)i, (Tcl_WideInt)count[i]); p += strlen(p); } sprintf(p, "number of buckets with %d or more entries: %d\n", - NUM_COUNTERS, overflow); + NUM_COUNTERS, (int)overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); return result; @@ -670,7 +669,7 @@ AllocArrayEntry( count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } @@ -778,7 +777,7 @@ AllocStringEntry( } hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } @@ -955,7 +954,7 @@ static void RebuildTable( register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - int oldSize, count, index; + size_t oldSize, count, index; Tcl_HashEntry **oldBuckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; @@ -982,8 +981,8 @@ RebuildTable( tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned) - (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0); + tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc( + tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } else { tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); @@ -1005,9 +1004,9 @@ RebuildTable( *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); + index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = PTR2UINT(hPtr->hash) & tablePtr->mask; + index = hPtr->hash & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 0c136b7..be41547 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -812,7 +812,7 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen; + size_t i, len, elemLen; char flags; Interp *iPtr = (Interp *) interp; const char *elementStr; @@ -832,8 +832,8 @@ Tcl_WrongNumArgs( */ if (iPtr->ensembleRewrite.sourceObjs != NULL) { - int toSkip = iPtr->ensembleRewrite.numInsertedObjs; - int toPrint = iPtr->ensembleRewrite.numRemovedObjs; + size_t toSkip = iPtr->ensembleRewrite.numInsertedObjs1; + size_t toPrint = iPtr->ensembleRewrite.numRemovedObjs1; Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; /* @@ -851,7 +851,7 @@ Tcl_WrongNumArgs( * confusing error message... */ - if (objc < toSkip) { + if ((size_t)objc < toSkip) { goto addNormalArgumentsToMessage; } @@ -878,7 +878,8 @@ Tcl_WrongNumArgs( elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { - elementStr = TclGetStringFromObj(origObjv[i], &elemLen); + elementStr = TclGetString(origObjv[i]); + elemLen = origObjv[i]->length; } flags = 0; len = TclScanElement(elementStr, elemLen, &flags); @@ -912,7 +913,7 @@ Tcl_WrongNumArgs( */ addNormalArgumentsToMessage: - for (i = 0; i < objc; i++) { + for (i = 0; i < (size_t)objc; i++) { /* * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. @@ -928,13 +929,14 @@ Tcl_WrongNumArgs( * Quote the argument if it contains spaces (Bug 942757). */ - elementStr = TclGetStringFromObj(objv[i], &elemLen); + elementStr = TclGetString(objv[i]); + elemLen = objv[i]->length; flags = 0; len = TclScanElement(elementStr, elemLen, &flags); if (len != elemLen) { char *quotedElementStr = TclStackAlloc(interp, - (unsigned) len + 1); + len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); @@ -950,7 +952,7 @@ Tcl_WrongNumArgs( * (either another element from objv, or the message string). */ - if (iliteralTable; LiteralEntry *globalPtr; - TCL_HASH_TYPE globalHash; + size_t globalHash; Tcl_Obj *objPtr; /* * Is it in the interpreter's global literal table? */ - if (hash == (TCL_HASH_TYPE) -1) { + if (hash == (size_t) -1) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); @@ -285,7 +285,8 @@ TclCreateLiteral( TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; - int found, i; + int found; + size_t i; found = 0; for (i=0 ; inumBuckets ; i++) { @@ -298,7 +299,7 @@ TclCreateLiteral( } if (!found) { Tcl_Panic("%s: literal \"%.*s\" wasn't global", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -335,10 +336,10 @@ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ - unsigned int index) /* Index of the desired literal, as returned + size_t index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { - if (index >= (unsigned int) envPtr->literalArrayNext) { + if (index >= (size_t) envPtr->literalArrayNext) { return NULL; } return envPtr->literalArrayPtr[index].objPtr; @@ -378,7 +379,7 @@ TclRegisterLiteral( register const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - int length, /* Number of bytes in the string. If < 0, the + size_t length, /* Number of bytes in the string. If -1, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already @@ -392,11 +393,11 @@ TclRegisterLiteral( LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; - unsigned hash; - int localHash, objIndex, new; + size_t hash, localHash, objIndex; + int new; Namespace *nsPtr; - if (length < 0) { + if (length == (size_t)-1) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); @@ -410,7 +411,7 @@ TclRegisterLiteral( for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL; localPtr = localPtr->nextPtr) { objPtr = localPtr->objPtr; - if ((objPtr->length == length) && ((length == 0) + if (((size_t)objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) && (memcmp(objPtr->bytes, bytes, length) == 0)))) { if ((flags & LITERAL_ON_HEAP)) { @@ -454,7 +455,7 @@ TclRegisterLiteral( #ifdef TCL_COMPILE_DEBUG if (globalPtr != NULL && globalPtr->refCount < 1) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", - "TclRegisterLiteral", (length>60? 60 : length), bytes, + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); @@ -492,10 +493,10 @@ LookupLiteralEntry( LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *entryPtr; const char *bytes; - int length, globalHash; + size_t globalHash; - bytes = TclGetStringFromObj(objPtr, &length); - globalHash = (HashString(bytes, length) & globalTablePtr->mask); + bytes = TclGetString(objPtr); + globalHash = (HashString(bytes, objPtr->length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { @@ -537,7 +538,8 @@ TclHideLiteral( { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - int localHash, length; + size_t localHash; + size_t length; const char *bytes; Tcl_Obj *newObjPtr; @@ -555,7 +557,8 @@ TclHideLiteral( TclReleaseLiteral(interp, lPtr->objPtr); lPtr->objPtr = newObjPtr; - bytes = TclGetStringFromObj(newObjPtr, &length); + bytes = TclGetString(newObjPtr); + length = newObjPtr->length; localHash = (HashString(bytes, length) & localTablePtr->mask); nextPtrPtr = &localTablePtr->buckets[localHash]; @@ -674,7 +677,8 @@ AddLocalLiteralEntry( TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int length, found, i; + int found; + size_t length, i; found = 0; for (i=0 ; inumBuckets ; i++) { @@ -687,9 +691,10 @@ AddLocalLiteralEntry( } if (!found) { - bytes = TclGetStringFromObj(objPtr, &length); + bytes = TclGetString(objPtr); + length = objPtr->length; Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", - "AddLocalLiteralEntry", (length>60? 60 : length), bytes); + "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -728,16 +733,16 @@ ExpandLocalLiteralArray( */ LiteralTable *localTablePtr = &envPtr->localLitTable; - int currElems = envPtr->literalArrayNext; + size_t currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; LiteralEntry *newArrayPtr; - int i; - unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; + size_t i; + size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { - Tcl_Panic("max size of Tcl literal array (%d literals) exceeded", - currElems); + Tcl_Panic("max size of Tcl literal array (%" TCL_LL_MODIFIER "d literals) exceeded", + (Tcl_WideInt)currElems); } if (envPtr->mallocedLiteralArray) { @@ -809,15 +814,16 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; register LiteralEntry *entryPtr, *prevPtr; const char *bytes; - int length, index; + size_t length, index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; - bytes = TclGetStringFromObj(objPtr, &length); - index = (HashString(bytes, length) & globalTablePtr->mask); + bytes = TclGetString(objPtr); + length = objPtr->length; + index = HashString(bytes, length) & globalTablePtr->mask; /* * Check to see if the object is in the global literal table and remove @@ -880,12 +886,12 @@ TclReleaseLiteral( *---------------------------------------------------------------------- */ -static unsigned +static size_t HashString( register const char *string, /* String for which to compute hash value. */ - int length) /* Number of bytes in the string. */ + size_t length) /* Number of bytes in the string. */ { - register unsigned int result = 0; + register size_t result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -954,8 +960,7 @@ RebuildLiteralTable( register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - unsigned int oldSize; - int count, index, length; + size_t oldSize, count, index, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -990,7 +995,8 @@ RebuildLiteralTable( for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { - bytes = TclGetStringFromObj(entryPtr->objPtr, &length); + bytes = TclGetString(entryPtr->objPtr); + length = entryPtr->objPtr->length; index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; @@ -1113,8 +1119,8 @@ TclLiteralStats( */ result = ckalloc(NUM_COUNTERS*60 + 300); - sprintf(result, "%d entries in table, %d buckets\n", - tablePtr->numEntries, tablePtr->numBuckets); + sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n", + (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; ilocalLitTable; register LiteralEntry *localPtr; char *bytes; - register int i; - int length, count; + size_t i, length, count = 0; - count = 0; for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; if (localPtr->refCount != -1) { - bytes = TclGetStringFromObj(localPtr->objPtr, &length); + bytes = TclGetString(localPtr->objPtr); + length = localPtr->objPtr->length; Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", "TclVerifyLocalLiteralTable", - (length>60? 60 : length), bytes, localPtr->refCount); + (length>60? 60 : (int) length), bytes, localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", @@ -1205,19 +1210,18 @@ TclVerifyGlobalLiteralTable( register LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *globalPtr; char *bytes; - register int i; - int length, count; + size_t i, length, count = 0; - count = 0; for (i=0 ; inumBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount < 1) { - bytes = TclGetStringFromObj(globalPtr->objPtr, &length); + bytes = TclGetString(globalPtr->objPtr); + length = globalPtr->objPtr->length; Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclVerifyGlobalLiteralTable", - (length>60? 60 : length), bytes, globalPtr->refCount); + (length>60? 60 : (int)length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index abac951..8a7f4a4 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -404,7 +404,7 @@ Tcl_PopCallFrame( nsPtr = framePtr->nsPtr; nsPtr->activationCount--; if ((nsPtr->flags & NS_DYING) - && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { + && (nsPtr->activationCount == (nsPtr == iPtr->globalNsPtr))) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; @@ -997,7 +997,7 @@ Tcl_DeleteNamespace( * refCount reaches 0. */ - if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { + if (nsPtr->activationCount > (nsPtr == globalNsPtr)) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( @@ -1099,7 +1099,7 @@ TclTeardownNamespace( Interp *iPtr = (Interp *) nsPtr->interp; register Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - int i; + size_t i; /* * Start by destroying the namespace's variable table, since variables @@ -1120,7 +1120,7 @@ TclTeardownNamespace( */ while (nsPtr->cmdTable.numEntries > 0) { - int length = nsPtr->cmdTable.numEntries; + size_t length = nsPtr->cmdTable.numEntries; Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Command *) * length); @@ -1192,7 +1192,7 @@ TclTeardownNamespace( #ifndef BREAK_NAMESPACE_COMPAT while (nsPtr->childTable.numEntries > 0) { - int length = nsPtr->childTable.numEntries; + size_t length = nsPtr->childTable.numEntries; Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1365,7 +1365,7 @@ Tcl_Export( Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; - int neededElems, len, i; + size_t neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. @@ -1492,7 +1492,8 @@ Tcl_AppendExportList( * export pattern list is appended. */ { Namespace *nsPtr; - int i, result; + size_t i; + int result; /* * If the specified namespace is NULL, use the current namespace. @@ -1694,7 +1695,7 @@ DoImport( Namespace *importNsPtr, int allowOverwrite) { - int i = 0, exported = 0; + size_t i = 0, exported = 0; Tcl_HashEntry *found; /* diff --git a/generic/tclOO.h b/generic/tclOO.h index 06a39fb..eff31f2 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -90,7 +90,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking - * binary compatability. + * binary compatibility. */ #define TCL_OO_METHOD_VERSION_CURRENT 1 @@ -117,7 +117,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_ObjectMetadataType * structure. This allows new versions of the structure to be introduced - * without breaking binary compatability. + * without breaking binary compatibility. */ #define TCL_OO_METADATA_VERSION_CURRENT 1 diff --git a/generic/tclObj.c b/generic/tclObj.c index ae45153..6a1d925 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3936,7 +3936,7 @@ AllocObjEntry( hPtr->key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); - hPtr->clientData = NULL; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } diff --git a/generic/tclProc.c b/generic/tclProc.c index a9862d9..982b4f2 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1346,7 +1346,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ -1, &new, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index b259df7..1fc0aa5 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2708,9 +2708,11 @@ TclStringRepeat( if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { + char buf[TCL_INTEGER_SPACE]; + sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(count*length)); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %lu bytes", - STRING_SIZE(count*length))); + "string size overflow: unable to alloc %s bytes", + buf)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; @@ -2931,9 +2933,11 @@ TclStringCatObjv( Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { + char buf[TCL_INTEGER_SPACE]; + sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(length)); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %lu bytes", - STRING_SIZE(length))); + "concatenation failed: unable to alloc %s bytes", + buf)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; @@ -2946,9 +2950,11 @@ TclStringCatObjv( objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { + char buf[TCL_INTEGER_SPACE]; + sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(length)); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %lu bytes", - STRING_SIZE(length))); + "concatenation failed: unable to alloc %s bytes", + buf)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; diff --git a/generic/tclTest.c b/generic/tclTest.c index 2f417e3..bc64594 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6641,7 +6641,7 @@ TestHashSystemHashCmd( Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } - if (hash.numEntries != limit) { + if (hash.numEntries != (size_t)limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 6f32617..08e58a0 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -220,7 +220,7 @@ GetCache(void) cachePtr = TclpGetAllocCache(); if (cachePtr == NULL) { - cachePtr = TclpSysAlloc(sizeof(Cache), 0); + cachePtr = TclpSysAlloc(sizeof(Cache)); if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } @@ -346,7 +346,7 @@ TclpAlloc( #endif if (size > MAXALLOC) { bucket = NBUCKETS; - blockPtr = TclpSysAlloc(size, 0); + blockPtr = TclpSysAlloc(size); if (blockPtr != NULL) { cachePtr->totalAssigned += reqSize; } @@ -572,7 +572,7 @@ TclThreadAllocObj(void) Tcl_Obj *newObjsPtr; cachePtr->numObjects = numMove = NOBJALLOC; - newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0); + newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove); if (newObjsPtr == NULL) { Tcl_Panic("alloc: could not allocate %d new objects", numMove); } @@ -1041,7 +1041,7 @@ GetBlocks( if (blockPtr == NULL) { size = MAXALLOC; - blockPtr = TclpSysAlloc(size, 0); + blockPtr = TclpSysAlloc(size); if (blockPtr == NULL) { return 0; } diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index 9035b1a..31776e2 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -85,14 +85,14 @@ TSDTableCreate(void) TSDTable *tsdTablePtr; sig_atomic_t i; - tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0); + tsdTablePtr = TclpSysAlloc(sizeof(TSDTable)); if (tsdTablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } tsdTablePtr->allocated = 8; tsdTablePtr->tablePtr = - TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0); + TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated); if (tsdTablePtr->tablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 44325f8..9a04d8b 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -2633,7 +2633,7 @@ TclArraySet( } else { /* * Not a dictionary, so assume (and convert to, for backward- - * -compatability reasons) a list. + * -compatibility reasons) a list. */ int elemLen; diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 2728957..047a415 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -672,9 +672,9 @@ typedef int socklen_t; *--------------------------------------------------------------------------- */ -#define TclpSysAlloc(size, isBin) malloc((size_t)(size)) +#define TclpSysAlloc(size) malloc(size) #define TclpSysFree(ptr) free((char *)(ptr)) -#define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size)) +#define TclpSysRealloc(ptr, size) realloc(ptr, size) /* *--------------------------------------------------------------------------- diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 44c5607..989e2af 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -708,7 +708,7 @@ TclpThreadCreateKey(void) { pthread_key_t *ptkeyPtr; - ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr, 0); + ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr); if (NULL == ptkeyPtr) { Tcl_Panic("unable to allocate thread key!"); } diff --git a/win/tclWinPort.h b/win/tclWinPort.h index b6e59b4..5bbce97 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -533,7 +533,7 @@ typedef DWORD_PTR * PDWORD_PTR; * use by tclAlloc.c. */ -#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ +#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \ (DWORD)0, (DWORD)size)) #define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ (DWORD)0, (HGLOBAL)ptr)) diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 8c130a7..c1ab58f 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -1037,7 +1037,7 @@ TclpThreadCreateKey(void) { DWORD *key; - key = TclpSysAlloc(sizeof *key, 0); + key = TclpSysAlloc(sizeof *key); if (key == NULL) { Tcl_Panic("unable to allocate thread key!"); } -- cgit v0.12 From 389ad9987b0baa69318bdec55a1e77f9140075dc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Dec 2016 12:32:49 +0000 Subject: Fix installation of platform/shell-1.1.4.tm on Windows (platform directory was still missing) --- win/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/Makefile.in b/win/Makefile.in index 4ae4dd0..067d1b8 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -621,7 +621,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0; \ + @for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ -- cgit v0.12 From 9c4eb9d12191daaee0a919967abc8f21b3f4fd99 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 23 Dec 2016 10:07:38 +0000 Subject: Deprecate otherValuePtr and ptrAndLongRep. Some more minor tweaks. --- doc/Object.3 | 9 ++------- generic/tcl.decls | 2 +- generic/tcl.h | 9 +-------- generic/tclDTrace.d | 9 ++------- generic/tclObj.c | 6 +----- generic/tclTestObj.c | 4 ++-- generic/tclThread.c | 2 +- win/tclWinFile.c | 1 - 8 files changed, 10 insertions(+), 32 deletions(-) diff --git a/doc/Object.3 b/doc/Object.3 index bf80fe2..027fea5 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -111,23 +111,18 @@ which is defined as follows. .PP .CS typedef struct Tcl_Obj { - int \fIrefCount\fR; + size_t \fIrefCount\fR; char *\fIbytes\fR; - int \fIlength\fR; + size_t \fIlength\fR; const Tcl_ObjType *\fItypePtr\fR; union { long \fIlongValue\fR; double \fIdoubleValue\fR; - void *\fIotherValuePtr\fR; Tcl_WideInt \fIwideValue\fR; struct { void *\fIptr1\fR; void *\fIptr2\fR; } \fItwoPtrValue\fR; - struct { - void *\fIptr\fR; - unsigned long \fIvalue\fR; - } \fIptrAndLongRep\fR; } \fIinternalRep\fR; } \fBTcl_Obj\fR; .CE diff --git a/generic/tcl.decls b/generic/tcl.decls index 3901d77..db57902 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -289,7 +289,7 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -# Removed in 9.0. Don't re-use it in any 9.x release, see TIP ???. +# Removed in 9.0. #declare 77 { # char Tcl_Backslash(const char *src, int *readPtr) #} diff --git a/generic/tcl.h b/generic/tcl.h index 8dbd320..e1d5ed9 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -610,7 +610,7 @@ typedef struct Tcl_ObjType { */ typedef struct Tcl_Obj { - size_t refCount; /* When 0 the object will be freed. */ + size_t refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * must be followed by a null byte (i.e., at @@ -631,8 +631,6 @@ typedef struct Tcl_Obj { union { /* The internal representation: */ long longValue; /* - an long integer value. */ double doubleValue; /* - a double-precision floating value. */ - void *otherValuePtr; /* - another, type-specific value, not used - * internally any more. */ Tcl_WideInt wideValue; /* - a long long value. */ struct { /* - internal rep as two pointers. * Many uses in Tcl, including a bignum's @@ -643,11 +641,6 @@ typedef struct Tcl_Obj { void *ptr1; void *ptr2; } twoPtrValue; - struct { /* - internal rep as a pointer and a long, - * not used internally any more. */ - void *ptr; - unsigned long value; - } ptrAndLongRep; } internalRep; } Tcl_Obj; diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index 360bdff..1ad9ae5 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -182,23 +182,18 @@ typedef struct Tcl_ObjType { } Tcl_ObjType; struct Tcl_Obj { - int refCount; + size_t refCount; char *bytes; - int length; + size_t length; Tcl_ObjType *typePtr; union { long longValue; double doubleValue; - void *otherValuePtr; int64_t wideValue; struct { void *ptr1; void *ptr2; } twoPtrValue; - struct { - void *ptr; - unsigned long value; - } ptrAndLongRep; } internalRep; }; diff --git a/generic/tclObj.c b/generic/tclObj.c index f004c3a..a6f8da3 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -309,11 +309,7 @@ const Tcl_HashKeyType tclObjHashKeyType = { * argument in a Tcl command. * * NOTE: the ResolvedCmdName that gets cached is stored in the - * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. You might - * think you could use the simpler otherValuePtr field to store the single - * ResolvedCmdName pointer, but DO NOT DO THIS. It seems that some extensions - * use the second internal pointer field of the twoPtrValue field for their - * own purposes. + * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. * * TRICKY POINT! Some extensions update this structure! (Notably, these * include TclBlend and TCom). This is highly ill-advised on their part, but diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 6c4a1ed..d11c65f 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1266,8 +1266,8 @@ TeststringobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_SetLongObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) - ? varPtr[varIndex]->length : (size_t)-1); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) + ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1); break; case 5: /* length2 */ if (objc != 3) { diff --git a/generic/tclThread.c b/generic/tclThread.c index eaba259..a7e386c 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -76,7 +76,7 @@ static void RememberSyncObject(void *objPtr, void * Tcl_GetThreadData( Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */ - size_t size) /* Size of storage block */ + size_t size) /* Size of storage block */ { void *result; #ifdef TCL_THREADS diff --git a/win/tclWinFile.c b/win/tclWinFile.c index e2b6d1e..e61d619 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2799,7 +2799,6 @@ TclWinVolumeRelativeNormalize( size_t cwdLen = useThisCwd->length; char drive_cur = path[0]; - cwdLen = useThisCwd->length; if (drive_cur >= 'a') { drive_cur -= ('a' - 'A'); } -- cgit v0.12 From d6418172e043b678c06e8e3cdd3380e212f1bbe4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 24 Jan 2017 15:42:32 +0000 Subject: Put back counter in test-case, so we can see if TestsaveresultFree() was actually called or not. --- generic/tclTest.c | 13 ++++++++++--- tests/result.test | 4 ++-- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index c5456f1..435a90d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -108,6 +108,13 @@ typedef struct { } TclEncoding; /* + * The counter below is used to determine if the TestsaveresultFree routine + * was called for a result. + */ + +static int freeCount; + +/* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ @@ -5027,6 +5034,7 @@ TestsaveresultCmd( return TCL_ERROR; } + freeCount = 0; objPtr = NULL; /* Lint. */ switch ((enum options) index) { case RESULT_SMALL: @@ -5068,8 +5076,7 @@ TestsaveresultCmd( switch ((enum options) index) { case RESULT_DYNAMIC: - Tcl_AppendElement(interp, discard ? "called" : "notCalled"); - Tcl_AppendElement(interp, !discard ? "present" : "missing"); + Tcl_AppendElement(interp, freeCount ? "freed" : "leak"); break; case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr @@ -5101,7 +5108,7 @@ static void TestsaveresultFree( char *blockPtr) { - /* empty... */ + freeCount++; } /* diff --git a/tests/result.test b/tests/result.test index 9e8a66b..1eff46e 100644 --- a/tests/result.test +++ b/tests/result.test @@ -31,7 +31,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 -} {dynamic result notCalled present} +} {dynamic result freed} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} @@ -43,7 +43,7 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 -} {42 called missing} +} {42 freed} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} -- cgit v0.12 From b667a58dab35d89cd4b5f140b48a3fcb2dfc5a31 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 22 Feb 2017 09:07:55 +0000 Subject: More internal use of size_t in stead of int (e.g. in many 'epoch's) --- generic/tclInt.h | 6 +++--- generic/tclLiteral.c | 14 ++++++-------- generic/tclOO.c | 5 +++-- generic/tclOOCall.c | 6 +++--- generic/tclOOInt.h | 14 +++++++------- 5 files changed, 22 insertions(+), 23 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 0571b4f..88b2cea 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1479,11 +1479,11 @@ typedef struct LiteralEntry { * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ - int refCount; /* If in an interpreter's global literal + size_t refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to - * 0. If in a local literal table, -1. */ + * 0. If in a local literal table, (size_t) -1. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce @@ -2328,7 +2328,7 @@ typedef enum TclEolTranslation { */ typedef struct List { - int refCount; + size_t refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 2dfce59..8ce2a90 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -453,10 +453,10 @@ TclRegisterLiteral( objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && globalPtr->refCount < 1) { + if (globalPtr != NULL && (globalPtr->refCount < 1 || globalPtr->refCount == (size_t)-1)) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : (int)length), bytes, - globalPtr->refCount); + (int)globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ @@ -615,7 +615,7 @@ TclAddLiteralObj( lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = -1; /* i.e., unused */ + lPtr->refCount = (size_t) -1; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { @@ -834,15 +834,13 @@ TclReleaseLiteral( for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index]; entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { - entryPtr->refCount--; - /* * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ - if (entryPtr->refCount == 0) { + if (entryPtr->refCount-- <= 1) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { @@ -1169,9 +1167,9 @@ TclVerifyLocalLiteralTable( if (localPtr->refCount != -1) { bytes = TclGetString(localPtr->objPtr); length = localPtr->objPtr->length; - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_LL_MODIFIER "d", "TclVerifyLocalLiteralTable", - (length>60? 60 : (int) length), bytes, localPtr->refCount); + (length>60? 60 : (int) length), bytes, (Tcl_WideInt)localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", diff --git a/generic/tclOO.c b/generic/tclOO.c index ef0c987..287396c 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -560,7 +560,8 @@ AllocObject( Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - int creationEpoch, ignored; + size_t creationEpoch; + int ignored; oPtr = ckalloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); @@ -590,7 +591,7 @@ AllocObject( while (1) { char objName[10 + TCL_INTEGER_SPACE]; - sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); + sprintf(objName, "::oo::Obj%" TCL_LL_MODIFIER "u", (Tcl_WideUInt)++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, ObjectNamespaceDeleted); if (oPtr->namespacePtr != NULL) { diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 8003345..7c392e6 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -1017,7 +1017,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (callPtr->numChain == 0) { TclOODeleteChain(callPtr); return NULL; @@ -1087,7 +1087,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; @@ -1254,7 +1254,7 @@ TclOOGetStereotypeCallChain( AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index ae24dee..b3f98cd 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -170,9 +170,9 @@ typedef struct Object { * references; this mechanism is there to * avoid Tcl_Preserve. */ int flags; - int creationEpoch; /* Unique value to make comparisons of objects + size_t creationEpoch; /* Unique value to make comparisons of objects * easier. */ - int epoch; /* Per-object epoch, incremented when the way + size_t epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to @@ -282,7 +282,7 @@ typedef struct Class { */ typedef struct ThreadLocalData { - int nsCount; /* Master epoch counter is used for keeping + size_t nsCount; /* Master epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter @@ -306,7 +306,7 @@ typedef struct Foundation { Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ - int epoch; /* Used to invalidate method chains when the + size_t epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ @@ -340,12 +340,12 @@ struct MInvoke { }; typedef struct CallChain { - int objectCreationEpoch; /* The object's creation epoch. Note that the + size_t objectCreationEpoch; /* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - int objectEpoch; /* Local (object structure) epoch counter + size_t objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - int epoch; /* Global (class structure) epoch counter + size_t epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ int refCount; /* Reference count. */ -- cgit v0.12 -- cgit v0.12 From eb03584c16b7a1b99800e60e00ed43a73745b2d2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 28 Mar 2017 07:14:47 +0000 Subject: (experimental) new internal macro TCL_Z_MODIFIER, just like TCL_LL_MODIFIER but then for size_t. --- generic/tcl.h | 8 ++++++++ generic/tclAlloc.c | 10 +++++----- generic/tclCkalloc.c | 14 +++++++------- generic/tclExecute.c | 6 +++--- generic/tclStringObj.c | 12 ++++++------ 5 files changed, 29 insertions(+), 21 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 731724e..24dd0be 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -394,9 +394,11 @@ typedef long LONG; # if defined(_WIN32) # define TCL_WIDE_INT_TYPE __int64 # define TCL_LL_MODIFIER "I64" +# define TCL_Z_MODIFIER "I" # elif defined(__GNUC__) # define TCL_WIDE_INT_TYPE long long # define TCL_LL_MODIFIER "ll" +# define TCL_Z_MODIFIER "z" # else /* ! _WIN32 && ! __GNUC__ */ /* * Don't know what platform it is and configure hasn't discovered what is @@ -426,6 +428,9 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # ifndef TCL_LL_MODIFIER # define TCL_LL_MODIFIER "l" # endif /* !TCL_LL_MODIFIER */ +# ifndef TCL_Z_MODIFIER +# define TCL_Z_MODIFIER "l" +# endif /* !TCL_Z_MODIFIER */ #else /* TCL_WIDE_INT_IS_LONG */ /* * The next short section of defines are only done when not running on Windows @@ -434,6 +439,9 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # ifndef TCL_LL_MODIFIER # define TCL_LL_MODIFIER "ll" # endif /* !TCL_LL_MODIFIER */ +# ifndef TCL_Z_MODIFIER +# define TCL_Z_MODIFIER "" +# endif /* !TCL_Z_MODIFIER */ # define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) # define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) # define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 64df1a2..fbd8f6e 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -661,14 +661,14 @@ mstats( fprintf(stderr, "\nused:\t"); for (i = 0; i < NBUCKETS; i++) { - fprintf(stderr, " %" TCL_LL_MODIFIER "d", (Tcl_WideInt)numMallocs[i]); + fprintf(stderr, " %" TCL_Z_MODIFIER "d", numMallocs[i]); totalUsed += numMallocs[i] * (1 << (i + 3)); } - fprintf(stderr, "\n\tTotal small in use: %" TCL_LL_MODIFIER "d, total free: %" TCL_LL_MODIFIER "d\n", - (Tcl_WideInt)totalUsed, (Tcl_WideInt)totalFree); - fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_LL_MODIFIER "d\n", - MAXMALLOC, (Tcl_WideInt)numMallocs[NBUCKETS]); + fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "d, total free: %" TCL_Z_MODIFIER "d\n", + totalUsed, totalFree); + fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "d\n", + MAXMALLOC, numMallocs[NBUCKETS]); Tcl_MutexUnlock(allocMutexPtr); } diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index d42536e..394287a 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -254,7 +254,7 @@ ValidateMemory( fprintf(stderr, "low guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ - fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", (Tcl_WideInt) memHeaderP->length, + fprintf(stderr, "%" TCL_Z_MODIFIER "d bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); Tcl_Panic("Memory validation failure"); } @@ -276,8 +276,8 @@ ValidateMemory( fprintf(stderr, "high guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ - fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", - (Tcl_WideInt)memHeaderP->length, memHeaderP->file, + fprintf(stderr, "%" TCL_Z_MODIFIER "d bytes allocated at (%s %d)\n", + memHeaderP->length, memHeaderP->file, memHeaderP->line); Tcl_Panic("Memory validation failure"); } @@ -359,10 +359,10 @@ Tcl_DumpActiveMemory( Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { address = &memScanP->body[0]; - fprintf(fileP, "%8" TCL_LL_MODIFIER "x - %8" TCL_LL_MODIFIER "x %7" TCL_LL_MODIFIER "d @ %s %d %s", - (Tcl_WideInt)(size_t)address, - (Tcl_WideInt)((size_t)address + memScanP->length - 1), - (Tcl_WideInt)memScanP->length, memScanP->file, memScanP->line, + fprintf(fileP, "%8" TCL_Z_MODIFIER "x - %8" TCL_Z_MODIFIER "x %7" TCL_Z_MODIFIER "d @ %s %d %s", + (size_t)address, + ((size_t)address + memScanP->length - 1), + memScanP->length, memScanP->file, memScanP->line, (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); (void) fputc('\n', fileP); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ad80b28..98fe51d 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -9477,9 +9477,9 @@ PrintByteCodeInfo( Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; - fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%p (epoch %" TCL_LL_MODIFIER "u)\n", - codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr, - (Tcl_WideInt)iPtr->compileEpoch); + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", + codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, + (size_t)iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index b8b64d4..d12cc74 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2759,8 +2759,8 @@ TclStringRepeat( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow: unable to alloc %" - TCL_LL_MODIFIER "u bytes", - (Tcl_WideUInt)STRING_SIZE(count*length))); + TCL_Z_MODIFIER "u bytes", + STRING_SIZE(count*length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; @@ -2983,8 +2983,8 @@ TclStringCatObjv( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" - TCL_LL_MODIFIER "u bytes", - (Tcl_WideUInt)STRING_SIZE(length))); + TCL_Z_MODIFIER "u bytes", + STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; @@ -2999,8 +2999,8 @@ TclStringCatObjv( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" - TCL_LL_MODIFIER "u bytes", - (Tcl_WideUInt)STRING_SIZE(length))); + TCL_Z_MODIFIER "u bytes", + STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; -- cgit v0.12 From cf3f133df1d082197bba097362768af248e334dc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Mar 2017 12:05:59 +0000 Subject: (more experimenting): Make TCL_LL_MODIFIER behave more close to intuitive expectations: If the platform has a "long long" type, use it for Tcl_WideInt, so TCL_LL_MODIFIER is really a replacement for "ll" on most platforms (Win32/Win64 as most notable exception). Will need a new TIP. --- doc/IntObj.3 | 2 +- generic/tcl.h | 15 +++++++-------- generic/tclIO.c | 2 +- unix/configure | 6 +++--- unix/tcl.m4 | 6 +++--- unix/tclConfig.h.in | 2 +- 6 files changed, 16 insertions(+), 17 deletions(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index dc62642..6d5ee69 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -97,7 +97,7 @@ are provided by the C language standard. The \fBTcl_WideInt\fR type is a typedef defined to be whatever signed integral type covers at least the 64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending on the platform and the C compiler, the actual type might be -\fBlong int\fR, \fBlong long int\fR, \fBint64\fR, or something else. +\fBlong long int\fR, \fB__int64\fR, or something else. The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP diff --git a/generic/tcl.h b/generic/tcl.h index 24dd0be..c038dce 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -412,21 +412,17 @@ typedef long LONG; # endif # endif /* _WIN32 */ #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */ -#ifdef TCL_WIDE_INT_IS_LONG -# undef TCL_WIDE_INT_TYPE -# define TCL_WIDE_INT_TYPE long -#endif /* TCL_WIDE_INT_IS_LONG */ - -typedef TCL_WIDE_INT_TYPE Tcl_WideInt; -typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #ifdef TCL_WIDE_INT_IS_LONG # define Tcl_WideAsLong(val) ((long)(val)) # define Tcl_LongAsWide(val) ((long)(val)) # define Tcl_WideAsDouble(val) ((double)((long)(val))) # define Tcl_DoubleAsWide(val) ((long)((double)(val))) +# ifndef TCL_WIDE_INT_TYPE +# define TCL_WIDE_INT_TYPE long long +# endif /* !TCL_WIDE_INT_TYPE */ # ifndef TCL_LL_MODIFIER -# define TCL_LL_MODIFIER "l" +# define TCL_LL_MODIFIER "ll" # endif /* !TCL_LL_MODIFIER */ # ifndef TCL_Z_MODIFIER # define TCL_Z_MODIFIER "l" @@ -448,6 +444,9 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #endif /* TCL_WIDE_INT_IS_LONG */ +typedef TCL_WIDE_INT_TYPE Tcl_WideInt; +typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; + #if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; diff --git a/generic/tclIO.c b/generic/tclIO.c index 6bf8451..a509ebf 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9276,7 +9276,7 @@ MBWrite( * then the calculations involving extra must be made wide too. * * Noted with Win32/MSVC debug build treating the warning (possible of - * data in int64 to int conversion) as error. + * data in __int64 to int conversion) as error. */ bufPtr = AllocChannelBuffer(extra); diff --git a/unix/configure b/unix/configure index 741ae47..ba8e19b 100755 --- a/unix/configure +++ b/unix/configure @@ -7044,7 +7044,7 @@ else tcl_type_64bit="long long" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - # See if we should use long anyway Note that we substitute in the + # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7070,8 +7070,8 @@ fi $as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5 -$as_echo "using long" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } else cat >>confdefs.h <<_ACEOF diff --git a/unix/tcl.m4 b/unix/tcl.m4 index c1d7a7d..ac40e5d 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2614,15 +2614,15 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ # See if the compiler knows natively about __int64 AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], tcl_type_64bit=__int64, tcl_type_64bit="long long") - # See if we should use long anyway Note that we substitute in the + # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... AC_TRY_COMPILE(,[switch (0) { case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ; }],tcl_cv_type_64bit=${tcl_type_64bit})]) if test "${tcl_cv_type_64bit}" = none ; then - AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?]) - AC_MSG_RESULT([using long]) + AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?]) + AC_MSG_RESULT([yes]) else AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}, [What type should be used to define wide integers?]) diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index adbc80d..fed3872 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -400,7 +400,7 @@ /* Does this platform have wide high-resolution clicks? */ #undef TCL_WIDE_CLICKS -/* Are wide integers to be implemented with C 'long's? */ +/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */ #undef TCL_WIDE_INT_IS_LONG /* What type should be used to define wide integers? */ -- cgit v0.12 From 0515becf7a31a04247d286856d70790c3ca43a2f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 31 Mar 2017 11:05:28 +0000 Subject: Fix fall-back test for TCL_WIDE_INT_IS_LONG, making it do the same as "configure": Should be 1 if sizeof(long long) == sizeof(long), 0 otherwise. --- generic/tcl.h | 49 ++++++++++++++----------------------------------- 1 file changed, 14 insertions(+), 35 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index c038dce..bacd73c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -396,8 +396,6 @@ typedef long LONG; # define TCL_LL_MODIFIER "I64" # define TCL_Z_MODIFIER "I" # elif defined(__GNUC__) -# define TCL_WIDE_INT_TYPE long long -# define TCL_LL_MODIFIER "ll" # define TCL_Z_MODIFIER "z" # else /* ! _WIN32 && ! __GNUC__ */ /* @@ -405,44 +403,25 @@ typedef long LONG; * going on for us. Try to guess... */ # include -# if (INT_MAX < LONG_MAX) +# if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX) # define TCL_WIDE_INT_IS_LONG 1 -# else -# define TCL_WIDE_INT_TYPE long long # endif # endif /* _WIN32 */ #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */ -#ifdef TCL_WIDE_INT_IS_LONG -# define Tcl_WideAsLong(val) ((long)(val)) -# define Tcl_LongAsWide(val) ((long)(val)) -# define Tcl_WideAsDouble(val) ((double)((long)(val))) -# define Tcl_DoubleAsWide(val) ((long)((double)(val))) -# ifndef TCL_WIDE_INT_TYPE -# define TCL_WIDE_INT_TYPE long long -# endif /* !TCL_WIDE_INT_TYPE */ -# ifndef TCL_LL_MODIFIER -# define TCL_LL_MODIFIER "ll" -# endif /* !TCL_LL_MODIFIER */ -# ifndef TCL_Z_MODIFIER -# define TCL_Z_MODIFIER "l" -# endif /* !TCL_Z_MODIFIER */ -#else /* TCL_WIDE_INT_IS_LONG */ -/* - * The next short section of defines are only done when not running on Windows - * or some other strange platform. - */ -# ifndef TCL_LL_MODIFIER -# define TCL_LL_MODIFIER "ll" -# endif /* !TCL_LL_MODIFIER */ -# ifndef TCL_Z_MODIFIER -# define TCL_Z_MODIFIER "" -# endif /* !TCL_Z_MODIFIER */ -# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) -# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) -# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) -# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) -#endif /* TCL_WIDE_INT_IS_LONG */ +#ifndef TCL_WIDE_INT_TYPE +# define TCL_WIDE_INT_TYPE long long +#endif /* !TCL_WIDE_INT_TYPE */ +#ifndef TCL_LL_MODIFIER +# define TCL_LL_MODIFIER "ll" +#endif /* !TCL_LL_MODIFIER */ +#ifndef TCL_Z_MODIFIER +# define TCL_Z_MODIFIER "l" +#endif /* !TCL_Z_MODIFIER */ +#define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) +#define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) +#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) +#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) typedef TCL_WIDE_INT_TYPE Tcl_WideInt; typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; -- cgit v0.12 From de59a00a303f0acfad8f990f62e5095d0e327298 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 Apr 2017 14:48:49 +0000 Subject: Use "0o" in stead of "0" as octal prefix in more places. --- generic/tclStringObj.c | 21 +++++---------------- tests/chanio.test | 8 ++++---- tests/format.test | 4 ++-- tests/io.test | 4 ++-- 4 files changed, 13 insertions(+), 24 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c574003..239f88f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1880,20 +1880,10 @@ Tcl_AppendFormatToObj( format += step; step = Tcl_UtfToUniChar(format, &ch); } - } else if ((ch == 't') || (ch == 'z')) { + } else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j') || (ch == 'L')) { format += step; step = Tcl_UtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG - if (sizeof(size_t) > sizeof(int)) { - useWide = 1; - } -#endif - } else if ((ch == 'q') ||(ch == 'j')) { - format += step; - step = Tcl_UtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG - useWide = 1; -#endif + useBig = 1; } format += step; @@ -2035,9 +2025,8 @@ Tcl_AppendFormatToObj( if (gotHash || (ch == 'p')) { switch (ch) { case 'o': - Tcl_AppendToObj(segment, "0", 1); - segmentLimit -= 1; - precision--; + Tcl_AppendToObj(segment, "0o", 2); + segmentLimit -= 2; break; case 'p': case 'x': @@ -2186,7 +2175,7 @@ Tcl_AppendFormatToObj( * Need to be sure zero becomes "0", not "". */ - if ((numDigits == 0) && !((ch == 'o') && gotHash)) { + if (numDigits == 0) { numDigits = 1; } pure = Tcl_NewObj(); diff --git a/tests/chanio.test b/tests/chanio.test index 8e27af9..2d900d0 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -5338,22 +5338,22 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup { } -constraints {unix} -body { set f [open $path(test3) {WRONLY CREAT} 0600] file stat $path(test3) stats - set x [format "0%o" [expr $stats(mode)&0o777]] + set x [format "%#o" [expr $stats(mode)&0o777]] chan puts $f "line 1" chan close $f set f [open $path(test3) r] lappend x [chan gets $f] } -cleanup { chan close $f -} -result {0600 {line 1}} +} -result {0o600 {line 1}} test chan-io-40.3 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -constraints {unix umask} -body { # This test only works if your umask is 2, like ouster's. chan close [open $path(test3) {WRONLY CREAT}] file stat $path(test3) stats - format "0%o" [expr $stats(mode)&0o777] -} -result [format %04o [expr {0o666 & ~ $umaskValue}]] + format "%#o" [expr $stats(mode)&0o777] +} -result [format %#5o [expr {0o666 & ~ $umaskValue}]] test chan-io-40.4 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -body { diff --git a/tests/format.test b/tests/format.test index ad127a4..801a735 100644 --- a/tests/format.test +++ b/tests/format.test @@ -72,10 +72,10 @@ test format-1.10.1 {integer formatting} longIs64bit { } {0 0x6 0x22 0x421b 0xfffffffffffffff4 } test format-1.11 {integer formatting} longIs32bit { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 -} {0 06 042 041033 037777777764 } +} {0 0o6 0o42 0o41033 0o37777777764 } test format-1.11.1 {integer formatting} longIs64bit { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 -} {0 06 042 041033 01777777777777777777764} +} {0 0o6 0o42 0o41033 0o1777777777777777777764} test format-1.12 {integer formatting} { format "%b %#b %llb" 5 5 [expr {2**100}] } {101 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} diff --git a/tests/io.test b/tests/io.test index 6e7420d..aaceec5 100644 --- a/tests/io.test +++ b/tests/io.test @@ -5652,8 +5652,8 @@ test io-40.3 {POSIX open access modes: CREAT} {unix umask} { set f [open $path(test3) {WRONLY CREAT}] close $f file stat $path(test3) stats - format "0%o" [expr $stats(mode)&0o777] -} [format %04o [expr {0o666 & ~ $umaskValue}]] + format "%#o" [expr $stats(mode)&0o777] +} [format %#5o [expr {0o666 & ~ $umaskValue}]] test io-40.4 {POSIX open access modes: CREAT} { file delete $path(test3) set f [open $path(test3) w] -- cgit v0.12 From cf30ba443c8cdaf39b5b960d78894955dc71beed Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 14 Jun 2017 10:04:05 +0000 Subject: Little variation on Brian's proposal: Only prefix decimal number with '0d' when that's necessary for correct interpretation of the number when parsed back again. --- doc/format.n | 5 +++-- generic/tclStringObj.c | 8 ++++++-- tests/format.test | 21 +++++++++------------ 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/doc/format.n b/doc/format.n index 4eb566d..1df255e 100644 --- a/doc/format.n +++ b/doc/format.n @@ -89,8 +89,9 @@ For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively) will be added to the beginning of the result unless it is zero. For \fBb\fR conversions, \fB0b\fR will be added to the beginning of the result unless it is zero. -For \fBd\fR conversions, \fB0d\fR will be added to the beginning -of the result unless it is zero. +For \fBd\fR conversions, \fB0d\fR there is no effect unless +the \fB0\fR specifier is used as well: In that case, \fB0d\fR or +\fB0D\fR (respectively) will be added to the beginning. For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR, \fBg\fR, and \fBG\fR) it guarantees that the result always has a decimal point. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index b84470b..5ce7d18 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2037,8 +2037,12 @@ Tcl_AppendFormatToObj( segmentLimit -= 2; break; case 'd': - Tcl_AppendToObj(segment, "0d", 2); - segmentLimit -= 2; +#if TCL_MAJOR_VERSION < 9 + if (gotZero) { + Tcl_AppendToObj(segment, "0d", 2); + segmentLimit -= 2; + } +#endif break; } } diff --git a/tests/format.test b/tests/format.test index 8842315..3fd72be 100644 --- a/tests/format.test +++ b/tests/format.test @@ -78,24 +78,21 @@ test format-1.11.1 {integer formatting} longIs64bit { test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] } {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} -test format-1.13 {integer formatting} longIs32bit { +test format-1.13 {integer formatting} { format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1 -} {0d0 0d6 0d34 0d16923 -0d12} -test format-1.13.1 {integer formatting} longIs64bit { - format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1 -} {0d0 0d6 0d34 0d16923 -0d12} +} {0 6 34 16923 -12} test format-1.14 {integer formatting} longIs32bit { - format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1 -} { 0d0 0d6 0d34 0d16923 -0d12} + format "%#05d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1 +} {0d000 6 34 16923 -12} test format-1.14.1 {integer formatting} longIs64bit { - format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1 -} { 0d0 0d6 0d34 0d16923 -0d12} + format "%#05d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1 +} {0d000 6 34 16923 -12} test format-1.15 {integer formatting} longIs32bit { - format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1 -} {0d0 0d6 0d34 0d16923 -0d12 } + format "%-#05d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1 +} {0d000 6 34 16923 -12 } test format-1.15.1 {integer formatting} longIs64bit { format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1 -} {0d0 0d6 0d34 0d16923 -0d12 } +} {0d000 6 34 16923 -12 } test format-2.1 {string formatting} { -- cgit v0.12 From ba1388e7ae69b88d941819008f9a3d774eb6002b Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 19 Jun 2017 18:04:23 +0000 Subject: Silence compiler warning --- generic/tclDictObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 729f4b8..d6211cd 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -530,7 +530,7 @@ UpdateStringOfDict( elem = TclGetString(keyPtr); length = keyPtr->length; bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { + if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } -- cgit v0.12 From 875f1b248d30947b159ed0463dd75e8f035298f8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 27 Jun 2017 10:13:34 +0000 Subject: Implement "format %o" as prefixing with "0o" in stead of "0" (Kevin Kenny's suggestion). Seems ready to be TIPed (just some more testing) --- generic/tclStringObj.c | 26 ++++++++++++++++++-------- library/clock.tcl | 0 tests/format.test | 26 +++++++++++++------------- tests/io.test | 2 +- 4 files changed, 32 insertions(+), 22 deletions(-) mode change 100644 => 100755 library/clock.tcl diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 3b3e211..e2a15f4 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1963,10 +1963,13 @@ Tcl_AppendFormatToObj( } #endif if (useBig) { + int cmpResult; if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { goto error; } - isNegative = (mp_cmp_d(&big, 0) == MP_LT); + cmpResult = mp_cmp_d(&big, 0); + isNegative = (cmpResult == MP_LT); + if (cmpResult == MP_EQ) gotHash = 0; #ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { @@ -1982,6 +1985,7 @@ Tcl_AppendFormatToObj( Tcl_DecrRefCount(objPtr); } isNegative = (w < (Tcl_WideInt) 0); + if (w == (Tcl_WideInt) 0) gotHash = 0; #endif } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { @@ -2001,14 +2005,18 @@ Tcl_AppendFormatToObj( if (useShort) { s = (short) l; isNegative = (s < (short) 0); + if (s == (short) 0) gotHash = 0; } else { isNegative = (l < (long) 0); + if (l == (long) 0) gotHash = 0; } } else if (useShort) { s = (short) l; isNegative = (s < (short) 0); + if (s == (short) 0) gotHash = 0; } else { isNegative = (l < (long) 0); + if (l == (long) 0) gotHash = 0; } segment = Tcl_NewObj(); @@ -2025,9 +2033,8 @@ Tcl_AppendFormatToObj( if (gotHash || (ch == 'p')) { switch (ch) { case 'o': - Tcl_AppendToObj(segment, "0", 1); - segmentLimit -= 1; - precision--; + Tcl_AppendToObj(segment, "0o", 2); + segmentLimit -= 2; break; case 'p': case 'x': @@ -2184,7 +2191,7 @@ Tcl_AppendFormatToObj( * Need to be sure zero becomes "0", not "". */ - if ((numDigits == 0) && !((ch == 'o') && gotHash)) { + if (numDigits == 0) { numDigits = 1; } pure = Tcl_NewObj(); @@ -2204,7 +2211,11 @@ Tcl_AppendFormatToObj( } digitOffset = (int) (bits % base); if (digitOffset > 9) { - bytes[numDigits] = 'a' + digitOffset - 10; + if (ch == 'X') { + bytes[numDigits] = 'A' + digitOffset - 10; + } else { + bytes[numDigits] = 'a' + digitOffset - 10; + } } else { bytes[numDigits] = '0' + digitOffset; } @@ -2328,8 +2339,7 @@ Tcl_AppendFormatToObj( switch (ch) { case 'E': - case 'G': - case 'X': { + case 'G': { Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment))); } } diff --git a/library/clock.tcl b/library/clock.tcl old mode 100644 new mode 100755 diff --git a/tests/format.test b/tests/format.test index 9d75c58..4d312db 100644 --- a/tests/format.test +++ b/tests/format.test @@ -28,7 +28,7 @@ test format-1.1 {integer formatting} { } { 34 16923 -12 -1} test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 -} { 6 34 16923 -12 -1 0xe 0XC} +} { 6 34 16923 -12 -1 0xe 0xC} test format-1.3 {integer formatting} longIs32bit { format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 } { 6 34 16923 4294967284 -1 0} @@ -54,40 +54,40 @@ test format-1.7.1 {integer formatting} longIs64bit { } { 6 22 421b fffffffffffffff4} test format-1.8 {integer formatting} longIs32bit { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 -} {0x0 0x6 0X22 0X421B 0xfffffff4} +} {0 0x6 0x22 0x421B 0xfffffff4} test format-1.8.1 {integer formatting} longIs64bit { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 -} {0x0 0x6 0X22 0X421B 0xfffffffffffffff4} +} {0 0x6 0x22 0x421B 0xfffffffffffffff4} test format-1.9 {integer formatting} longIs32bit { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 -} { 0x0 0x6 0x22 0x421b 0xfffffff4} +} { 0 0x6 0x22 0x421b 0xfffffff4} test format-1.9.1 {integer formatting} longIs64bit { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 -} { 0x0 0x6 0x22 0x421b 0xfffffffffffffff4} +} { 0 0x6 0x22 0x421b 0xfffffffffffffff4} test format-1.10 {integer formatting} longIs32bit { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 -} {0x0 0x6 0x22 0x421b 0xfffffff4 } +} {0 0x6 0x22 0x421b 0xfffffff4 } test format-1.10.1 {integer formatting} longIs64bit { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 -} {0x0 0x6 0x22 0x421b 0xfffffffffffffff4 } +} {0 0x6 0x22 0x421b 0xfffffffffffffff4 } test format-1.11 {integer formatting} longIs32bit { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 -} {0 06 042 041033 037777777764 } +} {0 0o6 0o42 0o41033 0o37777777764 } test format-1.11.1 {integer formatting} longIs64bit { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 -} {0 06 042 041033 01777777777777777777764} +} {0 0o6 0o42 0o41033 0o1777777777777777777764} test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] -} {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} +} {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} test format-1.13 {integer formatting} { format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1 -} {0d0 0d6 0d34 0d16923 -0d12} +} {0 0d6 0d34 0d16923 -0d12} test format-1.14 {integer formatting} { format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1 -} {0d000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} +} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} test format-1.15 {integer formatting} { format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1 -} {0d000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} +} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} test format-2.1 {string formatting} { diff --git a/tests/io.test b/tests/io.test index 3fc370d..fb04a5b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -5638,7 +5638,7 @@ test io-40.2 {POSIX open access modes: CREAT} {unix} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats - set x [format "0o%o" [expr $stats(mode)&0o777]] + set x [format "%#o" [expr $stats(mode)&0o777]] puts $f "line 1" close $f set f [open $path(test3) r] -- cgit v0.12 From 4401a58b2a11919b4b98ff792f925bf967ffb232 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 28 Jun 2017 11:02:19 +0000 Subject: Implement %a and %A for floating point numbers --- generic/tclStringObj.c | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 43c8f6c..6457eb3 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2263,6 +2263,8 @@ Tcl_AppendFormatToObj( break; } + case 'a': + case 'A': case 'e': case 'E': case 'f': @@ -2343,9 +2345,12 @@ Tcl_AppendFormatToObj( } switch (ch) { - case 'E': - case 'G': { - Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment))); + case 'A': { + char *p = TclGetString(segment); + p[1] = 'x'; + p = strchr(p, 'P'); + if (p) *p = 'p'; + break; } } -- cgit v0.12 From c86a23de04031e905caf60b8b28dfeed64b8ba5f Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Thu, 17 Aug 2017 13:02:27 +0000 Subject: Basic scaffolding for tcl::process --- generic/tclBasic.c | 1 + generic/tclInt.h | 1 + generic/tclProcess.c | 175 +++++++++++++++++++++++++++++++++++++++++++++++++++ tests/process.test | 21 +++++++ unix/Makefile.in | 6 +- win/Makefile.in | 1 + win/buildall.vc.bat | 4 +- win/makefile.vc | 1 + win/tcl.dsp | 4 ++ 9 files changed, 212 insertions(+), 2 deletions(-) create mode 100644 generic/tclProcess.c create mode 100644 tests/process.test diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8e816a5..b4821ef 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -813,6 +813,7 @@ Tcl_CreateInterp(void) TclInitNamespaceCmd(interp); TclInitStringCmd(interp); TclInitPrefixCmd(interp); + TclInitProcessCmd(interp); /* * Register "clock" subcommands. These *do* go through diff --git a/generic/tclInt.h b/generic/tclInt.h index 1fbc541..ce6cc1c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3414,6 +3414,7 @@ MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); +MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclProcess.c b/generic/tclProcess.c new file mode 100644 index 0000000..3fcdacd --- /dev/null +++ b/generic/tclProcess.c @@ -0,0 +1,175 @@ +/* + * tclProcess.c -- + * + * This file implements the "tcl::process" ensemble for subprocess + * management as defined by TIP #462. + * + * Copyright (c) 2017 Frederic Bonnet. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + #include "tclInt.h" + + /* + * Prototypes for functions defined later in this file: + */ + +static int ProcessListObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessStatusObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessPurgeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessAutopurgeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); + +/*---------------------------------------------------------------------- + * + * ProcessListObjCmd -- + * + * This function implements the 'tcl::process list' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessListObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/*---------------------------------------------------------------------- + * + * ProcessStatusObjCmd -- + * + * This function implements the 'tcl::process status' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessStatusObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/*---------------------------------------------------------------------- + * + * ProcessPurgeObjCmd -- + * + * This function implements the 'tcl::process purge' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessPurgeObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/*---------------------------------------------------------------------- + * + * ProcessAutopurgeObjCmd -- + * + * This function implements the 'tcl::process autopurge' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessAutopurgeObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/* + *---------------------------------------------------------------------- + * + * TclInitProcessCmd -- + * + * This procedure creates the "tcl::process" Tcl command. See the user + * documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + Tcl_Command + TclInitProcessCmd( + Tcl_Interp *interp) /* Current interpreter. */ + { + static const EnsembleImplMap processImplMap[] = { + {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, + {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, + {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {NULL, NULL, NULL, NULL, NULL, 0} + }; + Tcl_Command processCmd; + + processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); + Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), + "process", 0); + return processCmd; + } + \ No newline at end of file diff --git a/tests/process.test b/tests/process.test new file mode 100644 index 0000000..f3275c8 --- /dev/null +++ b/tests/process.test @@ -0,0 +1,21 @@ +# process.test -- +# +# This file contains a collection of tests for the tcl::process ensemble. +# Sourcing this file into Tcl runs the tests and generates output for +# errors. No output means no errors were found. +# +# Copyright (c) 2017 Frederic Bonnet +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +test process-1.1 {tcl::process command basic syntax} -returnCodes error -body { + tcl::process +} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"} +test process-1.2 {tcl::process command basic syntax} -returnCodes error -body { + tcl::process ? +} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status} diff --git a/unix/Makefile.in b/unix/Makefile.in index c4f6136..25aa003 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -303,7 +303,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \ tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ tclPkg.o tclPkgConfig.o tclPosixStr.o \ - tclPreserve.o tclProc.o tclRegexp.o \ + tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ @@ -444,6 +444,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclPosixStr.c \ $(GENERIC_DIR)/tclPreserve.c \ $(GENERIC_DIR)/tclProc.c \ + $(GENERIC_DIR)/tclProcess.c \ $(GENERIC_DIR)/tclRegexp.c \ $(GENERIC_DIR)/tclResolve.c \ $(GENERIC_DIR)/tclResult.c \ @@ -1286,6 +1287,9 @@ tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c +tclProcess.o: $(GENERIC_DIR)/tclProcess.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProcess.c + tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c diff --git a/win/Makefile.in b/win/Makefile.in index e967ef3..ad8db34 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -285,6 +285,7 @@ GENERIC_OBJS = \ tclPosixStr.$(OBJEXT) \ tclPreserve.$(OBJEXT) \ tclProc.$(OBJEXT) \ + tclProcess.$(OBJEXT) \ tclRegexp.$(OBJEXT) \ tclResolve.$(OBJEXT) \ tclResult.$(OBJEXT) \ diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat index deb9e39..cb136be 100644 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -38,7 +38,9 @@ if defined WINDOWSSDKDIR (goto :startBuilding) :: might not be correct. You should call it yourself prior to running :: this batchfile. :: -call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" +REM call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" +set "VSCMD_START_DIR=%CD%" +call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat" if errorlevel 1 (goto no_vcvars) :startBuilding diff --git a/win/makefile.vc b/win/makefile.vc index d6de5e1..bdc8511 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -327,6 +327,7 @@ COREOBJS = \ $(TMP_DIR)\tclPosixStr.obj \ $(TMP_DIR)\tclPreserve.obj \ $(TMP_DIR)\tclProc.obj \ + $(TMP_DIR)\tclProcess.obj \ $(TMP_DIR)\tclRegexp.obj \ $(TMP_DIR)\tclResolve.obj \ $(TMP_DIR)\tclResult.obj \ diff --git a/win/tcl.dsp b/win/tcl.dsp index 48eae9d..e3873a3 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1268,6 +1268,10 @@ SOURCE=..\generic\tclProc.c # End Source File # Begin Source File +SOURCE=..\generic\tclProcess.c +# End Source File +# Begin Source File + SOURCE=..\generic\tclRegexp.c # End Source File # Begin Source File -- cgit v0.12 From 0b8e964f45cff8228e6e64598b7f7f80060aa345 Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Thu, 17 Aug 2017 13:03:48 +0000 Subject: Fixed line endings --- generic/tclProcess.c | 348 +++++++++++++++++++++++++-------------------------- tests/process.test | 42 +++---- 2 files changed, 195 insertions(+), 195 deletions(-) diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 3fcdacd..516d0d7 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -1,175 +1,175 @@ -/* - * tclProcess.c -- - * - * This file implements the "tcl::process" ensemble for subprocess - * management as defined by TIP #462. - * - * Copyright (c) 2017 Frederic Bonnet. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - - #include "tclInt.h" - - /* - * Prototypes for functions defined later in this file: - */ - -static int ProcessListObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ProcessStatusObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ProcessPurgeObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ProcessAutopurgeObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); - -/*---------------------------------------------------------------------- - * - * ProcessListObjCmd -- - * - * This function implements the 'tcl::process list' Tcl command. - * Refer to the user documentation for details on what it does. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None.TODO - * - *---------------------------------------------------------------------- - */ - - static int - ProcessListObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { - /* TODO */ - return TCL_ERROR; - } - -/*---------------------------------------------------------------------- - * - * ProcessStatusObjCmd -- - * - * This function implements the 'tcl::process status' Tcl command. - * Refer to the user documentation for details on what it does. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None.TODO - * - *---------------------------------------------------------------------- - */ - - static int - ProcessStatusObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { - /* TODO */ - return TCL_ERROR; - } - -/*---------------------------------------------------------------------- - * - * ProcessPurgeObjCmd -- - * - * This function implements the 'tcl::process purge' Tcl command. - * Refer to the user documentation for details on what it does. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None.TODO - * - *---------------------------------------------------------------------- - */ - - static int - ProcessPurgeObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { - /* TODO */ - return TCL_ERROR; - } - -/*---------------------------------------------------------------------- - * - * ProcessAutopurgeObjCmd -- - * - * This function implements the 'tcl::process autopurge' Tcl command. - * Refer to the user documentation for details on what it does. - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * None.TODO - * - *---------------------------------------------------------------------- - */ - - static int - ProcessAutopurgeObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { - /* TODO */ - return TCL_ERROR; - } - -/* - *---------------------------------------------------------------------- - * - * TclInitProcessCmd -- - * - * This procedure creates the "tcl::process" Tcl command. See the user - * documentation for details on what it does. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ - - Tcl_Command - TclInitProcessCmd( - Tcl_Interp *interp) /* Current interpreter. */ - { - static const EnsembleImplMap processImplMap[] = { - {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, - {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, - {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, - {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, - {NULL, NULL, NULL, NULL, NULL, 0} - }; - Tcl_Command processCmd; - - processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); - Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), - "process", 0); - return processCmd; - } +/* + * tclProcess.c -- + * + * This file implements the "tcl::process" ensemble for subprocess + * management as defined by TIP #462. + * + * Copyright (c) 2017 Frederic Bonnet. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + + #include "tclInt.h" + + /* + * Prototypes for functions defined later in this file: + */ + +static int ProcessListObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessStatusObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessPurgeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessAutopurgeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); + +/*---------------------------------------------------------------------- + * + * ProcessListObjCmd -- + * + * This function implements the 'tcl::process list' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessListObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/*---------------------------------------------------------------------- + * + * ProcessStatusObjCmd -- + * + * This function implements the 'tcl::process status' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessStatusObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/*---------------------------------------------------------------------- + * + * ProcessPurgeObjCmd -- + * + * This function implements the 'tcl::process purge' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessPurgeObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/*---------------------------------------------------------------------- + * + * ProcessAutopurgeObjCmd -- + * + * This function implements the 'tcl::process autopurge' Tcl command. + * Refer to the user documentation for details on what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None.TODO + * + *---------------------------------------------------------------------- + */ + + static int + ProcessAutopurgeObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ + { + /* TODO */ + return TCL_ERROR; + } + +/* + *---------------------------------------------------------------------- + * + * TclInitProcessCmd -- + * + * This procedure creates the "tcl::process" Tcl command. See the user + * documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + Tcl_Command + TclInitProcessCmd( + Tcl_Interp *interp) /* Current interpreter. */ + { + static const EnsembleImplMap processImplMap[] = { + {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, + {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, + {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {NULL, NULL, NULL, NULL, NULL, 0} + }; + Tcl_Command processCmd; + + processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); + Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), + "process", 0); + return processCmd; + } \ No newline at end of file diff --git a/tests/process.test b/tests/process.test index f3275c8..cef3adc 100644 --- a/tests/process.test +++ b/tests/process.test @@ -1,21 +1,21 @@ -# process.test -- -# -# This file contains a collection of tests for the tcl::process ensemble. -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. -# -# Copyright (c) 2017 Frederic Bonnet -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -test process-1.1 {tcl::process command basic syntax} -returnCodes error -body { - tcl::process -} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"} -test process-1.2 {tcl::process command basic syntax} -returnCodes error -body { - tcl::process ? -} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status} +# process.test -- +# +# This file contains a collection of tests for the tcl::process ensemble. +# Sourcing this file into Tcl runs the tests and generates output for +# errors. No output means no errors were found. +# +# Copyright (c) 2017 Frederic Bonnet +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +test process-1.1 {tcl::process command basic syntax} -returnCodes error -body { + tcl::process +} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"} +test process-1.2 {tcl::process command basic syntax} -returnCodes error -body { + tcl::process ? +} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status} -- cgit v0.12 From 5aaef06572dc90a7a493d187959fe9829da27fbb Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Fri, 18 Aug 2017 07:51:01 +0000 Subject: Added [tcl::process autopurge] flag management with TclProcessGetAutopurge/TclProcessSetAutopurge companion functions. --- generic/tclInt.h | 9 ++- generic/tclProcess.c | 176 +++++++++++++++++++++++++++++++++++++-------------- tests/process.test | 10 +++ 3 files changed, 148 insertions(+), 47 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index ce6cc1c..a602e6c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3414,7 +3414,6 @@ MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); -MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -4023,6 +4022,14 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); /* + * TIP #462. + */ + +MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); +MODULE_SCOPE int TclProcessGetAutopurge(void); +MODULE_SCOPE void TclProcessSetAutopurge(int flag); + +/* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 516d0d7..23ba4de 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -10,7 +10,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ - #include "tclInt.h" +#include "tclInt.h" + +static int autopurge = 1; /* Autopurge flag. */ /* * Prototypes for functions defined later in this file: @@ -45,13 +47,18 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, *---------------------------------------------------------------------- */ - static int - ProcessListObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { +static int +ProcessListObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + /* TODO */ return TCL_ERROR; } @@ -72,13 +79,18 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, *---------------------------------------------------------------------- */ - static int - ProcessStatusObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { +static int +ProcessStatusObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc < 1) { + Tcl_WrongNumArgs(interp, 1, objv, "?switches? ?pids?"); + return TCL_ERROR; + } + /* TODO */ return TCL_ERROR; } @@ -99,13 +111,18 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, *---------------------------------------------------------------------- */ - static int - ProcessPurgeObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ - { +static int +ProcessPurgeObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc != 1 && objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?pids?"); + return TCL_ERROR; + } + /* TODO */ return TCL_ERROR; } @@ -126,17 +143,40 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, *---------------------------------------------------------------------- */ - static int - ProcessAutopurgeObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ +static int +ProcessAutopurgeObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - /* TODO */ - return TCL_ERROR; - } - + if (objc != 1 && objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?flag?"); + return TCL_ERROR; + } + + if (objc == 2) { + /* + * Set given value. + */ + + int flag; + int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag); + if (result != TCL_OK) { + return result; + } + + TclProcessSetAutopurge(flag); + } + + /* + * Return current value. + */ + + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(TclProcessGetAutopurge())); + return TCL_OK; +} + /* *---------------------------------------------------------------------- * @@ -154,22 +194,66 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, *---------------------------------------------------------------------- */ - Tcl_Command - TclInitProcessCmd( - Tcl_Interp *interp) /* Current interpreter. */ - { - static const EnsembleImplMap processImplMap[] = { +Tcl_Command +TclInitProcessCmd( + Tcl_Interp *interp) /* Current interpreter. */ +{ + static const EnsembleImplMap processImplMap[] = { {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} - }; - Tcl_Command processCmd; - - processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); - Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), - "process", 0); - return processCmd; - } - \ No newline at end of file + }; + Tcl_Command processCmd; + + processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); + Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), + "process", 0); + return processCmd; +} + +/* + *---------------------------------------------------------------------- + * + * TclProcessGetAutopurge -- + * + * This function queries the value of the autopurge flag. + * + * Results: + * The current boolean value of the autopurge flag. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclProcessGetAutopurge(void) +{ + return autopurge; +} + +/* + *---------------------------------------------------------------------- + * + * TclProcessSetAutopurge -- + * + * This function sets the value of the autopurge flag. + * + * Results: + * None. + * + * Side effects: + * Sets the autopurge static variable. + * + *---------------------------------------------------------------------- + */ + +void +TclProcessSetAutopurge( + int flag) /* New value for autopurge. */ +{ + autopurge = !!flag; +} diff --git a/tests/process.test b/tests/process.test index cef3adc..fb3a5e2 100644 --- a/tests/process.test +++ b/tests/process.test @@ -19,3 +19,13 @@ test process-1.1 {tcl::process command basic syntax} -returnCodes error -body { test process-1.2 {tcl::process command basic syntax} -returnCodes error -body { tcl::process ? } -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status} + +test process-2.1 {tcl::process autopurge get} {tcl::process autopurge} {1} +test process-2.2 {tcl::process autopurge set true} { + tcl::process autopurge true + tcl::process autopurge +} {1} +test process-2.3 {tcl::process autopurge set false} { + tcl::process autopurge false + tcl::process autopurge +} {0} -- cgit v0.12 From 03470df2ff2414f1912a85772cd6f558196ca8bc Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Fri, 18 Aug 2017 12:49:08 +0000 Subject: Completed [tcl::process autopurge] semantics and added [tcl::process purge] implementation along with the necessary internal functions TclpGetChildPid/TclReapPids --- generic/tclInt.h | 2 ++ generic/tclIntPlatDecls.h | 2 ++ generic/tclPipe.c | 59 ++++++++++++++++++++++++++++++++++++++++++++++- generic/tclProcess.c | 45 +++++++++++++++++++++++++++++++++--- unix/tclUnixPipe.c | 4 +++- win/tclWinPipe.c | 42 ++++++++++++++++++++++++++++++++- 6 files changed, 148 insertions(+), 6 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index a602e6c..3e99f91 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4028,6 +4028,8 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); MODULE_SCOPE int TclProcessGetAutopurge(void); MODULE_SCOPE void TclProcessSetAutopurge(int flag); +MODULE_SCOPE void TclReapPids(int numPids, Tcl_Pid *pidPtr); +MODULE_SCOPE Tcl_Pid TclpGetChildPid(int id); /* *---------------------------------------------------------------- diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 494d6f1..4770747 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -562,6 +562,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #else # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) +# undef TclpGetChildPid +# define TclpGetChildPid(id) ((Tcl_Pid) (id)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclPipe.c b/generic/tclPipe.c index d6cd188..c98ee7e 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -247,6 +247,61 @@ Tcl_ReapDetachedProcs(void) /* *---------------------------------------------------------------------- * + * TclReapPids -- + * + * This function is similar to Tcl_ReapDetachedProcs but works on a + * subset of processes. + * + * Results: + * None. + * + * Side effects: + * Processes are waited on, so that they can be reaped by the system. + * + *---------------------------------------------------------------------- + */ + +void +TclReapPids( + int numPids, /* Number of pids to detach: gives size of + * array pointed to by pidPtr. */ + Tcl_Pid *pidPtr) /* Array of pids to detach. */ +{ + register Detached *detPtr; + Detached *nextPtr, *prevPtr; + int status; + Tcl_Pid pid; + int i; + + Tcl_MutexLock(&pipeMutex); + for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { + pid = 0; + for (i = 0; i < numPids; i++) { + if (detPtr->pid == pidPtr[i]) { + pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG); + break; + } + } + if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { + prevPtr = detPtr; + detPtr = detPtr->nextPtr; + continue; + } + nextPtr = detPtr->nextPtr; + if (prevPtr == NULL) { + detList = detPtr->nextPtr; + } else { + prevPtr->nextPtr = detPtr->nextPtr; + } + ckfree(detPtr); + detPtr = nextPtr; + } + Tcl_MutexUnlock(&pipeMutex); +} + +/* + *---------------------------------------------------------------------- + * * TclCleanupChildren -- * * This is a utility function used to wait for child processes to exit, @@ -854,7 +909,9 @@ TclCreatePipeline( * arguments between the "|" characters. */ - Tcl_ReapDetachedProcs(); + if (TclProcessGetAutopurge()) { + Tcl_ReapDetachedProcs(); + } pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid)); curInFile = inputFile; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 23ba4de..2557067 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -123,8 +123,47 @@ ProcessPurgeObjCmd( return TCL_ERROR; } - /* TODO */ - return TCL_ERROR; + if (objc == 1) { + /* + * Purge all detached processes. + */ + + Tcl_ReapDetachedProcs(); + } else { + int result; + int numPids; + Tcl_Obj **pidObjs; + Tcl_Pid *pids; + int id; + int i; + + /* + * Get pids from argument. + */ + + result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); + if (result != TCL_OK) { + return result; + } + pids = (Tcl_Pid *) TclStackAlloc(interp, numPids * sizeof(Tcl_Pid)); + for (i = 0; i < numPids; i++) { + result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &id); + if (result != TCL_OK) { + TclStackFree(interp, (void *) pids); + return result; + } + pids[i] = TclpGetChildPid(id); + } + + /* + * Purge only provided processes. + */ + + TclReapPids(numPids, pids); + TclStackFree(interp, (void *) pids); + } + + return TCL_OK; } /*---------------------------------------------------------------------- @@ -138,7 +177,7 @@ ProcessPurgeObjCmd( * Returns a standard Tcl result. * * Side effects: - * None.TODO + * Alters detached process handling by Tcl_ReapDetachedProcs(). * *---------------------------------------------------------------------- */ diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index be7b4eb..3d8e680 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -986,7 +986,9 @@ PipeClose2Proc( */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); - Tcl_ReapDetachedProcs(); + if (TclProcessGetAutopurge()) { + Tcl_ReapDetachedProcs(); + } if (pipePtr->errorFile) { TclpCloseFile(pipePtr->errorFile); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4666deb..6dd2173 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -884,6 +884,44 @@ TclpGetPid( Tcl_MutexUnlock(&pipeMutex); return (unsigned long) -1; } + +/* + *-------------------------------------------------------------------------- + * + * TclpGetChildPid -- + * + * Given a process id of a child process, return the HANDLE for that + * child process. + * + * Results: + * Returns the HANDLE for the child process. If the id was not known + * by Tcl, either because the id was not created by Tcl or the child + * process has already been reaped, NULL is returned. + * + * Side effects: + * None. + * + *-------------------------------------------------------------------------- + */ + +Tcl_Pid +TclpGetChildPid( + int id) /* The process id of the child process. */ +{ + ProcInfo *infoPtr; + + PipeInit(); + + Tcl_MutexLock(&pipeMutex); + for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { + if (infoPtr->dwProcessId == (DWORD) id) { + Tcl_MutexUnlock(&pipeMutex); + return (Tcl_Pid) infoPtr->hProcess; + } + } + Tcl_MutexUnlock(&pipeMutex); + return (Tcl_Pid) NULL; +} /* *---------------------------------------------------------------------- @@ -1991,7 +2029,9 @@ PipeClose2Proc( */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); - Tcl_ReapDetachedProcs(); + if (TclProcessGetAutopurge()) { + Tcl_ReapDetachedProcs(); + } if (pipePtr->errorFile) { if (TclpCloseFile(pipePtr->errorFile) != 0) { -- cgit v0.12 From 8dd2373a08bd2ec8d5796041d0f8945d24a811c1 Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Wed, 23 Aug 2017 18:31:56 +0000 Subject: Refactoring and preliminary implementation of tcl::process (list|status) --- generic/tclInt.h | 6 +- generic/tclIntPlatDecls.h | 2 - generic/tclPipe.c | 65 +------ generic/tclProcess.c | 455 ++++++++++++++++++++++++++++++++++++++-------- unix/tclUnixPipe.c | 4 +- win/tclWinPipe.c | 42 +---- 6 files changed, 383 insertions(+), 191 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 3e99f91..dcdf2f6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4026,10 +4026,8 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); */ MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclProcessGetAutopurge(void); -MODULE_SCOPE void TclProcessSetAutopurge(int flag); -MODULE_SCOPE void TclReapPids(int numPids, Tcl_Pid *pidPtr); -MODULE_SCOPE Tcl_Pid TclpGetChildPid(int id); +MODULE_SCOPE void TclProcessDetach(Tcl_Pid pid); +MODULE_SCOPE int TclProcessStatus(Tcl_Pid pid, int options); /* *---------------------------------------------------------------- diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 4770747..494d6f1 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -562,8 +562,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #else # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) -# undef TclpGetChildPid -# define TclpGetChildPid(id) ((Tcl_Pid) (id)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclPipe.c b/generic/tclPipe.c index c98ee7e..e7c419d 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -192,6 +192,7 @@ Tcl_DetachPids( detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; + TclProcessDetach(pidPtr[i]); } Tcl_MutexUnlock(&pipeMutex); @@ -221,13 +222,10 @@ Tcl_ReapDetachedProcs(void) { register Detached *detPtr; Detached *nextPtr, *prevPtr; - int status; - Tcl_Pid pid; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { - pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG); - if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { + if (!TclProcessStatus(detPtr->pid, WNOHANG)) { prevPtr = detPtr; detPtr = detPtr->nextPtr; continue; @@ -247,61 +245,6 @@ Tcl_ReapDetachedProcs(void) /* *---------------------------------------------------------------------- * - * TclReapPids -- - * - * This function is similar to Tcl_ReapDetachedProcs but works on a - * subset of processes. - * - * Results: - * None. - * - * Side effects: - * Processes are waited on, so that they can be reaped by the system. - * - *---------------------------------------------------------------------- - */ - -void -TclReapPids( - int numPids, /* Number of pids to detach: gives size of - * array pointed to by pidPtr. */ - Tcl_Pid *pidPtr) /* Array of pids to detach. */ -{ - register Detached *detPtr; - Detached *nextPtr, *prevPtr; - int status; - Tcl_Pid pid; - int i; - - Tcl_MutexLock(&pipeMutex); - for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { - pid = 0; - for (i = 0; i < numPids; i++) { - if (detPtr->pid == pidPtr[i]) { - pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG); - break; - } - } - if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { - prevPtr = detPtr; - detPtr = detPtr->nextPtr; - continue; - } - nextPtr = detPtr->nextPtr; - if (prevPtr == NULL) { - detList = detPtr->nextPtr; - } else { - prevPtr->nextPtr = detPtr->nextPtr; - } - ckfree(detPtr); - detPtr = nextPtr; - } - Tcl_MutexUnlock(&pipeMutex); -} - -/* - *---------------------------------------------------------------------- - * * TclCleanupChildren -- * * This is a utility function used to wait for child processes to exit, @@ -909,9 +852,7 @@ TclCreatePipeline( * arguments between the "|" characters. */ - if (TclProcessGetAutopurge()) { - Tcl_ReapDetachedProcs(); - } + Tcl_ReapDetachedProcs(); pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid)); curInFile = inputFile; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 2557067..733b1d7 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -12,22 +12,45 @@ #include "tclInt.h" +/* + * Autopurge flag. Process-global because of the way Tcl manages child + * processes (see tclPipe.c). + */ + static int autopurge = 1; /* Autopurge flag. */ +/* + * Hash table that keeps track of all child process statuses. Keys are the + * child process ids, values are (ProcessInfo *). + */ + +typedef struct ProcessInfo { + Tcl_Pid pid; /*FRED TODO*/ + int resolvedPid; /*FRED TODO unused?*/ + Tcl_Obj *status; /*FRED TODO*/ + +} ProcessInfo; +static Tcl_HashTable statusTable; +static int statusTableInitialized = 0; /* 0 means not yet initialized. */ +TCL_DECLARE_MUTEX(statusMutex) + /* * Prototypes for functions defined later in this file: */ -static int ProcessListObjCmd(ClientData clientData, +static int GetProcessStatus(Tcl_Pid pid, int resolvedPid, + int options, Tcl_Obj **statusPtr); +static int PurgeProcessStatus(Tcl_HashEntry *entry); +static int ProcessListObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ProcessStatusObjCmd(ClientData clientData, +static int ProcessStatusObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ProcessPurgeObjCmd(ClientData clientData, +static int ProcessPurgeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ProcessAutopurgeObjCmd(ClientData clientData, +static int ProcessAutopurgeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -42,7 +65,7 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, * Returns a standard Tcl result. * * Side effects: - * None.TODO + * None.FRED TODO * *---------------------------------------------------------------------- */ @@ -50,18 +73,36 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, static int ProcessListObjCmd( ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tcl_Obj *result; + Tcl_HashEntry *entry; + Tcl_HashSearch search; + ProcessInfo *info; + if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - /* TODO */ - return TCL_ERROR; - } + /* + * Return the list of all chid process ids. + */ + + result = Tcl_NewListObj(0, NULL); + Tcl_MutexLock(&statusMutex); + for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + Tcl_ListObjAppendElement(interp, result, + Tcl_NewIntObj(info->resolvedPid)); + } + Tcl_MutexUnlock(&statusMutex); + Tcl_SetObjResult(interp, result); + return TCL_OK; +} /*---------------------------------------------------------------------- * @@ -74,7 +115,7 @@ ProcessListObjCmd( * Returns a standard Tcl result. * * Side effects: - * None.TODO + * None.FRED TODO * *---------------------------------------------------------------------- */ @@ -82,18 +123,61 @@ ProcessListObjCmd( static int ProcessStatusObjCmd( ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tcl_Obj *result; + int options; + Tcl_HashEntry *entry; + Tcl_HashSearch search; + ProcessInfo *info; + if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? ?pids?"); return TCL_ERROR; } - /* TODO */ - return TCL_ERROR; - } + /* FRED TODO switches */ + options = WNOHANG; + + /* + * Return the list of all chid process statuses. + */ + + result = Tcl_NewDictObj(); + Tcl_MutexLock(&statusMutex); + for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (autopurge) { + if (GetProcessStatus(info->pid, info->resolvedPid, options, + NULL)) { + /* + * Purge. + */ + + PurgeProcessStatus(entry); + Tcl_DeleteHashEntry(entry); + continue; + } + } else if (!info->status) { + /* + * Update status. + */ + + if (GetProcessStatus(info->pid, info->resolvedPid, options, + &info->status)) { + Tcl_IncrRefCount(info->status); + } + } + Tcl_DictObjPut(interp, result, Tcl_NewIntObj(info->resolvedPid), + info->status ? info->status : Tcl_NewObj()); + } + Tcl_MutexUnlock(&statusMutex); + Tcl_SetObjResult(interp, result); + return TCL_OK; +} /*---------------------------------------------------------------------- * @@ -106,7 +190,7 @@ ProcessStatusObjCmd( * Returns a standard Tcl result. * * Side effects: - * None.TODO + * None.FRED TODO * *---------------------------------------------------------------------- */ @@ -114,57 +198,65 @@ ProcessStatusObjCmd( static int ProcessPurgeObjCmd( ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tcl_HashEntry *entry; + Tcl_HashSearch search; + int numPids; + Tcl_Obj **pidObjs; + int result; + int i; + int pid; + if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pids?"); return TCL_ERROR; } +//FRED TODO update status list first. + if (objc == 1) { /* - * Purge all detached processes. + * Purge all terminated processes. */ - - Tcl_ReapDetachedProcs(); - } else { - int result; - int numPids; - Tcl_Obj **pidObjs; - Tcl_Pid *pids; - int id; - int i; + Tcl_MutexLock(&statusMutex); + for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + if (PurgeProcessStatus(entry)) { + Tcl_DeleteHashEntry(entry); + } + } + Tcl_MutexUnlock(&statusMutex); + } else { /* - * Get pids from argument. + * Purge only provided processes. */ result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } - pids = (Tcl_Pid *) TclStackAlloc(interp, numPids * sizeof(Tcl_Pid)); + Tcl_MutexLock(&statusMutex); for (i = 0; i < numPids; i++) { - result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &id); + result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); if (result != TCL_OK) { - TclStackFree(interp, (void *) pids); + Tcl_MutexUnlock(&statusMutex); return result; } - pids[i] = TclpGetChildPid(id); - } - /* - * Purge only provided processes. - */ - - TclReapPids(numPids, pids); - TclStackFree(interp, (void *) pids); + entry = Tcl_FindHashEntry(&statusTable, INT2PTR(pid)); + if (entry && PurgeProcessStatus(entry)) { + Tcl_DeleteHashEntry(entry); + } + } + Tcl_MutexUnlock(&statusMutex); } return TCL_OK; - } +} /*---------------------------------------------------------------------- * @@ -185,10 +277,10 @@ ProcessPurgeObjCmd( static int ProcessAutopurgeObjCmd( ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ - { +{ if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "?flag?"); return TCL_ERROR; @@ -205,14 +297,14 @@ ProcessAutopurgeObjCmd( return result; } - TclProcessSetAutopurge(flag); + autopurge = !!flag; } /* * Return current value. */ - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(TclProcessGetAutopurge())); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge)); return TCL_OK; } @@ -246,53 +338,258 @@ TclInitProcessCmd( }; Tcl_Command processCmd; + if (statusTableInitialized == 0) { + Tcl_MutexLock(&statusMutex); + if (statusTableInitialized == 0) { + Tcl_InitHashTable(&statusTable, TCL_ONE_WORD_KEYS); + statusTableInitialized = 1; + } + Tcl_MutexUnlock(&statusMutex); + } + processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), "process", 0); return processCmd; } -/* - *---------------------------------------------------------------------- - * - * TclProcessGetAutopurge -- - * - * This function queries the value of the autopurge flag. - * - * Results: - * The current boolean value of the autopurge flag. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ +/* FRED TODO */ +void +TclProcessDetach( + Tcl_Pid pid) +{ + int resolvedPid; + Tcl_HashEntry *entry; + int isNew; + ProcessInfo *info; + + resolvedPid = TclpGetPid(pid); + Tcl_MutexLock(&statusMutex); + entry = Tcl_CreateHashEntry(&statusTable, INT2PTR(resolvedPid), &isNew); + if (!isNew) { + /* + * Pid was reused, free old status and reuse structure. + */ + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->status) { + Tcl_DecrRefCount(info->status); + } + } else { + /* + * Allocate new info structure. + */ + info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); + Tcl_SetHashValue(entry, info); + } + + /* + * Initialize with an empty status. + */ + + info->pid = pid; + info->resolvedPid = resolvedPid; + info->status = NULL; + + Tcl_MutexUnlock(&statusMutex); +} + +/* FRED TODO */ int -TclProcessGetAutopurge(void) +TclProcessStatus( + Tcl_Pid pid, + int options) { - return autopurge; + int resolvedPid; + Tcl_HashEntry *entry; + ProcessInfo *info; + Tcl_Obj *status; + int isNew; + + /* + * We need to get the resolved pid before we wait on it as the windows + * implementation of Tcl_WaitPid deletes the information such that any + * following calls to TclpGetPid fail. + */ + + resolvedPid = TclpGetPid(pid); + + if (!GetProcessStatus(pid, resolvedPid, options, + (autopurge ? NULL /* unused */: &status))) { + /* + * Process still alive, or non child-related error. + */ + + return 0; + } + + if (autopurge) { + /* + * Child terminated, purge. + */ + + Tcl_MutexLock(&statusMutex); + entry = Tcl_FindHashEntry(&statusTable, INT2PTR(resolvedPid)); + if (entry) { + PurgeProcessStatus(entry); + Tcl_DeleteHashEntry(entry); + } + Tcl_MutexUnlock(&statusMutex); + + return 1; + } + + /* + * Store process status. + */ + + Tcl_MutexLock(&statusMutex); + entry = Tcl_CreateHashEntry(&statusTable, INT2PTR(resolvedPid), &isNew); + if (!isNew) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->status) { + /* + * Free old status object. + */ + + Tcl_DecrRefCount(info->status); + } + } else { + /* + * Allocate new info structure. + */ + + info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); + info->pid = pid; + info->resolvedPid = resolvedPid; + Tcl_SetHashValue(entry, info); + } + + info->status = status; + Tcl_IncrRefCount(status); + Tcl_MutexUnlock(&statusMutex); + + return 1; } -/* - *---------------------------------------------------------------------- - * - * TclProcessSetAutopurge -- - * - * This function sets the value of the autopurge flag. - * - * Results: - * None. - * - * Side effects: - * Sets the autopurge static variable. - * - *---------------------------------------------------------------------- - */ +/* FRED TODO */ +int +GetProcessStatus( + Tcl_Pid pid, + int resolvedPid, + int options, + Tcl_Obj **statusPtr) +{ + int waitStatus; + Tcl_Obj *statusCodes[5]; + const char *msg; -void -TclProcessSetAutopurge( - int flag) /* New value for autopurge. */ + pid = Tcl_WaitPid(pid, &waitStatus, options); + if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { + /* + * Process still alive, or non child-related error. + */ + + return 0; + } + + if (!statusPtr) { + return 1; + } + + /* + * Get process status. + */ + + if (pid == (Tcl_Pid) -1) { + /* + * POSIX errName msg + */ + + statusCodes[0] = Tcl_NewStringObj("POSIX", -1); + statusCodes[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); + msg = Tcl_ErrnoMsg(errno); + if (errno == ECHILD) { + /* + * This changeup in message suggested by Mark Diekhans to + * remind people that ECHILD errors can occur on some + * systems if SIGCHLD isn't in its default state. + */ + + msg = "child process lost (is SIGCHLD ignored or trapped?)"; + } + statusCodes[2] = Tcl_NewStringObj(msg, -1); + *statusPtr = Tcl_NewListObj(3, statusCodes); + } else if (WIFEXITED(waitStatus)) { + /* + * CHILDSTATUS pid code + * + * Child exited with a non-zero exit status. + */ + + statusCodes[0] = Tcl_NewStringObj("CHILDSTATUS", -1); + statusCodes[1] = Tcl_NewIntObj(resolvedPid); + statusCodes[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus)); + *statusPtr = Tcl_NewListObj(3, statusCodes); + } else if (WIFSIGNALED(waitStatus)) { + /* + * CHILDKILLED pid sigName msg + * + * Child killed because of a signal + */ + + statusCodes[0] = Tcl_NewStringObj("CHILDKILLED", -1); + statusCodes[1] = Tcl_NewIntObj(resolvedPid); + statusCodes[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1); + statusCodes[3] = Tcl_NewStringObj(Tcl_SignalMsg(WTERMSIG(waitStatus)), -1); + *statusPtr = Tcl_NewListObj(4, statusCodes); + } else if (WIFSTOPPED(waitStatus)) { + /* + * CHILDSUSP pid sigName msg + * + * Child suspended because of a signal + */ + + statusCodes[0] = Tcl_NewStringObj("CHILDSUSP", -1); + statusCodes[1] = Tcl_NewIntObj(resolvedPid); + statusCodes[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1); + statusCodes[3] = Tcl_NewStringObj(Tcl_SignalMsg(WSTOPSIG(waitStatus)), -1); + *statusPtr = Tcl_NewListObj(4, statusCodes); + } else { + /* + * TCL OPERATION EXEC ODDWAITRESULT + * + * Child wait status didn't make sense. + */ + + statusCodes[0] = Tcl_NewStringObj("TCL", -1); + statusCodes[1] = Tcl_NewStringObj("OPERATION", -1); + statusCodes[2] = Tcl_NewStringObj("EXEC", -1); + statusCodes[3] = Tcl_NewStringObj("ODDWAITRESULT", -1); + statusCodes[4] = Tcl_NewIntObj(resolvedPid); + *statusPtr = Tcl_NewListObj(5, statusCodes); + } + + return 1; +} + +/* FRED TODO */ +int +PurgeProcessStatus( + Tcl_HashEntry *entry) { - autopurge = !!flag; + ProcessInfo *info; + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->status) { + /* + * Process has ended, purge. + */ + + Tcl_DecrRefCount(info->status); + return 1; + } + + return 0; } diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 3d8e680..be7b4eb 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -986,9 +986,7 @@ PipeClose2Proc( */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); - if (TclProcessGetAutopurge()) { - Tcl_ReapDetachedProcs(); - } + Tcl_ReapDetachedProcs(); if (pipePtr->errorFile) { TclpCloseFile(pipePtr->errorFile); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 6dd2173..4666deb 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -884,44 +884,6 @@ TclpGetPid( Tcl_MutexUnlock(&pipeMutex); return (unsigned long) -1; } - -/* - *-------------------------------------------------------------------------- - * - * TclpGetChildPid -- - * - * Given a process id of a child process, return the HANDLE for that - * child process. - * - * Results: - * Returns the HANDLE for the child process. If the id was not known - * by Tcl, either because the id was not created by Tcl or the child - * process has already been reaped, NULL is returned. - * - * Side effects: - * None. - * - *-------------------------------------------------------------------------- - */ - -Tcl_Pid -TclpGetChildPid( - int id) /* The process id of the child process. */ -{ - ProcInfo *infoPtr; - - PipeInit(); - - Tcl_MutexLock(&pipeMutex); - for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (DWORD) id) { - Tcl_MutexUnlock(&pipeMutex); - return (Tcl_Pid) infoPtr->hProcess; - } - } - Tcl_MutexUnlock(&pipeMutex); - return (Tcl_Pid) NULL; -} /* *---------------------------------------------------------------------- @@ -2029,9 +1991,7 @@ PipeClose2Proc( */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); - if (TclProcessGetAutopurge()) { - Tcl_ReapDetachedProcs(); - } + Tcl_ReapDetachedProcs(); if (pipePtr->errorFile) { if (TclpCloseFile(pipePtr->errorFile) != 0) { -- cgit v0.12 From 57aa77515aae5d66471140213b35e4ff50972b0e Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Wed, 23 Aug 2017 19:51:02 +0000 Subject: Added switches and pid list support to tcl::process status --- generic/tclProcess.c | 159 ++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 119 insertions(+), 40 deletions(-) diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 733b1d7..99bb7e1 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -77,7 +77,7 @@ ProcessListObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *result; + Tcl_Obj *list; Tcl_HashEntry *entry; Tcl_HashSearch search; ProcessInfo *info; @@ -91,16 +91,16 @@ ProcessListObjCmd( * Return the list of all chid process ids. */ - result = Tcl_NewListObj(0, NULL); + list = Tcl_NewListObj(0, NULL); Tcl_MutexLock(&statusMutex); for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { info = (ProcessInfo *) Tcl_GetHashValue(entry); - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(info->resolvedPid)); } Tcl_MutexUnlock(&statusMutex); - Tcl_SetObjResult(interp, result); + Tcl_SetObjResult(interp, list); return TCL_OK; } @@ -127,55 +127,136 @@ ProcessStatusObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *result; - int options; + Tcl_Obj *dict; + int index, options = WNOHANG; Tcl_HashEntry *entry; Tcl_HashSearch search; ProcessInfo *info; + int numPids; + Tcl_Obj **pidObjs; + int result; + int i; + int pid; + Tcl_Obj *const *savedobjv = objv; + static const char *const switches[] = { + "-wait", "--", NULL + }; + enum switches { + STATUS_WAIT, STATUS_LAST + }; - if (objc < 1) { - Tcl_WrongNumArgs(interp, 1, objv, "?switches? ?pids?"); + while (objc > 1) { + if (TclGetString(objv[1])[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[1], switches, "switches", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + ++objv; --objc; + if (STATUS_WAIT == (enum switches) index) { + options = 0; + } else { + break; + } + } + + if (objc != 1 && objc != 2) { + Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?"); return TCL_ERROR; } - /* FRED TODO switches */ - options = WNOHANG; + if (objc == 1) { + /* + * Return the list of all child process statuses. + */ - /* - * Return the list of all chid process statuses. - */ + dict = Tcl_NewDictObj(); + Tcl_MutexLock(&statusMutex); + for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (autopurge) { + if (GetProcessStatus(info->pid, info->resolvedPid, options, + NULL)) { + /* + * Purge. + */ + + PurgeProcessStatus(entry); + Tcl_DeleteHashEntry(entry); + continue; + } + } else if (!info->status) { + /* + * Update status. + */ + + if (GetProcessStatus(info->pid, info->resolvedPid, options, + &info->status)) { + Tcl_IncrRefCount(info->status); + } + } + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + info->status ? info->status : Tcl_NewObj()); + } + Tcl_MutexUnlock(&statusMutex); + } else { + /* + * Only return statuses of provided processes. + */ + + result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); + if (result != TCL_OK) { + return result; + } + dict = Tcl_NewDictObj(); + Tcl_MutexLock(&statusMutex); + for (i = 0; i < numPids; i++) { + result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); + if (result != TCL_OK) { + Tcl_MutexUnlock(&statusMutex); + Tcl_DecrRefCount(dict); + return result; + } - result = Tcl_NewDictObj(); - Tcl_MutexLock(&statusMutex); - for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; - entry = Tcl_NextHashEntry(&search)) { - info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (autopurge) { - if (GetProcessStatus(info->pid, info->resolvedPid, options, - NULL)) { + entry = Tcl_FindHashEntry(&statusTable, INT2PTR(pid)); + if (!entry) { /* - * Purge. + * Skip unknown process. */ - - PurgeProcessStatus(entry); - Tcl_DeleteHashEntry(entry); + continue; } - } else if (!info->status) { - /* - * Update status. - */ - - if (GetProcessStatus(info->pid, info->resolvedPid, options, - &info->status)) { - Tcl_IncrRefCount(info->status); - } + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (autopurge) { + if (GetProcessStatus(info->pid, info->resolvedPid, options, + NULL)) { + /* + * Purge. + */ + + PurgeProcessStatus(entry); + Tcl_DeleteHashEntry(entry); + continue; + } + } else if (!info->status) { + /* + * Update status. + */ + + if (GetProcessStatus(info->pid, info->resolvedPid, options, + &info->status)) { + Tcl_IncrRefCount(info->status); + } + } + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + info->status ? info->status : Tcl_NewObj()); } - Tcl_DictObjPut(interp, result, Tcl_NewIntObj(info->resolvedPid), - info->status ? info->status : Tcl_NewObj()); + Tcl_MutexUnlock(&statusMutex); } - Tcl_MutexUnlock(&statusMutex); - Tcl_SetObjResult(interp, result); + Tcl_SetObjResult(interp, dict); return TCL_OK; } @@ -215,8 +296,6 @@ ProcessPurgeObjCmd( return TCL_ERROR; } -//FRED TODO update status list first. - if (objc == 1) { /* * Purge all terminated processes. -- cgit v0.12 From 43c89a019c37b43637956e0b21b5788f784b1972 Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Sun, 27 Aug 2017 11:05:45 +0000 Subject: Refactoring to support all processes and not just detached ones. --- generic/tclInt.h | 15 +- generic/tclPipe.c | 75 ++----- generic/tclProcess.c | 625 +++++++++++++++++++++++++++++---------------------- 3 files changed, 391 insertions(+), 324 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index dcdf2f6..c7a0a0d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4025,9 +4025,20 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); * TIP #462. */ +typedef enum TclProcessWaitStatus { + TCL_PROCESS_ERROR = -1, + TCL_PROCESS_UNCHANGED = 0, + TCL_PROCESS_EXITED = 1, + TCL_PROCESS_SIGNALED = 2, + TCL_PROCESS_STOPPED = 3, + TCL_PROCESS_UNKNOWN_STATUS = 4 +} TclProcessWaitStatus; + MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); -MODULE_SCOPE void TclProcessDetach(Tcl_Pid pid); -MODULE_SCOPE int TclProcessStatus(Tcl_Pid pid, int options); +MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid); +MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options, + int *codePtr, Tcl_Obj **msgObjPtr, + Tcl_Obj **errorObjPtr); /* *---------------------------------------------------------------- diff --git a/generic/tclPipe.c b/generic/tclPipe.c index e7c419d..d20d8eb 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -192,7 +192,6 @@ Tcl_DetachPids( detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; - TclProcessDetach(pidPtr[i]); } Tcl_MutexUnlock(&pipeMutex); @@ -222,10 +221,13 @@ Tcl_ReapDetachedProcs(void) { register Detached *detPtr; Detached *nextPtr, *prevPtr; + int status, code; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { - if (!TclProcessStatus(detPtr->pid, WNOHANG)) { + status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL); + if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR + && code != ECHILD)) { prevPtr = detPtr; detPtr = detPtr->nextPtr; continue; @@ -275,37 +277,18 @@ TclCleanupChildren( { int result = TCL_OK; int i, abnormalExit, anyErrorInfo; - Tcl_Pid pid; - int waitStatus; - const char *msg; - unsigned long resolvedPid; + TclProcessWaitStatus waitStatus; + int code; + Tcl_Obj *msg, *error; abnormalExit = 0; for (i = 0; i < numPids; i++) { - /* - * We need to get the resolved pid before we wait on it as the windows - * implementation of Tcl_WaitPid deletes the information such that any - * following calls to TclpGetPid fail. - */ - - resolvedPid = TclpGetPid(pidPtr[i]); - pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0); - if (pid == (Tcl_Pid) -1) { + waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error); + if (waitStatus == TCL_PROCESS_ERROR) { result = TCL_ERROR; if (interp != NULL) { - msg = Tcl_PosixError(interp); - if (errno == ECHILD) { - /* - * This changeup in message suggested by Mark Diekhans to - * remind people that ECHILD errors can occur on some - * systems if SIGCHLD isn't in its default state. - */ - - msg = - "child process lost (is SIGCHLD ignored or trapped?)"; - } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error waiting for process to exit: %s", msg)); + Tcl_SetObjErrorCode(interp, error); + Tcl_SetObjResult(interp, msg); } continue; } @@ -317,38 +300,17 @@ TclCleanupChildren( * removed). */ - if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) { - char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE]; - + if (waitStatus != TCL_PROCESS_EXITED || code != 0) { result = TCL_ERROR; - sprintf(msg1, "%lu", resolvedPid); - if (WIFEXITED(waitStatus)) { + if (waitStatus == TCL_PROCESS_EXITED) { if (interp != NULL) { - sprintf(msg2, "%u", WEXITSTATUS(waitStatus)); - Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL); + Tcl_SetObjErrorCode(interp, error); + Tcl_DecrRefCount(msg); } abnormalExit = 1; } else if (interp != NULL) { - const char *p; - - if (WIFSIGNALED(waitStatus)) { - p = Tcl_SignalMsg(WTERMSIG(waitStatus)); - Tcl_SetErrorCode(interp, "CHILDKILLED", msg1, - Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "child killed: %s\n", p)); - } else if (WIFSTOPPED(waitStatus)) { - p = Tcl_SignalMsg(WSTOPSIG(waitStatus)); - Tcl_SetErrorCode(interp, "CHILDSUSP", msg1, - Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "child suspended: %s\n", p)); - } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "child wait status didn't make sense\n", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", - "ODDWAITRESULT", msg1, NULL); - } + Tcl_SetObjErrorCode(interp, error); + Tcl_SetObjResult(interp, msg); } } } @@ -380,7 +342,7 @@ TclCleanupChildren( Tcl_PosixError(interp))); } else if (count > 0) { anyErrorInfo = 1; - Tcl_SetObjResult(interp, objPtr); + Tcl_SetObjResult(interp, objPtr); result = TCL_ERROR; } else { Tcl_DecrRefCount(objPtr); @@ -928,6 +890,7 @@ TclCreatePipeline( pidPtr[numPids] = pid; numPids++; + TclProcessCreated(pid); /* * Close off our copies of file descriptors that were set up for this diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 99bb7e1..87fc8bb 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -20,27 +20,36 @@ static int autopurge = 1; /* Autopurge flag. */ /* - * Hash table that keeps track of all child process statuses. Keys are the - * child process ids, values are (ProcessInfo *). + * Hash tables that keeps track of all child process statuses. Keys are the + * child process ids and resolved pids, values are (ProcessInfo *). */ typedef struct ProcessInfo { Tcl_Pid pid; /*FRED TODO*/ - int resolvedPid; /*FRED TODO unused?*/ - Tcl_Obj *status; /*FRED TODO*/ - + int resolvedPid; /*FRED TODO*/ + int purge; /*FRED TODO*/ + TclProcessWaitStatus status; + int code; /*FRED TODO*/ + Tcl_Obj *msg; /*FRED TODO*/ + Tcl_Obj *error; /*FRED TODO*/ } ProcessInfo; -static Tcl_HashTable statusTable; -static int statusTableInitialized = 0; /* 0 means not yet initialized. */ -TCL_DECLARE_MUTEX(statusMutex) +static Tcl_HashTable infoTablePerPid; +static Tcl_HashTable infoTablePerResolvedPid; +static int infoTablesInitialized = 0; /* 0 means not yet initialized. */ +TCL_DECLARE_MUTEX(infoTablesMutex) /* * Prototypes for functions defined later in this file: */ -static int GetProcessStatus(Tcl_Pid pid, int resolvedPid, - int options, Tcl_Obj **statusPtr); -static int PurgeProcessStatus(Tcl_HashEntry *entry); +static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, + int resolvedPid); +static void FreeProcessInfo(ProcessInfo *info, int preserveObjs); +static int RefreshProcessInfo(ProcessInfo *info, int options); +static int WaitProcessStatus(Tcl_Pid pid, int resolvedPid, + int options, int *codePtr, Tcl_Obj **msgPtr, + Tcl_Obj **errorObjPtr); +static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); static int ProcessListObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -54,6 +63,231 @@ static int ProcessAutopurgeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +/* FRED TODO */ +void +InitProcessInfo( + ProcessInfo *info, + Tcl_Pid pid, + int resolvedPid) +{ + info->pid = pid; + info->resolvedPid = resolvedPid; + info->purge = 0; + info->status = TCL_PROCESS_UNCHANGED; + info->code = 0; + info->msg = NULL; + info->error = NULL; +} + +/* FRED TODO */ +void +FreeProcessInfo( + ProcessInfo *info, + int preserveObjs) +{ + if (!preserveObjs) { + if (info->msg) { + Tcl_DecrRefCount(info->msg); + } + if (info->error) { + Tcl_DecrRefCount(info->error); + } + } + ckfree(info); +} + +/* FRED TODO */ +int +RefreshProcessInfo( + ProcessInfo *info, + int options +) +{ + if (info->status == TCL_PROCESS_UNCHANGED) { + /* + * Refresh & store status. + */ + + info->status = WaitProcessStatus(info->pid, info->resolvedPid, + options, &info->code, &info->msg, &info->error); + if (info->msg) Tcl_IncrRefCount(info->msg); + if (info->error) Tcl_IncrRefCount(info->error); + return (info->status != TCL_PROCESS_UNCHANGED); + } else { + return 0; + } +} + +/* FRED TODO */ +int +WaitProcessStatus( + Tcl_Pid pid, + int resolvedPid, + int options, + int *codePtr, + Tcl_Obj **msgObjPtr, + Tcl_Obj **errorObjPtr) +{ + int waitStatus; + Tcl_Obj *errorStrings[5]; + const char *msg; + + pid = Tcl_WaitPid(pid, &waitStatus, options); + if ((pid == 0)) { + /* + * No change. + */ + + return TCL_PROCESS_UNCHANGED; + } + + /* + * Get process status. + */ + + if (pid == (Tcl_Pid) -1) { + /* + * POSIX errName msg + */ + + msg = Tcl_ErrnoMsg(errno); + if (errno == ECHILD) { + /* + * This changeup in message suggested by Mark Diekhans to + * remind people that ECHILD errors can occur on some + * systems if SIGCHLD isn't in its default state. + */ + + msg = "child process lost (is SIGCHLD ignored or trapped?)"; + } + if (codePtr) *codePtr = errno; + if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( + "error waiting for process to exit: %s", msg); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("POSIX", -1); + errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); + errorStrings[2] = Tcl_NewStringObj(msg, -1); + *errorObjPtr = Tcl_NewListObj(3, errorStrings); + } + return TCL_PROCESS_ERROR; + } else if (WIFEXITED(waitStatus)) { + if (codePtr) *codePtr = WEXITSTATUS(waitStatus); + if (!WEXITSTATUS(waitStatus)) { + /* + * Normal exit. + */ + + if (msgObjPtr) *msgObjPtr = NULL; + if (errorObjPtr) *errorObjPtr = NULL; + } else { + /* + * CHILDSTATUS pid code + * + * Child exited with a non-zero exit status. + */ + + if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( + "child process exited abnormally", -1); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1); + errorStrings[1] = Tcl_NewIntObj(resolvedPid); + errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus)); + *errorObjPtr = Tcl_NewListObj(3, errorStrings); + } + } + return TCL_PROCESS_EXITED; + } else if (WIFSIGNALED(waitStatus)) { + /* + * CHILDKILLED pid sigName msg + * + * Child killed because of a signal. + */ + + msg = Tcl_SignalMsg(WTERMSIG(waitStatus)); + if (codePtr) *codePtr = WTERMSIG(waitStatus); + if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( + "child killed: %s", msg); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1); + errorStrings[1] = Tcl_NewIntObj(resolvedPid); + errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1); + errorStrings[3] = Tcl_NewStringObj(msg, -1); + *errorObjPtr = Tcl_NewListObj(4, errorStrings); + } + return TCL_PROCESS_SIGNALED; + } else if (WIFSTOPPED(waitStatus)) { + /* + * CHILDSUSP pid sigName msg + * + * Child suspended because of a signal. + */ + + msg = Tcl_SignalMsg(WSTOPSIG(waitStatus)); + if (codePtr) *codePtr = WSTOPSIG(waitStatus); + if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( + "child suspended: %s", msg); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1); + errorStrings[1] = Tcl_NewIntObj(resolvedPid); + errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1); + errorStrings[3] = Tcl_NewStringObj(msg, -1); + *errorObjPtr = Tcl_NewListObj(4, errorStrings); + } + return TCL_PROCESS_STOPPED; + } else { + /* + * TCL OPERATION EXEC ODDWAITRESULT + * + * Child wait status didn't make sense. + */ + + if (codePtr) *codePtr = waitStatus; + if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( + "child wait status didn't make sense\n", -1); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("TCL", -1); + errorStrings[1] = Tcl_NewStringObj("OPERATION", -1); + errorStrings[2] = Tcl_NewStringObj("EXEC", -1); + errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1); + errorStrings[4] = Tcl_NewIntObj(resolvedPid); + *errorObjPtr = Tcl_NewListObj(5, errorStrings); + } + return TCL_PROCESS_UNKNOWN_STATUS; + } +} + +/* FRED TODO */ +Tcl_Obj * +BuildProcessStatusObj( + ProcessInfo *info) +{ + Tcl_Obj *resultObjs[3]; + + if (info->status == TCL_PROCESS_UNCHANGED) { + /* + * Process still running, return empty obj. + */ + + return Tcl_NewObj(); + } + if (info->status == TCL_PROCESS_EXITED && info->code == 0) { + /* + * Normal exit, return TCL_OK. + */ + + return Tcl_NewIntObj(TCL_OK); + } + + /* + * Abnormal exit, return {TCL_ERROR msg error} + */ + + resultObjs[0] = Tcl_NewIntObj(TCL_ERROR); + resultObjs[1] = info->msg; + resultObjs[2] = info->error; + return Tcl_NewListObj(3, resultObjs); +} + /*---------------------------------------------------------------------- * * ProcessListObjCmd -- @@ -92,14 +326,14 @@ ProcessListObjCmd( */ list = Tcl_NewListObj(0, NULL); - Tcl_MutexLock(&statusMutex); - for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; - entry = Tcl_NextHashEntry(&search)) { + Tcl_MutexLock(&infoTablesMutex); + for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { info = (ProcessInfo *) Tcl_GetHashValue(entry); Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(info->resolvedPid)); } - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); Tcl_SetObjResult(interp, list); return TCL_OK; } @@ -172,35 +406,17 @@ ProcessStatusObjCmd( */ dict = Tcl_NewDictObj(); - Tcl_MutexLock(&statusMutex); - for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; - entry = Tcl_NextHashEntry(&search)) { + Tcl_MutexLock(&infoTablesMutex); + for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (autopurge) { - if (GetProcessStatus(info->pid, info->resolvedPid, options, - NULL)) { - /* - * Purge. - */ - - PurgeProcessStatus(entry); - Tcl_DeleteHashEntry(entry); - continue; - } - } else if (!info->status) { - /* - * Update status. - */ + RefreshProcessInfo(info, options); + // TODO purge etc. - if (GetProcessStatus(info->pid, info->resolvedPid, options, - &info->status)) { - Tcl_IncrRefCount(info->status); - } - } - Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), - info->status ? info->status : Tcl_NewObj()); + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + BuildProcessStatusObj(info)); } - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); } else { /* * Only return statuses of provided processes. @@ -211,16 +427,16 @@ ProcessStatusObjCmd( return result; } dict = Tcl_NewDictObj(); - Tcl_MutexLock(&statusMutex); + Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); if (result != TCL_OK) { - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); Tcl_DecrRefCount(dict); return result; } - entry = Tcl_FindHashEntry(&statusTable, INT2PTR(pid)); + entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); if (!entry) { /* * Skip unknown process. @@ -230,31 +446,14 @@ ProcessStatusObjCmd( } info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (autopurge) { - if (GetProcessStatus(info->pid, info->resolvedPid, options, - NULL)) { - /* - * Purge. - */ - - PurgeProcessStatus(entry); - Tcl_DeleteHashEntry(entry); - continue; - } - } else if (!info->status) { - /* - * Update status. - */ + RefreshProcessInfo(info, options); - if (GetProcessStatus(info->pid, info->resolvedPid, options, - &info->status)) { - Tcl_IncrRefCount(info->status); - } - } - Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), - info->status ? info->status : Tcl_NewObj()); + // TODO purge etc. + + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + BuildProcessStatusObj(info)); } - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); } Tcl_SetObjResult(interp, dict); return TCL_OK; @@ -285,6 +484,7 @@ ProcessPurgeObjCmd( { Tcl_HashEntry *entry; Tcl_HashSearch search; + ProcessInfo *info; int numPids; Tcl_Obj **pidObjs; int result; @@ -301,14 +501,16 @@ ProcessPurgeObjCmd( * Purge all terminated processes. */ - Tcl_MutexLock(&statusMutex); - for (entry = Tcl_FirstHashEntry(&statusTable, &search); entry != NULL; + Tcl_MutexLock(&infoTablesMutex); + for (entry = Tcl_FirstHashEntry(&infoTablePerPid, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { - if (PurgeProcessStatus(entry)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->status != TCL_PROCESS_UNCHANGED) { Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info, 0); } } - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); } else { /* * Purge only provided processes. @@ -318,20 +520,24 @@ ProcessPurgeObjCmd( if (result != TCL_OK) { return result; } - Tcl_MutexLock(&statusMutex); + Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); if (result != TCL_OK) { - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); return result; } - entry = Tcl_FindHashEntry(&statusTable, INT2PTR(pid)); - if (entry && PurgeProcessStatus(entry)) { - Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, INT2PTR(pid)); + if (entry) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->status != TCL_PROCESS_UNCHANGED) { + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info, 0); + } } } - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); } return TCL_OK; @@ -417,13 +623,14 @@ TclInitProcessCmd( }; Tcl_Command processCmd; - if (statusTableInitialized == 0) { - Tcl_MutexLock(&statusMutex); - if (statusTableInitialized == 0) { - Tcl_InitHashTable(&statusTable, TCL_ONE_WORD_KEYS); - statusTableInitialized = 1; + if (infoTablesInitialized == 0) { + Tcl_MutexLock(&infoTablesMutex); + if (infoTablesInitialized == 0) { + Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS); + infoTablesInitialized = 1; } - Tcl_MutexUnlock(&statusMutex); + Tcl_MutexUnlock(&infoTablesMutex); } processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); @@ -434,7 +641,7 @@ TclInitProcessCmd( /* FRED TODO */ void -TclProcessDetach( +TclProcessCreated( Tcl_Pid pid) { int resolvedPid; @@ -442,233 +649,119 @@ TclProcessDetach( int isNew; ProcessInfo *info; + /* + * Get resolved pid first. + */ + resolvedPid = TclpGetPid(pid); - Tcl_MutexLock(&statusMutex); - entry = Tcl_CreateHashEntry(&statusTable, INT2PTR(resolvedPid), &isNew); + + Tcl_MutexLock(&infoTablesMutex); + + /* + * Create entry in pid table. + */ + + entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew); if (!isNew) { /* - * Pid was reused, free old status and reuse structure. + * Pid was reused, free old info and reuse structure. */ info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->status) { - Tcl_DecrRefCount(info->status); - } - } else { - /* - * Allocate new info structure. - */ - - info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); - Tcl_SetHashValue(entry, info); + FreeProcessInfo(info, 0); } - + /* - * Initialize with an empty status. + * Allocate and initialize info structure. */ - info->pid = pid; - info->resolvedPid = resolvedPid; - info->status = NULL; + info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); + InitProcessInfo(info, pid, resolvedPid); + + /* + * Add entry to tables. + */ - Tcl_MutexUnlock(&statusMutex); + Tcl_SetHashValue(entry, info); + entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid), &isNew); + Tcl_SetHashValue(entry, info); + + Tcl_MutexUnlock(&infoTablesMutex); } + /* FRED TODO */ -int -TclProcessStatus( +TclProcessWaitStatus +TclProcessWait( Tcl_Pid pid, - int options) + int options, + int *codePtr, + Tcl_Obj **msgObjPtr, + Tcl_Obj **errorObjPtr) { - int resolvedPid; Tcl_HashEntry *entry; ProcessInfo *info; - Tcl_Obj *status; - int isNew; - + int result; + /* - * We need to get the resolved pid before we wait on it as the windows - * implementation of Tcl_WaitPid deletes the information such that any - * following calls to TclpGetPid fail. + * First search for pid in table. */ - resolvedPid = TclpGetPid(pid); - - if (!GetProcessStatus(pid, resolvedPid, options, - (autopurge ? NULL /* unused */: &status))) { + entry = Tcl_FindHashEntry(&infoTablePerPid, pid); + if (!entry) { /* - * Process still alive, or non child-related error. + * Unknown process, just call WaitProcessStatus and return. */ - return 0; - } - - if (autopurge) { - /* - * Child terminated, purge. - */ - - Tcl_MutexLock(&statusMutex); - entry = Tcl_FindHashEntry(&statusTable, INT2PTR(resolvedPid)); - if (entry) { - PurgeProcessStatus(entry); - Tcl_DeleteHashEntry(entry); - } - Tcl_MutexUnlock(&statusMutex); - - return 1; + return WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, + msgObjPtr, errorObjPtr); } - /* - * Store process status. - */ - - Tcl_MutexLock(&statusMutex); - entry = Tcl_CreateHashEntry(&statusTable, INT2PTR(resolvedPid), &isNew); - if (!isNew) { - info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->status) { - /* - * Free old status object. - */ - - Tcl_DecrRefCount(info->status); - } - } else { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->purge) { /* - * Allocate new info structure. + * Process has completed but TclProcessWait has already been called, + * so report no change. */ - - info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); - info->pid = pid; - info->resolvedPid = resolvedPid; - Tcl_SetHashValue(entry, info); + + return TCL_PROCESS_UNCHANGED; } - info->status = status; - Tcl_IncrRefCount(status); - Tcl_MutexUnlock(&statusMutex); - - return 1; -} - -/* FRED TODO */ -int -GetProcessStatus( - Tcl_Pid pid, - int resolvedPid, - int options, - Tcl_Obj **statusPtr) -{ - int waitStatus; - Tcl_Obj *statusCodes[5]; - const char *msg; - - pid = Tcl_WaitPid(pid, &waitStatus, options); - if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) { + RefreshProcessInfo(info, options); + if (info->status == TCL_PROCESS_UNCHANGED) { /* - * Process still alive, or non child-related error. + * No change, stop there. */ - return 0; - } - - if (!statusPtr) { - return 1; + return TCL_PROCESS_UNCHANGED; } /* - * Get process status. + * Set return values. */ - if (pid == (Tcl_Pid) -1) { - /* - * POSIX errName msg - */ + result = info->status; + if (codePtr) *codePtr = info->code; + if (msgObjPtr) *msgObjPtr = info->msg; + if (errorObjPtr) *errorObjPtr = info->error; - statusCodes[0] = Tcl_NewStringObj("POSIX", -1); - statusCodes[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); - msg = Tcl_ErrnoMsg(errno); - if (errno == ECHILD) { - /* - * This changeup in message suggested by Mark Diekhans to - * remind people that ECHILD errors can occur on some - * systems if SIGCHLD isn't in its default state. - */ - - msg = "child process lost (is SIGCHLD ignored or trapped?)"; - } - statusCodes[2] = Tcl_NewStringObj(msg, -1); - *statusPtr = Tcl_NewListObj(3, statusCodes); - } else if (WIFEXITED(waitStatus)) { - /* - * CHILDSTATUS pid code - * - * Child exited with a non-zero exit status. - */ - - statusCodes[0] = Tcl_NewStringObj("CHILDSTATUS", -1); - statusCodes[1] = Tcl_NewIntObj(resolvedPid); - statusCodes[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus)); - *statusPtr = Tcl_NewListObj(3, statusCodes); - } else if (WIFSIGNALED(waitStatus)) { - /* - * CHILDKILLED pid sigName msg - * - * Child killed because of a signal - */ - - statusCodes[0] = Tcl_NewStringObj("CHILDKILLED", -1); - statusCodes[1] = Tcl_NewIntObj(resolvedPid); - statusCodes[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1); - statusCodes[3] = Tcl_NewStringObj(Tcl_SignalMsg(WTERMSIG(waitStatus)), -1); - *statusPtr = Tcl_NewListObj(4, statusCodes); - } else if (WIFSTOPPED(waitStatus)) { + if (autopurge) { /* - * CHILDSUSP pid sigName msg - * - * Child suspended because of a signal + * Purge now. */ - statusCodes[0] = Tcl_NewStringObj("CHILDSUSP", -1); - statusCodes[1] = Tcl_NewIntObj(resolvedPid); - statusCodes[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1); - statusCodes[3] = Tcl_NewStringObj(Tcl_SignalMsg(WSTOPSIG(waitStatus)), -1); - *statusPtr = Tcl_NewListObj(4, statusCodes); + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, + INT2PTR(info->resolvedPid)); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info, 1); } else { /* - * TCL OPERATION EXEC ODDWAITRESULT - * - * Child wait status didn't make sense. - */ - - statusCodes[0] = Tcl_NewStringObj("TCL", -1); - statusCodes[1] = Tcl_NewStringObj("OPERATION", -1); - statusCodes[2] = Tcl_NewStringObj("EXEC", -1); - statusCodes[3] = Tcl_NewStringObj("ODDWAITRESULT", -1); - statusCodes[4] = Tcl_NewIntObj(resolvedPid); - *statusPtr = Tcl_NewListObj(5, statusCodes); - } - - return 1; -} - -/* FRED TODO */ -int -PurgeProcessStatus( - Tcl_HashEntry *entry) -{ - ProcessInfo *info; - - info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->status) { - /* - * Process has ended, purge. + * Eventually purge. Subsequent calls will return + * TCL_PROCESS_UNCHANGED. */ - Tcl_DecrRefCount(info->status); - return 1; + info->purge = 1; } - - return 0; + return result; } -- cgit v0.12 From 935e991786520c81b01c7c2992568703d3d0746f Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Sun, 27 Aug 2017 15:24:22 +0000 Subject: On Windows, Tcl_Pids now map to dwProcessId instead of hProcess because the system reuses handles of recently terminated processes. --- win/tclWinPipe.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4666deb..ce132d1 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -876,7 +876,7 @@ TclpGetPid( Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->hProcess == (HANDLE) pid) { + if (infoPtr->dwProcessId == (DWORD) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } @@ -1187,7 +1187,7 @@ TclpCreateProcess( WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); - *pidPtr = (Tcl_Pid) procInfo.hProcess; + *pidPtr = (Tcl_Pid) procInfo.dwProcessId; if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } @@ -2458,7 +2458,7 @@ Tcl_WaitPid( prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->hProcess == (HANDLE) pid) { + if (infoPtr->dwProcessId == (DWORD) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } -- cgit v0.12 From 68b53cfb2571faea3e86f728b3a07222ea9143d0 Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Sun, 27 Aug 2017 15:25:57 +0000 Subject: Fixed reference counting issue with objects returned by WaitProcessStatus --- generic/tclInt.h | 17 +++++--- generic/tclPipe.c | 5 ++- generic/tclProcess.c | 110 ++++++++++++++++++++++++++++++++++++--------------- 3 files changed, 93 insertions(+), 39 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index c7a0a0d..32b0d8a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4025,13 +4025,18 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); * TIP #462. */ +/* + * The following enum values give the status of a spawned process. + */ + typedef enum TclProcessWaitStatus { - TCL_PROCESS_ERROR = -1, - TCL_PROCESS_UNCHANGED = 0, - TCL_PROCESS_EXITED = 1, - TCL_PROCESS_SIGNALED = 2, - TCL_PROCESS_STOPPED = 3, - TCL_PROCESS_UNKNOWN_STATUS = 4 + TCL_PROCESS_ERROR = -1, /* Error waiting for process to exit */ + TCL_PROCESS_UNCHANGED = 0, /* No change since the last call. */ + TCL_PROCESS_EXITED = 1, /* Process has exited. */ + TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */ + TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */ + TCL_PROCESS_UNKNOWN_STATUS = 4 + /* Child wait status didn't make sense. */ } TclProcessWaitStatus; MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); diff --git a/generic/tclPipe.c b/generic/tclPipe.c index d20d8eb..fa5c55d 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -290,6 +290,8 @@ TclCleanupChildren( Tcl_SetObjErrorCode(interp, error); Tcl_SetObjResult(interp, msg); } + Tcl_DecrRefCount(error); + Tcl_DecrRefCount(msg); continue; } @@ -305,7 +307,6 @@ TclCleanupChildren( if (waitStatus == TCL_PROCESS_EXITED) { if (interp != NULL) { Tcl_SetObjErrorCode(interp, error); - Tcl_DecrRefCount(msg); } abnormalExit = 1; } else if (interp != NULL) { @@ -313,6 +314,8 @@ TclCleanupChildren( Tcl_SetObjResult(interp, msg); } } + Tcl_DecrRefCount(error); + Tcl_DecrRefCount(msg); } /* diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 87fc8bb..bd3467b 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -44,7 +44,7 @@ TCL_DECLARE_MUTEX(infoTablesMutex) static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, int resolvedPid); -static void FreeProcessInfo(ProcessInfo *info, int preserveObjs); +static void FreeProcessInfo(ProcessInfo *info); static int RefreshProcessInfo(ProcessInfo *info, int options); static int WaitProcessStatus(Tcl_Pid pid, int resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, @@ -82,16 +82,13 @@ InitProcessInfo( /* FRED TODO */ void FreeProcessInfo( - ProcessInfo *info, - int preserveObjs) + ProcessInfo *info) { - if (!preserveObjs) { - if (info->msg) { - Tcl_DecrRefCount(info->msg); - } - if (info->error) { - Tcl_DecrRefCount(info->error); - } + if (info->msg) { + Tcl_DecrRefCount(info->msg); + } + if (info->error) { + Tcl_DecrRefCount(info->error); } ckfree(info); } @@ -402,7 +399,7 @@ ProcessStatusObjCmd( if (objc == 1) { /* - * Return the list of all child process statuses. + * Return a dict with all child process statuses. */ dict = Tcl_NewDictObj(); @@ -411,10 +408,24 @@ ProcessStatusObjCmd( entry != NULL; entry = Tcl_NextHashEntry(&search)) { info = (ProcessInfo *) Tcl_GetHashValue(entry); RefreshProcessInfo(info, options); - // TODO purge etc. - Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), - BuildProcessStatusObj(info)); + if (info->purge && autopurge) { + /* + * Purge entry. + */ + + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); + } else { + /* + * Add to result. + */ + + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + BuildProcessStatusObj(info)); + } } Tcl_MutexUnlock(&infoTablesMutex); } else { @@ -448,10 +459,23 @@ ProcessStatusObjCmd( info = (ProcessInfo *) Tcl_GetHashValue(entry); RefreshProcessInfo(info, options); - // TODO purge etc. + if (info->purge && autopurge) { + /* + * Purge entry. + */ + + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); + } else { + /* + * Add to result. + */ - Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), - BuildProcessStatusObj(info)); + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + BuildProcessStatusObj(info)); + } } Tcl_MutexUnlock(&infoTablesMutex); } @@ -496,18 +520,26 @@ ProcessPurgeObjCmd( return TCL_ERROR; } + /* + * First reap detached procs so that their purge flag is up-to-date. + */ + + Tcl_ReapDetachedProcs(); + if (objc == 1) { /* * Purge all terminated processes. */ Tcl_MutexLock(&infoTablesMutex); - for (entry = Tcl_FirstHashEntry(&infoTablePerPid, &search); entry != NULL; - entry = Tcl_NextHashEntry(&search)) { + for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->status != TCL_PROCESS_UNCHANGED) { + if (info->purge) { + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info, 0); + FreeProcessInfo(info); } } Tcl_MutexUnlock(&infoTablesMutex); @@ -528,13 +560,21 @@ ProcessPurgeObjCmd( return result; } - entry = Tcl_FindHashEntry(&infoTablePerPid, INT2PTR(pid)); - if (entry) { - info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->status != TCL_PROCESS_UNCHANGED) { - Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info, 0); - } + entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); + if (!entry) { + /* + * Skip unknown process. + */ + + continue; + } + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->purge) { + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); } } Tcl_MutexUnlock(&infoTablesMutex); @@ -668,7 +708,7 @@ TclProcessCreated( */ info = (ProcessInfo *) Tcl_GetHashValue(entry); - FreeProcessInfo(info, 0); + FreeProcessInfo(info); } /* @@ -683,7 +723,8 @@ TclProcessCreated( */ Tcl_SetHashValue(entry, info); - entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid), &isNew); + entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid), + &isNew); Tcl_SetHashValue(entry, info); Tcl_MutexUnlock(&infoTablesMutex); @@ -713,8 +754,11 @@ TclProcessWait( * Unknown process, just call WaitProcessStatus and return. */ - return WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, + result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, msgObjPtr, errorObjPtr); + if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); + if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); + return result; } info = (ProcessInfo *) Tcl_GetHashValue(entry); @@ -744,6 +788,8 @@ TclProcessWait( if (codePtr) *codePtr = info->code; if (msgObjPtr) *msgObjPtr = info->msg; if (errorObjPtr) *errorObjPtr = info->error; + if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); + if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); if (autopurge) { /* @@ -754,7 +800,7 @@ TclProcessWait( entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(info->resolvedPid)); Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info, 1); + FreeProcessInfo(info); } else { /* * Eventually purge. Subsequent calls will return -- cgit v0.12 From 0a8718312d30c1e90db63395404caa10c890d9a4 Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Sun, 27 Aug 2017 21:25:14 +0000 Subject: Comments and formatting --- generic/tclPipe.c | 2 +- generic/tclProcess.c | 923 +++++++++++++++++++++++++++++---------------------- 2 files changed, 532 insertions(+), 393 deletions(-) diff --git a/generic/tclPipe.c b/generic/tclPipe.c index fa5c55d..bc760b6 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -345,7 +345,7 @@ TclCleanupChildren( Tcl_PosixError(interp))); } else if (count > 0) { anyErrorInfo = 1; - Tcl_SetObjResult(interp, objPtr); + Tcl_SetObjResult(interp, objPtr); result = TCL_ERROR; } else { Tcl_DecrRefCount(objPtr); diff --git a/generic/tclProcess.c b/generic/tclProcess.c index bd3467b..8d98a23 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -2,7 +2,7 @@ * tclProcess.c -- * * This file implements the "tcl::process" ensemble for subprocess - * management as defined by TIP #462. + * management as defined by TIP #462. * * Copyright (c) 2017 Frederic Bonnet. * @@ -17,7 +17,7 @@ * processes (see tclPipe.c). */ -static int autopurge = 1; /* Autopurge flag. */ +static int autopurge = 1; /* Autopurge flag. */ /* * Hash tables that keeps track of all child process statuses. Keys are the @@ -25,13 +25,14 @@ static int autopurge = 1; /* Autopurge flag. */ */ typedef struct ProcessInfo { - Tcl_Pid pid; /*FRED TODO*/ - int resolvedPid; /*FRED TODO*/ - int purge; /*FRED TODO*/ - TclProcessWaitStatus status; - int code; /*FRED TODO*/ - Tcl_Obj *msg; /*FRED TODO*/ - Tcl_Obj *error; /*FRED TODO*/ + Tcl_Pid pid; /* Process id. */ + int resolvedPid; /* Resolved process id. */ + int purge; /* Purge eventualy. */ + TclProcessWaitStatus status;/* Process status. */ + int code; /* Error code, exit status or signal + number. */ + Tcl_Obj *msg; /* Error message. */ + Tcl_Obj *error; /* Error code. */ } ProcessInfo; static Tcl_HashTable infoTablePerPid; static Tcl_HashTable infoTablePerResolvedPid; @@ -42,33 +43,48 @@ TCL_DECLARE_MUTEX(infoTablesMutex) * Prototypes for functions defined later in this file: */ -static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, - int resolvedPid); -static void FreeProcessInfo(ProcessInfo *info); -static int RefreshProcessInfo(ProcessInfo *info, int options); -static int WaitProcessStatus(Tcl_Pid pid, int resolvedPid, +static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, + int resolvedPid); +static void FreeProcessInfo(ProcessInfo *info); +static int RefreshProcessInfo(ProcessInfo *info, int options); +static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, - Tcl_Obj **errorObjPtr); -static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); -static int ProcessListObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ProcessStatusObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ProcessPurgeObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ProcessAutopurgeObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); - -/* FRED TODO */ + Tcl_Obj **errorObjPtr); +static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); +static int ProcessListObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessStatusObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessPurgeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int ProcessAutopurgeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); + +/* + *---------------------------------------------------------------------- + * + * InitProcessInfo -- + * + * Initializes the ProcessInfo structure. + * + * Results: + * None. + * + * Side effects: + * Memory written. + * + *---------------------------------------------------------------------- + */ + void InitProcessInfo( - ProcessInfo *info, - Tcl_Pid pid, - int resolvedPid) + ProcessInfo *info, /* Structure to initialize. */ + Tcl_Pid pid, /* Process id. */ + int resolvedPid) /* Resolved process id. */ { info->pid = pid; info->resolvedPid = resolvedPid; @@ -79,51 +95,115 @@ InitProcessInfo( info->error = NULL; } -/* FRED TODO */ +/* + *---------------------------------------------------------------------- + * + * FreeProcessInfo -- + * + * Free the ProcessInfo structure. + * + * Results: + * None. + * + * Side effects: + * Memory deallocated, Tcl_Obj refcount decreased. + * + *---------------------------------------------------------------------- + */ + void FreeProcessInfo( - ProcessInfo *info) + ProcessInfo *info) /* Structure to free. */ { + /* + * Free stored Tcl_Objs. + */ + if (info->msg) { - Tcl_DecrRefCount(info->msg); + Tcl_DecrRefCount(info->msg); } if (info->error) { - Tcl_DecrRefCount(info->error); + Tcl_DecrRefCount(info->error); } + + /* + * Free allocated structure. + */ + ckfree(info); } -/* FRED TODO */ +/* + *---------------------------------------------------------------------- + * + * RefreshProcessInfo -- + * + * Refresh process info. + * + * Results: + * Nonzero if state changed, else zero. + * + * Side effects: + * May call WaitProcessStatus, which can block if WNOHANG option is set. + * + *---------------------------------------------------------------------- + */ + int RefreshProcessInfo( - ProcessInfo *info, - int options + ProcessInfo *info, /* Structure to refresh. */ + int options /* Options passed to WaitProcessStatus. */ ) { if (info->status == TCL_PROCESS_UNCHANGED) { - /* - * Refresh & store status. - */ - - info->status = WaitProcessStatus(info->pid, info->resolvedPid, - options, &info->code, &info->msg, &info->error); - if (info->msg) Tcl_IncrRefCount(info->msg); - if (info->error) Tcl_IncrRefCount(info->error); - return (info->status != TCL_PROCESS_UNCHANGED); + /* + * Refresh & store status. + */ + + info->status = WaitProcessStatus(info->pid, info->resolvedPid, + options, &info->code, &info->msg, &info->error); + if (info->msg) Tcl_IncrRefCount(info->msg); + if (info->error) Tcl_IncrRefCount(info->error); + return (info->status != TCL_PROCESS_UNCHANGED); } else { - return 0; + /* + * No change. + */ + + return 0; } } -/* FRED TODO */ -int +/* + *---------------------------------------------------------------------- + * + * WaitProcessStatus -- + * + * Wait for process status to change. + * + * Results: + * TclProcessWaitStatus enum value. + * + * Side effects: + * May call WaitProcessStatus, which can block if WNOHANG option is set. + * + *---------------------------------------------------------------------- + */ + +TclProcessWaitStatus WaitProcessStatus( - Tcl_Pid pid, - int resolvedPid, - int options, - int *codePtr, - Tcl_Obj **msgObjPtr, - Tcl_Obj **errorObjPtr) + Tcl_Pid pid, /* Process id. */ + int resolvedPid, /* Resolved process id. */ + int options, /* Options passed to Tcl_WaitPid. */ + int *codePtr, /* If non-NULL, will receive either: + * - 0 for normal exit. + * - errno in case of error. + * - non-zero exit code for abormal exit. + * - signal number if killed or suspended. + * - Tcl_WaitPid status in all other cases. + */ + Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ + Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { int waitStatus; Tcl_Obj *errorStrings[5]; @@ -131,11 +211,11 @@ WaitProcessStatus( pid = Tcl_WaitPid(pid, &waitStatus, options); if ((pid == 0)) { - /* - * No change. - */ - - return TCL_PROCESS_UNCHANGED; + /* + * No change. + */ + + return TCL_PROCESS_UNCHANGED; } /* @@ -143,117 +223,136 @@ WaitProcessStatus( */ if (pid == (Tcl_Pid) -1) { - /* - * POSIX errName msg - */ - - msg = Tcl_ErrnoMsg(errno); - if (errno == ECHILD) { - /* - * This changeup in message suggested by Mark Diekhans to - * remind people that ECHILD errors can occur on some - * systems if SIGCHLD isn't in its default state. - */ - - msg = "child process lost (is SIGCHLD ignored or trapped?)"; - } - if (codePtr) *codePtr = errno; - if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( - "error waiting for process to exit: %s", msg); - if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("POSIX", -1); - errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); - errorStrings[2] = Tcl_NewStringObj(msg, -1); - *errorObjPtr = Tcl_NewListObj(3, errorStrings); - } - return TCL_PROCESS_ERROR; + /* + * POSIX errName msg + */ + + msg = Tcl_ErrnoMsg(errno); + if (errno == ECHILD) { + /* + * This changeup in message suggested by Mark Diekhans to + * remind people that ECHILD errors can occur on some + * systems if SIGCHLD isn't in its default state. + */ + + msg = "child process lost (is SIGCHLD ignored or trapped?)"; + } + if (codePtr) *codePtr = errno; + if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( + "error waiting for process to exit: %s", msg); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("POSIX", -1); + errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); + errorStrings[2] = Tcl_NewStringObj(msg, -1); + *errorObjPtr = Tcl_NewListObj(3, errorStrings); + } + return TCL_PROCESS_ERROR; } else if (WIFEXITED(waitStatus)) { - if (codePtr) *codePtr = WEXITSTATUS(waitStatus); - if (!WEXITSTATUS(waitStatus)) { - /* - * Normal exit. - */ - - if (msgObjPtr) *msgObjPtr = NULL; - if (errorObjPtr) *errorObjPtr = NULL; - } else { - /* - * CHILDSTATUS pid code - * - * Child exited with a non-zero exit status. - */ - - if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( - "child process exited abnormally", -1); - if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1); - errorStrings[1] = Tcl_NewIntObj(resolvedPid); - errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus)); - *errorObjPtr = Tcl_NewListObj(3, errorStrings); - } - } - return TCL_PROCESS_EXITED; + if (codePtr) *codePtr = WEXITSTATUS(waitStatus); + if (!WEXITSTATUS(waitStatus)) { + /* + * Normal exit. + */ + + if (msgObjPtr) *msgObjPtr = NULL; + if (errorObjPtr) *errorObjPtr = NULL; + } else { + /* + * CHILDSTATUS pid code + * + * Child exited with a non-zero exit status. + */ + + if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( + "child process exited abnormally", -1); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1); + errorStrings[1] = Tcl_NewIntObj(resolvedPid); + errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus)); + *errorObjPtr = Tcl_NewListObj(3, errorStrings); + } + } + return TCL_PROCESS_EXITED; } else if (WIFSIGNALED(waitStatus)) { - /* - * CHILDKILLED pid sigName msg - * - * Child killed because of a signal. - */ - - msg = Tcl_SignalMsg(WTERMSIG(waitStatus)); - if (codePtr) *codePtr = WTERMSIG(waitStatus); - if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( - "child killed: %s", msg); - if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1); - errorStrings[1] = Tcl_NewIntObj(resolvedPid); - errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1); - errorStrings[3] = Tcl_NewStringObj(msg, -1); - *errorObjPtr = Tcl_NewListObj(4, errorStrings); - } - return TCL_PROCESS_SIGNALED; + /* + * CHILDKILLED pid sigName msg + * + * Child killed because of a signal. + */ + + msg = Tcl_SignalMsg(WTERMSIG(waitStatus)); + if (codePtr) *codePtr = WTERMSIG(waitStatus); + if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( + "child killed: %s", msg); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1); + errorStrings[1] = Tcl_NewIntObj(resolvedPid); + errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1); + errorStrings[3] = Tcl_NewStringObj(msg, -1); + *errorObjPtr = Tcl_NewListObj(4, errorStrings); + } + return TCL_PROCESS_SIGNALED; } else if (WIFSTOPPED(waitStatus)) { - /* - * CHILDSUSP pid sigName msg - * - * Child suspended because of a signal. - */ - - msg = Tcl_SignalMsg(WSTOPSIG(waitStatus)); - if (codePtr) *codePtr = WSTOPSIG(waitStatus); - if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( - "child suspended: %s", msg); - if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1); - errorStrings[1] = Tcl_NewIntObj(resolvedPid); - errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1); - errorStrings[3] = Tcl_NewStringObj(msg, -1); - *errorObjPtr = Tcl_NewListObj(4, errorStrings); - } - return TCL_PROCESS_STOPPED; + /* + * CHILDSUSP pid sigName msg + * + * Child suspended because of a signal. + */ + + msg = Tcl_SignalMsg(WSTOPSIG(waitStatus)); + if (codePtr) *codePtr = WSTOPSIG(waitStatus); + if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( + "child suspended: %s", msg); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1); + errorStrings[1] = Tcl_NewIntObj(resolvedPid); + errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1); + errorStrings[3] = Tcl_NewStringObj(msg, -1); + *errorObjPtr = Tcl_NewListObj(4, errorStrings); + } + return TCL_PROCESS_STOPPED; } else { - /* - * TCL OPERATION EXEC ODDWAITRESULT - * - * Child wait status didn't make sense. - */ - - if (codePtr) *codePtr = waitStatus; - if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( - "child wait status didn't make sense\n", -1); - if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("TCL", -1); - errorStrings[1] = Tcl_NewStringObj("OPERATION", -1); - errorStrings[2] = Tcl_NewStringObj("EXEC", -1); - errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1); - errorStrings[4] = Tcl_NewIntObj(resolvedPid); - *errorObjPtr = Tcl_NewListObj(5, errorStrings); - } - return TCL_PROCESS_UNKNOWN_STATUS; + /* + * TCL OPERATION EXEC ODDWAITRESULT + * + * Child wait status didn't make sense. + */ + + if (codePtr) *codePtr = waitStatus; + if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( + "child wait status didn't make sense\n", -1); + if (errorObjPtr) { + errorStrings[0] = Tcl_NewStringObj("TCL", -1); + errorStrings[1] = Tcl_NewStringObj("OPERATION", -1); + errorStrings[2] = Tcl_NewStringObj("EXEC", -1); + errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1); + errorStrings[4] = Tcl_NewIntObj(resolvedPid); + *errorObjPtr = Tcl_NewListObj(5, errorStrings); + } + return TCL_PROCESS_UNKNOWN_STATUS; } } -/* FRED TODO */ + +/* + *---------------------------------------------------------------------- + * + * BuildProcessStatusObj -- + * + * Build a list object with process status. The first element is always + * a standard Tcl return value, which can be either TCL_OK or TCL_ERROR. + * In the latter case, the second element is the error message and the + * third element is a Tcl error code (see tclvars). + * + * Results: + * A list object. + * + * Side effects: + * Tcl_Objs are created. + * + *---------------------------------------------------------------------- + */ + Tcl_Obj * BuildProcessStatusObj( ProcessInfo *info) @@ -261,18 +360,18 @@ BuildProcessStatusObj( Tcl_Obj *resultObjs[3]; if (info->status == TCL_PROCESS_UNCHANGED) { - /* - * Process still running, return empty obj. - */ + /* + * Process still running, return empty obj. + */ - return Tcl_NewObj(); + return Tcl_NewObj(); } if (info->status == TCL_PROCESS_EXITED && info->code == 0) { - /* - * Normal exit, return TCL_OK. - */ - - return Tcl_NewIntObj(TCL_OK); + /* + * Normal exit, return TCL_OK. + */ + + return Tcl_NewIntObj(TCL_OK); } /* @@ -290,13 +389,13 @@ BuildProcessStatusObj( * ProcessListObjCmd -- * * This function implements the 'tcl::process list' Tcl command. - * Refer to the user documentation for details on what it does. + * Refer to the user documentation for details on what it does. * * Results: * Returns a standard Tcl result. * * Side effects: - * None.FRED TODO + * Access to the internal structures is protected by infoTablesMutex. * *---------------------------------------------------------------------- */ @@ -325,10 +424,10 @@ ProcessListObjCmd( list = Tcl_NewListObj(0, NULL); Tcl_MutexLock(&infoTablesMutex); for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); - entry != NULL; entry = Tcl_NextHashEntry(&search)) { - info = (ProcessInfo *) Tcl_GetHashValue(entry); - Tcl_ListObjAppendElement(interp, list, - Tcl_NewIntObj(info->resolvedPid)); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + Tcl_ListObjAppendElement(interp, list, + Tcl_NewIntObj(info->resolvedPid)); } Tcl_MutexUnlock(&infoTablesMutex); Tcl_SetObjResult(interp, list); @@ -340,13 +439,14 @@ ProcessListObjCmd( * ProcessStatusObjCmd -- * * This function implements the 'tcl::process status' Tcl command. - * Refer to the user documentation for details on what it does. + * Refer to the user documentation for details on what it does. * * Results: * Returns a standard Tcl result. * * Side effects: - * None.FRED TODO + * Access to the internal structures is protected by infoTablesMutex. + * Calls RefreshProcessInfo, which can block if -wait switch is given. * *---------------------------------------------------------------------- */ @@ -375,7 +475,7 @@ ProcessStatusObjCmd( enum switches { STATUS_WAIT, STATUS_LAST }; - + while (objc > 1) { if (TclGetString(objv[1])[0] != '-') { break; @@ -391,93 +491,93 @@ ProcessStatusObjCmd( break; } } - + if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?"); return TCL_ERROR; } if (objc == 1) { - /* - * Return a dict with all child process statuses. - */ - - dict = Tcl_NewDictObj(); - Tcl_MutexLock(&infoTablesMutex); - for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); - entry != NULL; entry = Tcl_NextHashEntry(&search)) { - info = (ProcessInfo *) Tcl_GetHashValue(entry); - RefreshProcessInfo(info, options); - - if (info->purge && autopurge) { - /* - * Purge entry. - */ - - Tcl_DeleteHashEntry(entry); - entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); - Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info); - } else { - /* - * Add to result. - */ - - Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), - BuildProcessStatusObj(info)); - } - } - Tcl_MutexUnlock(&infoTablesMutex); + /* + * Return a dict with all child process statuses. + */ + + dict = Tcl_NewDictObj(); + Tcl_MutexLock(&infoTablesMutex); + for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + RefreshProcessInfo(info, options); + + if (info->purge && autopurge) { + /* + * Purge entry. + */ + + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); + } else { + /* + * Add to result. + */ + + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + BuildProcessStatusObj(info)); + } + } + Tcl_MutexUnlock(&infoTablesMutex); } else { - /* - * Only return statuses of provided processes. - */ - - result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); - if (result != TCL_OK) { - return result; - } - dict = Tcl_NewDictObj(); - Tcl_MutexLock(&infoTablesMutex); - for (i = 0; i < numPids; i++) { - result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); - if (result != TCL_OK) { - Tcl_MutexUnlock(&infoTablesMutex); - Tcl_DecrRefCount(dict); - return result; - } - - entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); - if (!entry) { - /* - * Skip unknown process. - */ - - continue; - } - - info = (ProcessInfo *) Tcl_GetHashValue(entry); - RefreshProcessInfo(info, options); - - if (info->purge && autopurge) { - /* - * Purge entry. - */ - - Tcl_DeleteHashEntry(entry); - entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); - Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info); - } else { - /* - * Add to result. - */ - - Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), - BuildProcessStatusObj(info)); - } - } - Tcl_MutexUnlock(&infoTablesMutex); + /* + * Only return statuses of provided processes. + */ + + result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); + if (result != TCL_OK) { + return result; + } + dict = Tcl_NewDictObj(); + Tcl_MutexLock(&infoTablesMutex); + for (i = 0; i < numPids; i++) { + result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); + if (result != TCL_OK) { + Tcl_MutexUnlock(&infoTablesMutex); + Tcl_DecrRefCount(dict); + return result; + } + + entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); + if (!entry) { + /* + * Skip unknown process. + */ + + continue; + } + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + RefreshProcessInfo(info, options); + + if (info->purge && autopurge) { + /* + * Purge entry. + */ + + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); + } else { + /* + * Add to result. + */ + + Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), + BuildProcessStatusObj(info)); + } + } + Tcl_MutexUnlock(&infoTablesMutex); } Tcl_SetObjResult(interp, dict); return TCL_OK; @@ -488,13 +588,13 @@ ProcessStatusObjCmd( * ProcessPurgeObjCmd -- * * This function implements the 'tcl::process purge' Tcl command. - * Refer to the user documentation for details on what it does. + * Refer to the user documentation for details on what it does. * * Results: * Returns a standard Tcl result. * * Side effects: - * None.FRED TODO + * Frees all ProcessInfo structures with their purge flag set. * *---------------------------------------------------------------------- */ @@ -525,61 +625,61 @@ ProcessPurgeObjCmd( */ Tcl_ReapDetachedProcs(); - + if (objc == 1) { - /* - * Purge all terminated processes. - */ - - Tcl_MutexLock(&infoTablesMutex); - for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); - entry != NULL; entry = Tcl_NextHashEntry(&search)) { - info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->purge) { - Tcl_DeleteHashEntry(entry); - entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); - Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info); - } - } - Tcl_MutexUnlock(&infoTablesMutex); + /* + * Purge all terminated processes. + */ + + Tcl_MutexLock(&infoTablesMutex); + for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->purge) { + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); + } + } + Tcl_MutexUnlock(&infoTablesMutex); } else { - /* - * Purge only provided processes. - */ - - result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); - if (result != TCL_OK) { - return result; - } - Tcl_MutexLock(&infoTablesMutex); - for (i = 0; i < numPids; i++) { - result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); - if (result != TCL_OK) { - Tcl_MutexUnlock(&infoTablesMutex); - return result; - } - - entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); - if (!entry) { - /* - * Skip unknown process. - */ - - continue; - } - - info = (ProcessInfo *) Tcl_GetHashValue(entry); - if (info->purge) { - Tcl_DeleteHashEntry(entry); - entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); - Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info); - } - } - Tcl_MutexUnlock(&infoTablesMutex); + /* + * Purge only provided processes. + */ + + result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); + if (result != TCL_OK) { + return result; + } + Tcl_MutexLock(&infoTablesMutex); + for (i = 0; i < numPids; i++) { + result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); + if (result != TCL_OK) { + Tcl_MutexUnlock(&infoTablesMutex); + return result; + } + + entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); + if (!entry) { + /* + * Skip unknown process. + */ + + continue; + } + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + if (info->purge) { + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); + } + } + Tcl_MutexUnlock(&infoTablesMutex); } - + return TCL_OK; } @@ -588,7 +688,7 @@ ProcessPurgeObjCmd( * ProcessAutopurgeObjCmd -- * * This function implements the 'tcl::process autopurge' Tcl command. - * Refer to the user documentation for details on what it does. + * Refer to the user documentation for details on what it does. * * Results: * Returns a standard Tcl result. @@ -612,17 +712,17 @@ ProcessAutopurgeObjCmd( } if (objc == 2) { - /* - * Set given value. - */ - - int flag; - int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag); - if (result != TCL_OK) { - return result; - } - - autopurge = !!flag; + /* + * Set given value. + */ + + int flag; + int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag); + if (result != TCL_OK) { + return result; + } + + autopurge = !!flag; } /* @@ -655,11 +755,11 @@ TclInitProcessCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap processImplMap[] = { - {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, - {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, - {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, - {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, - {NULL, NULL, NULL, NULL, NULL, 0} + {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, + {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, + {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {NULL, NULL, NULL, NULL, NULL, 0} }; Tcl_Command processCmd; @@ -672,20 +772,35 @@ TclInitProcessCmd( } Tcl_MutexUnlock(&infoTablesMutex); } - + processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap); Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0), - "process", 0); + "process", 0); return processCmd; } -/* FRED TODO */ +/* + *---------------------------------------------------------------------- + * + * TclProcessCreated -- + * + * Called when a child process has been created by Tcl. + * + * Results: + * None. + * + * Side effects: + * Internal structures are updated with a new ProcessInfo. + * + *---------------------------------------------------------------------- + */ + void TclProcessCreated( - Tcl_Pid pid) + Tcl_Pid pid) /* Process id. */ { int resolvedPid; - Tcl_HashEntry *entry; + Tcl_HashEntry *entry, *entry2; int isNew; ProcessInfo *info; @@ -694,7 +809,7 @@ TclProcessCreated( */ resolvedPid = TclpGetPid(pid); - + Tcl_MutexLock(&infoTablesMutex); /* @@ -703,12 +818,15 @@ TclProcessCreated( entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew); if (!isNew) { - /* - * Pid was reused, free old info and reuse structure. - */ - - info = (ProcessInfo *) Tcl_GetHashValue(entry); - FreeProcessInfo(info); + /* + * Pid was reused, free old info and reuse structure. + */ + + info = (ProcessInfo *) Tcl_GetHashValue(entry); + entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid, + INT2PTR(resolvedPid)); + if (entry2) Tcl_DeleteHashEntry(entry2); + FreeProcessInfo(info); } /* @@ -717,32 +835,53 @@ TclProcessCreated( info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); InitProcessInfo(info, pid, resolvedPid); - + /* * Add entry to tables. */ Tcl_SetHashValue(entry, info); entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid), - &isNew); + &isNew); Tcl_SetHashValue(entry, info); - + Tcl_MutexUnlock(&infoTablesMutex); } +/* + *---------------------------------------------------------------------- + * + * TclProcessWait -- + * + * Wait for process status to change. + * + * Results: + * TclProcessWaitStatus enum value. + * + * Side effects: + * Completed process info structures are purged immediately (autopurge on) + * or eventually (autopurge off). + * + *---------------------------------------------------------------------- + */ -/* FRED TODO */ TclProcessWaitStatus TclProcessWait( - Tcl_Pid pid, - int options, - int *codePtr, - Tcl_Obj **msgObjPtr, - Tcl_Obj **errorObjPtr) + Tcl_Pid pid, /* Process id. */ + int options, /* Options passed to WaitProcessStatus. */ + int *codePtr, /* If non-NULL, will receive either: + * - 0 for normal exit. + * - errno in case of error. + * - non-zero exit code for abormal exit. + * - signal number if killed or suspended. + * - Tcl_WaitPid status in all other cases. + */ + Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ + Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { Tcl_HashEntry *entry; ProcessInfo *info; - int result; + TclProcessWaitStatus result; /* * First search for pid in table. @@ -750,34 +889,34 @@ TclProcessWait( entry = Tcl_FindHashEntry(&infoTablePerPid, pid); if (!entry) { - /* - * Unknown process, just call WaitProcessStatus and return. - */ - - result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, - msgObjPtr, errorObjPtr); - if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); - if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); - return result; + /* + * Unknown process, just call WaitProcessStatus and return. + */ + + result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, + msgObjPtr, errorObjPtr); + if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); + if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); + return result; } info = (ProcessInfo *) Tcl_GetHashValue(entry); if (info->purge) { - /* - * Process has completed but TclProcessWait has already been called, - * so report no change. - */ - - return TCL_PROCESS_UNCHANGED; + /* + * Process has completed but TclProcessWait has already been called, + * so report no change. + */ + + return TCL_PROCESS_UNCHANGED; } RefreshProcessInfo(info, options); if (info->status == TCL_PROCESS_UNCHANGED) { - /* - * No change, stop there. - */ - - return TCL_PROCESS_UNCHANGED; + /* + * No change, stop there. + */ + + return TCL_PROCESS_UNCHANGED; } /* @@ -792,22 +931,22 @@ TclProcessWait( if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); if (autopurge) { - /* - * Purge now. - */ - - Tcl_DeleteHashEntry(entry); - entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, - INT2PTR(info->resolvedPid)); - Tcl_DeleteHashEntry(entry); - FreeProcessInfo(info); + /* + * Purge now. + */ + + Tcl_DeleteHashEntry(entry); + entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, + INT2PTR(info->resolvedPid)); + Tcl_DeleteHashEntry(entry); + FreeProcessInfo(info); } else { - /* - * Eventually purge. Subsequent calls will return - * TCL_PROCESS_UNCHANGED. - */ + /* + * Eventually purge. Subsequent calls will return + * TCL_PROCESS_UNCHANGED. + */ - info->purge = 1; + info->purge = 1; } return result; } -- cgit v0.12 From 522456ba985545e9ba23b34d8093a2f770ebc10b Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 5 Sep 2017 16:33:37 +0000 Subject: Removed the package style loader from tclAppInit. Zipfs now loads as part of the interpreter. --- unix/tclAppInit.c | 5 ----- win/tclAppInit.c | 5 ----- 2 files changed, 10 deletions(-) diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 40b10f3..9bbc88b 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -17,7 +17,6 @@ #include "tcl.h" #ifdef TCL_TEST -#include "tclZipfs.h" extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ @@ -124,10 +123,6 @@ Tcl_AppInit( return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); - if (Tclzipfs_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); #endif /* TCL_TEST */ /* diff --git a/win/tclAppInit.c b/win/tclAppInit.c index b821ca7..e06eaf5 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -25,7 +25,6 @@ #include #ifdef TCL_TEST -#include "tclZipfs.h" extern Tcl_PackageInitProc Tcltest_Init; extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ @@ -175,10 +174,6 @@ Tcl_AppInit( return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); - if (Tclzipfs_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit); #endif /* TCL_TEST */ /* -- cgit v0.12 From b1dc2099c73d4588f26bf86db45046014d647a12 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Sep 2017 13:22:46 +0000 Subject: When we invalidate the string rep of a dict, that's a sign we need to free all the intreps of that dict as well. --- generic/tclDictObj.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index f4e15a6..b312fe1 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -909,7 +909,11 @@ InvalidateDictChain( assert( dict != NULL); do { + dict->refCount++; TclInvalidateStringRep(dictObj); + Tcl_FreeIntRep(dictObj); + DictSetIntRep(dictObj, dict); + dict->epoch++; dictObj = dict->chain; if (dictObj == NULL) { -- cgit v0.12 From bbcc51539b6cbb04bdee6c87c3f321d0f47d583b Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Sep 2017 13:23:40 +0000 Subject: Revised dict value means we much invalidate existing intreps. --- generic/tclDictObj.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index b312fe1..d0ef59d 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -911,7 +911,7 @@ InvalidateDictChain( do { dict->refCount++; TclInvalidateStringRep(dictObj); - Tcl_FreeIntRep(dictObj); + TclFreeIntRep(dictObj); DictSetIntRep(dictObj, dict); dict->epoch++; @@ -965,6 +965,9 @@ Tcl_DictObjPut( TclInvalidateStringRep(dictPtr); hPtr = CreateChainEntry(dict, keyPtr, &isNew); + dict->refCount++; + TclFreeIntRep(dictPtr) + DictSetIntRep(dictPtr, dict); Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr); -- cgit v0.12 From ed8604f566febdc366bae97f8d431a20612b3bfb Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Sep 2017 15:18:46 +0000 Subject: Make sure ListObjAppendElement invalidates outdated intreps. --- generic/tclListObj.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index c33b95e..fc253cc 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -711,6 +711,10 @@ Tcl_ListObjAppendElement( listRepPtr = newPtr; } ListResetIntRep(listPtr, listRepPtr); + listRepPtr->refCount++; + TclFreeIntRep(listPtr); + ListSetIntRep(listPtr, listRepPtr); + listRepPtr->refCount--; /* * Add objPtr to the end of listPtr's array of element pointers. Increment -- cgit v0.12 From de6b083f580fde9bac4b7498524a30b87581fabb Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Sep 2017 15:44:00 +0000 Subject: Make sure ListObjReplace invalidates outdated intreps. --- generic/tclListObj.c | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index fc253cc..f60329d 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1127,10 +1127,15 @@ Tcl_ListObjReplace( listRepPtr->elemCount = numRequired; /* - * Invalidate and free any old string representation since it no longer - * reflects the list's internal representation. + * Invalidate and free any old representations that may not agree + * with the revised list's internal representation. */ + listRepPtr->refCount++; + TclFreeIntRep(listPtr); + ListSetIntRep(listPtr, listRepPtr); + listRepPtr->refCount--; + TclInvalidateStringRep(listPtr); return TCL_OK; } -- cgit v0.12 From 41765c8938c367e0824c280bbfe292bec64d52e1 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Sep 2017 17:01:55 +0000 Subject: Rework [lset] internals to be sure outdated intreps get purged. --- generic/tclListObj.c | 39 ++++++++++++++++++++++++++++++--------- 1 file changed, 30 insertions(+), 9 deletions(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index f60329d..c6d8d0e 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1594,23 +1594,32 @@ TclLsetFlat( while (chainPtr) { Tcl_Obj *objPtr = chainPtr; + List *listRepPtr; + /* + * Clear away our intrep surgery mess. + */ + + irPtr = Tcl_FetchIntRep(objPtr, &tclListType); + listRepPtr = irPtr->twoPtrValue.ptr1; + chainPtr = irPtr->twoPtrValue.ptr2; + if (result == TCL_OK) { + /* * We're going to store valuePtr, so spoil string reps of all * containing lists. */ + listRepPtr->refCount++; + TclFreeIntRep(objPtr); + ListSetIntRep(objPtr, listRepPtr); + listRepPtr->refCount--; + TclInvalidateStringRep(objPtr); + } else { + irPtr->twoPtrValue.ptr2 = NULL; } - - /* - * Clear away our intrep surgery mess. - */ - - irPtr = Tcl_FetchIntRep(objPtr, &tclListType); - chainPtr = irPtr->twoPtrValue.ptr2; - irPtr->twoPtrValue.ptr2 = NULL; } if (result != TCL_OK) { @@ -1637,8 +1646,8 @@ TclLsetFlat( Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); + TclInvalidateStringRep(subListPtr); } - TclInvalidateStringRep(subListPtr); Tcl_IncrRefCount(retValuePtr); return retValuePtr; } @@ -1781,6 +1790,18 @@ TclListObjSetElement( elemPtrs[index] = valuePtr; + /* + * Invalidate outdated intreps. + */ + + ListGetIntRep(listPtr, listRepPtr); + listRepPtr->refCount++; + TclFreeIntRep(listPtr); + ListSetIntRep(listPtr, listRepPtr); + listRepPtr->refCount--; + + TclInvalidateStringRep(listPtr); + return TCL_OK; } -- cgit v0.12 From 2af8b0203eae756de9f337054ead9cca1c317024 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 22 Sep 2017 13:32:31 +0000 Subject: Partial conversion of the "path" Tcl_ObjType to TIP 445 contributed by Cyan Ogilvie. This reworking also eliminates circular references in the "path" values. Test suite indicates the change works. Don't know what, if anything, was lost compared to the original Darley design. --- generic/tclPathObj.c | 194 +++++++++++++++++---------------------------------- 1 file changed, 64 insertions(+), 130 deletions(-) diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 4e10087..9b2e67d 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -51,19 +51,14 @@ static const Tcl_ObjType fsPathType = { * represent relative or absolute paths, and has certain optimisations when * used to represent paths which are already normalized and absolute. * - * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular - * reference to the container Tcl_Obj of this FsPath. - * * There are two cases, with the first being the most common: * * (i) flags == 0, => Ordinary path. * - * translatedPathPtr contains the translated path (which may be a circular - * reference to the object itself). If it is NULL then the path is pure - * normalized (and the normPathPtr will be a circular reference). cwdPtr is - * null for an absolute path, and non-null for a relative path (unless the cwd - * has never been set, in which case the cwdPtr may also be null for a - * relative path). + * translatedPathPtr contains the translated path. If it is NULL then the path + * is pure normalized. cwdPtr is null for an absolute path, and non-null for a + * relative path (unless the cwd has never been set, in which case the cwdPtr + * may also be null for a relative path). * * (ii) flags != 0, => Special path, see TclNewFSPathObj * @@ -79,11 +74,7 @@ typedef struct FsPath { * Tcl_Obj's string rep is already both * translated and normalized. */ Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or - * ~user sequences. If the Tcl_Obj containing - * this FsPath is already normalized, this may - * be a circular reference back to the - * container. If that is NOT the case, we have - * a refCount on the object. */ + * ~user sequences. */ Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points * to the cwd object used for this path. We * have a refCount on the object. */ @@ -110,9 +101,14 @@ typedef struct FsPath { * fields. */ -#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) +#define PATHOBJ(pathPtr) ((FsPath *) (Tcl_FetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) #define SETPATHOBJ(pathPtr,fsPathPtr) \ - ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) + do { \ + Tcl_ObjIntRep ir; \ + ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreIntRep((pathPtr), &fsPathType, &ir); \ + } while (0) #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* @@ -564,7 +560,9 @@ TclPathPart( Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { - if (pathPtr->typePtr == &fsPathType) { + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + + if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { @@ -864,6 +862,7 @@ TclJoinPath( if (elements == 2) { Tcl_Obj *elt = objv[0]; + Tcl_ObjIntRep *eltIr = Tcl_FetchIntRep(elt, &fsPathType); /* * This is a special case where we can be much more efficient, where @@ -877,7 +876,7 @@ TclJoinPath( * to be an absolute path. Added a check for that elt is absolute. */ - if ((elt->typePtr == &fsPathType) + if ((eltIr) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { Tcl_Obj *tailObj = objv[1]; @@ -1154,6 +1153,8 @@ Tcl_FSConvertToPathType( Tcl_Obj *pathPtr) /* Object to convert to a valid, current path * type. */ { + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + /* * While it is bad practice to examine an object's type directly, this is * actually the best thing to do here. The reason is that if we are @@ -1164,7 +1165,7 @@ Tcl_FSConvertToPathType( * path. */ - if (pathPtr->typePtr == &fsPathType) { + if (irPtr) { if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { return TCL_OK; } @@ -1172,7 +1173,7 @@ Tcl_FSConvertToPathType( if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } - FreeFsPathInternalRep(pathPtr); + Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); } return SetFsPathFromAny(interp, pathPtr); @@ -1328,7 +1329,6 @@ TclNewFSPathObj( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; - pathPtr->typePtr = &fsPathType; pathPtr->bytes = NULL; pathPtr->length = 0; @@ -1430,8 +1430,9 @@ TclFSMakePathRelative( { int cwdLen, len; const char *tempStr; + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); - if (pathPtr->typePtr == &fsPathType) { + if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { @@ -1498,31 +1499,12 @@ MakePathFromNormalized( Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); - if (pathPtr->typePtr == &fsPathType) { + if (irPtr) { return TCL_OK; } - /* - * Free old representation - */ - - if (pathPtr->typePtr != NULL) { - if (pathPtr->bytes == NULL) { - if (pathPtr->typePtr->updateStringProc == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't find object string representation", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF", - NULL); - } - return TCL_ERROR; - } - pathPtr->typePtr->updateStringProc(pathPtr); - } - TclFreeIntRep(pathPtr); - } - fsPathPtr = ckalloc(sizeof(FsPath)); /* @@ -1531,11 +1513,7 @@ MakePathFromNormalized( fsPathPtr->translatedPathPtr = NULL; - /* - * Circular reference by design. - */ - - fsPathPtr->normPathPtr = pathPtr; + Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; @@ -1544,7 +1522,6 @@ MakePathFromNormalized( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &fsPathType; return TCL_OK; } @@ -1595,25 +1572,12 @@ Tcl_FSNewNativePath( * safe. */ - if (pathPtr->typePtr != NULL) { - if (pathPtr->bytes == NULL) { - if (pathPtr->typePtr->updateStringProc == NULL) { - return NULL; - } - pathPtr->typePtr->updateStringProc(pathPtr); - } - TclFreeIntRep(pathPtr); - } - + Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; - /* - * Circular reference, by design. - */ - - fsPathPtr->normPathPtr = pathPtr; + Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; @@ -1621,7 +1585,6 @@ Tcl_FSNewNativePath( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &fsPathType; return pathPtr; } @@ -1668,20 +1631,22 @@ Tcl_FSGetTranslatedPath( Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, srcFsPathPtr->cwdPtr); + Tcl_ObjIntRep *translatedCwdIrPtr; + if (translatedCwdPtr == NULL) { return NULL; } retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); - srcFsPathPtr->translatedPathPtr = retObj; - if (translatedCwdPtr->typePtr == &fsPathType) { + Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj); + translatedCwdIrPtr = Tcl_FetchIntRep(translatedCwdPtr, &fsPathType); + if (translatedCwdIrPtr) { srcFsPathPtr->filesystemEpoch = PATHOBJ(translatedCwdPtr)->filesystemEpoch; } else { srcFsPathPtr->filesystemEpoch = 0; } - Tcl_IncrRefCount(retObj); Tcl_DecrRefCount(translatedCwdPtr); } else { /* @@ -1864,6 +1829,7 @@ Tcl_FSGetNormalizedPath( /* * That's our reference to copy used. */ + copy = NULL; TclDecrRefCount(dir); TclDecrRefCount(origDir); @@ -1876,7 +1842,7 @@ Tcl_FSGetNormalizedPath( /* * That's our reference to copy used. */ - + copy = NULL; TclDecrRefCount(dir); } PATHFLAGS(pathPtr) = 0; @@ -1891,7 +1857,7 @@ Tcl_FSGetNormalizedPath( if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } - FreeFsPathInternalRep(pathPtr); + Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } @@ -1917,7 +1883,6 @@ Tcl_FSGetNormalizedPath( } if (fsPathPtr->normPathPtr == NULL) { Tcl_Obj *useThisCwd = NULL; - int pureNormalized = 1; /* * Since normPathPtr is NULL, but this is a valid path object, we know @@ -1967,7 +1932,6 @@ Tcl_FSGetNormalizedPath( return NULL; } - pureNormalized = 0; Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); @@ -1987,7 +1951,6 @@ Tcl_FSGetNormalizedPath( if (absolutePath == NULL) { return NULL; } - pureNormalized = 0; #endif /* _WIN32 */ } } @@ -1996,35 +1959,12 @@ Tcl_FSGetNormalizedPath( * Already has refCount incremented. */ + if (fsPathPtr->normPathPtr) { + Tcl_DecrRefCount(fsPathPtr->normPathPtr); + } fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath); - /* - * Check if path is pure normalized (this can only be the case if it - * is an absolute path). - */ - - if (pureNormalized) { - int normPathLen, pathLen; - const char *normPath; - - path = TclGetStringFromObj(pathPtr, &pathLen); - normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen); - if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) { - /* - * The path was already normalized. Get rid of the duplicate. - */ - - TclDecrRefCount(fsPathPtr->normPathPtr); - - /* - * We do *not* increment the refCount for this circular - * reference. - */ - - fsPathPtr->normPathPtr = pathPtr; - } - } if (useThisCwd != NULL) { /* * We just need to free an object we allocated above for relative @@ -2170,8 +2110,9 @@ TclFSEnsureEpochOk( const Tcl_Filesystem **fsPtrPtr) { FsPath *srcFsPathPtr; + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); - if (pathPtr->typePtr != &fsPathType) { + if (irPtr == NULL) { return TCL_OK; } @@ -2190,7 +2131,7 @@ TclFSEnsureEpochOk( if (pathPtr->bytes == NULL) { UpdateStringOfFsPath(pathPtr); } - FreeFsPathInternalRep(pathPtr); + Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } @@ -2230,12 +2171,13 @@ TclFSSetPathDetails( ClientData clientData) { FsPath *srcFsPathPtr; + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);; /* * Make sure pathPtr is of the correct type. */ - if (pathPtr->typePtr != &fsPathType) { + if (irPtr == NULL) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } @@ -2333,8 +2275,9 @@ SetFsPathFromAny( FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); - if (pathPtr->typePtr == &fsPathType) { + if (irPtr) { return TCL_OK; } @@ -2477,8 +2420,10 @@ SetFsPathFromAny( fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; - if (transPtr != pathPtr) { + if (fsPathPtr->translatedPathPtr != NULL) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + } + if (transPtr != pathPtr) { /* Redo translation when $env(HOME) changes */ fsPathPtr->filesystemEpoch = TclFSEpoch(); } else { @@ -2489,14 +2434,8 @@ SetFsPathFromAny( fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; - /* - * Free old representation before installing our new one. - */ - - TclFreeIntRep(pathPtr); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &fsPathType; return TCL_OK; } @@ -2519,6 +2458,7 @@ FreeFsPathInternalRep( } if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); + fsPathPtr->cwdPtr = NULL; } if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = @@ -2531,7 +2471,6 @@ FreeFsPathInternalRep( } ckfree(fsPathPtr); - pathPtr->typePtr = NULL; } static void @@ -2544,24 +2483,14 @@ DupFsPathInternalRep( SETPATHOBJ(copyPtr, copyFsPathPtr); - if (srcFsPathPtr->translatedPathPtr == srcPtr) { - /* Cycle in src -> make cycle in copy. */ - copyFsPathPtr->translatedPathPtr = copyPtr; - } else { - copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; - if (copyFsPathPtr->translatedPathPtr != NULL) { - Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); - } + copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; + if (copyFsPathPtr->translatedPathPtr != NULL) { + Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } - if (srcFsPathPtr->normPathPtr == srcPtr) { - /* Cycle in src -> make cycle in copy. */ - copyFsPathPtr->normPathPtr = copyPtr; - } else { - copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; - if (copyFsPathPtr->normPathPtr != NULL) { - Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); - } + copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; + if (copyFsPathPtr->normPathPtr != NULL) { + Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; @@ -2587,8 +2516,6 @@ DupFsPathInternalRep( } copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - - copyPtr->typePtr = &fsPathType; } /* @@ -2620,7 +2547,12 @@ UpdateStringOfFsPath( } copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); + if (Tcl_IsShared(copy)) { + copy = Tcl_DuplicateObj(copy); + } + Tcl_IncrRefCount(copy); + /* Steal copy's string rep */ pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; TclInitStringRep(copy, NULL, 0); @@ -2653,6 +2585,8 @@ TclNativePathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { + Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + /* * A special case is required to handle the empty path "". This is a valid * path (i.e. the user should be able to do 'file exists ""' without @@ -2660,7 +2594,7 @@ TclNativePathInFilesystem( * semantics of Tcl (at present anyway), so we have to abide by them here. */ - if (pathPtr->typePtr == &fsPathType) { + if (irPtr) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { /* * We reject the empty path "". -- cgit v0.12 From de970528d7f4dd9acb90d3ddfabdc79849808923 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 22 Sep 2017 14:11:45 +0000 Subject: More TIP 445 conversion of the "path" Tcl_ObjType. --- generic/tclPathObj.c | 40 +++++----------------------------------- 1 file changed, 5 insertions(+), 35 deletions(-) diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 9b2e67d..be3d57c 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1170,34 +1170,11 @@ Tcl_FSConvertToPathType( return TCL_OK; } - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } + TclGetString(pathPtr); Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); } return SetFsPathFromAny(interp, pathPtr); - - /* - * We used to have more complex code here: - * - * FsPath *fsPathPtr = PATHOBJ(pathPtr); - * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { - * return TCL_OK; - * } else { - * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - * return TCL_OK; - * } else { - * if (pathPtr->bytes == NULL) { - * UpdateStringOfFsPath(pathPtr); - * } - * FreeFsPathInternalRep(pathPtr); - * return Tcl_ConvertToType(interp, pathPtr, &fsPathType); - * } - * } - * - * But we no longer believe this is necessary. - */ } /* @@ -1329,8 +1306,7 @@ TclNewFSPathObj( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; - pathPtr->bytes = NULL; - pathPtr->length = 0; + TclInvalidateStringRep(pathPtr); /* * Look for path components made up of only "." @@ -1756,9 +1732,7 @@ Tcl_FSGetNormalizedPath( return NULL; } /* TODO: Figure out why this is needed. */ - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } + TclGetString(pathPtr); TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { @@ -1854,9 +1828,7 @@ Tcl_FSGetNormalizedPath( if (fsPathPtr->cwdPtr != NULL) { if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } + TclGetString(pathPtr); Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; @@ -2128,9 +2100,7 @@ TclFSEnsureEpochOk( * We have to discard the stale representation and recalculate it. */ - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } + TclGetString(pathPtr); Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; -- cgit v0.12 From 54bc992b814ebb022b6cdb9798e2effdc14a2550 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 25 Sep 2017 16:23:56 +0000 Subject: Improvements to Tip#430 based on community input. Added a forward declaration of TclZipfs_Init. Added TclZipfs_Mount() and TclZifs_Unmount to stubs table. --- generic/tcl.decls | 9 +++++++- generic/tclBasic.c | 2 +- generic/tclDecls.h | 13 +++++++++++ generic/tclInt.h | 4 ++++ generic/tclStubInit.c | 2 ++ generic/tclZipfs.c | 62 +++++++++++++++++++++++++-------------------------- generic/tclZipfs.h | 8 +++---- 7 files changed, 63 insertions(+), 37 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..c19bf68 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2335,7 +2335,14 @@ declare 631 { # ----- BASELINE -- FOR -- 8.7.0 ----- # - +# TIP #430 +declare 632 { + int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, + const char *passwd) +} +declare 633 { + int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) +} ############################################################################## diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f798a3d..3e6ad56 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -990,7 +990,7 @@ Tcl_CreateInterp(void) if (TclZlibInit(interp) != TCL_OK) { Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } - if (TclZipfsInit(interp) != TCL_OK) { + if (TclZipfs_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } #endif diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..24a22c3 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1831,6 +1831,13 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); +/* 632 */ +EXTERN int TclZipfs_Mount(Tcl_Interp *interp, + const char *zipname, const char *mntpt, + const char *passwd); +/* 633 */ +EXTERN int TclZipfs_Unmount(Tcl_Interp *interp, + const char *zipname); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2498,6 +2505,8 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 632 */ + int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3792,6 +3801,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ #define Tcl_OpenTcpServerEx \ (tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */ +#define TclZipfs_Mount \ + (tclStubsPtr->tclZipfs_Mount) /* 632 */ +#define TclZipfs_Unmount \ + (tclStubsPtr->tclZipfs_Unmount) /* 633 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclInt.h b/generic/tclInt.h index be93f16..8339fb1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3215,6 +3215,10 @@ MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length); +/* Tip 430 */ +MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); +MODULE_SCOPE int TclZipfs_SafeInit(Tcl_Interp *interp); + /* *---------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..f251a57 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1536,6 +1536,8 @@ const TclStubs tclStubs = { Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ Tcl_OpenTcpServerEx, /* 631 */ + TclZipfs_Mount, /* 632 */ + TclZipfs_Unmount, /* 633 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 01d46c6..9d74890 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -505,19 +505,19 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA int i, j, c, isunc = 0, isvfs=0, n=0; #if HAS_DRIVES int zipfspath=1; - if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && - (tail[1] == ':')) { + if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && + (tail[1] == ':')) { tail += 2; zipfspath=0; - } - /* UNC style path */ - if (tail[0] == '\\') { - root = ""; + } + /* UNC style path */ + if (tail[0] == '\\') { + root = ""; ++tail; zipfspath=0; - } - if (tail[0] == '\\') { - root = "/"; + } + if (tail[0] == '\\') { + root = "/"; ++tail; zipfspath=0; } @@ -571,7 +571,7 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA } else if(isvfs==2) { Tcl_DStringSetLength(dsPtr, j); path = Tcl_DStringValue(dsPtr); - memcpy(path, tail, j); + memcpy(path, tail, j); } else { if (ZIPFSPATH) { Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); @@ -586,12 +586,12 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA memcpy(path + i, tail, j); } } -#if HAS_DRIVES - for (i = 0; path[i] != '\0'; i++) { - if (path[i] == '\\') { - path[i] = '/'; +#if HAS_DRIVES + for (i = 0; path[i] != '\0'; i++) { + if (path[i] == '\\') { + path[i] = '/'; } - } + } #endif if(ZIPFSPATH) { n=ZIPFS_VOLUME_LEN; @@ -706,7 +706,7 @@ static ZipEntry * ZipFSLookup(char *filename) { char *realname; - + Tcl_HashEntry *hPtr; ZipEntry *z; Tcl_DString ds; @@ -1030,7 +1030,7 @@ error: /* *------------------------------------------------------------------------- * - * TclZipfsMount -- + * TclZipfs_Mount -- * * This procedure is invoked to mount a given ZIP archive file on * a given mountpoint with optional ZIP password. @@ -1046,7 +1046,7 @@ error: */ int -TclZipfsMount(Tcl_Interp *interp, const char *zipname, const char *mntpt, +TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { char *realname, *p; @@ -1379,7 +1379,7 @@ nextent: /* *------------------------------------------------------------------------- * - * TclZipfsUnmount -- + * TclZipfs_Unmount -- * * This procedure is invoked to unmount a given ZIP archive. * @@ -1393,7 +1393,7 @@ nextent: */ int -TclZipfsUnmount(Tcl_Interp *interp, const char *zipname) +TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) { char *realname; ZipFile *zf; @@ -1471,7 +1471,7 @@ ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, "?zipfile? ?mountpoint? ?password?"); return TCL_ERROR; } - return TclZipfsMount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, + return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, (objc > 2) ? Tcl_GetString(objv[2]) : NULL, (objc > 3) ? Tcl_GetString(objv[3]) : NULL); } @@ -1500,7 +1500,7 @@ ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp, Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); return TCL_ERROR; } - return TclZipfsUnmount(interp, Tcl_GetString(objv[1])); + return TclZipfs_Unmount(interp, Tcl_GetString(objv[1])); } /* @@ -2271,7 +2271,7 @@ ZipFSCanonicalObjCmd(ClientData clientData, Tcl_Interp *interp, } mntpoint = Tcl_GetString(objv[1]); filename = Tcl_GetString(objv[2]); - result=CanonicalPath(mntpoint,filename,&dPath,zipfs); + result=CanonicalPath(mntpoint,filename,&dPath,zipfs); } Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1)); return TCL_OK; @@ -3430,7 +3430,7 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) { return -1; } - + Tcl_DStringInit(&ds); path = CanonicalPath("",path, &ds, 1); len = Tcl_DStringLength(&ds); @@ -3793,7 +3793,7 @@ const Tcl_Filesystem zipfsFilesystem = { /* *------------------------------------------------------------------------- * - * TclZipfsInit -- + * TclZipfs_Init -- * * Perform per interpreter initialization of this module. * @@ -3808,7 +3808,7 @@ const Tcl_Filesystem zipfsFilesystem = { */ int -TclZipfsInit(Tcl_Interp *interp) +TclZipfs_Init(Tcl_Interp *interp) { #ifdef HAVE_ZLIB /* one-time initialization */ @@ -3884,7 +3884,7 @@ TclZipfsInit(Tcl_Interp *interp) /* *------------------------------------------------------------------------- * - * TclZipfsMount, TclZipfsUnmount -- + * TclZipfs_Mount, TclZipfs_Unmount -- * * Dummy version when no ZLIB support available. * @@ -3892,16 +3892,16 @@ TclZipfsInit(Tcl_Interp *interp) */ int -TclZipfsMount(Tcl_Interp *interp, const char *zipname, const char *mntpt, +TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { - return TclZipFsInit(interp, 1); + return TclZipfs_Init(interp, 1); } int -TclZipfsUnmount(Tcl_Interp *interp, const char *zipname) +TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) { - return TclZipFsInit(interp, 1); + return TclZipfs_Init(interp, 1); } #endif diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h index 01c9e96..f7da3bd 100644 --- a/generic/tclZipfs.h +++ b/generic/tclZipfs.h @@ -27,11 +27,11 @@ extern "C" { # define ZIPFSAPI DLLEXPORT #endif -ZIPFSAPI int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, +ZIPFSAPI int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); -ZIPFSAPI int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname); -ZIPFSAPI int Tclzipfs_Init(Tcl_Interp *interp); -ZIPFSAPI int Tclzipfs_SafeInit(Tcl_Interp *interp); +ZIPFSAPI int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname); +ZIPFSAPI int TclZipfs_Init(Tcl_Interp *interp); +ZIPFSAPI int TclZipfs_SafeInit(Tcl_Interp *interp); #ifdef __cplusplus } -- cgit v0.12 From 3b96c2260eeb2c9b54b90847874ec995663c9b3c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Sep 2017 09:05:47 +0000 Subject: Remove coffbase.txt and all references to it: It's not recommended by Microsoft any more. --- .fossil-settings/crlf-glob | 1 - .fossil-settings/crnl-glob | 1 - .fossil-settings/encoding-glob | 1 - macosx/Tcl.xcode/project.pbxproj | 2 -- macosx/Tcl.xcodeproj/project.pbxproj | 2 -- unix/Makefile.in | 1 - win/coffbase.txt | 43 ------------------------------------ win/makefile.vc | 6 ++--- win/rules.vc | 2 -- 9 files changed, 3 insertions(+), 56 deletions(-) delete mode 100644 win/coffbase.txt diff --git a/.fossil-settings/crlf-glob b/.fossil-settings/crlf-glob index 2041cb6..bfdcc18 100644 --- a/.fossil-settings/crlf-glob +++ b/.fossil-settings/crlf-glob @@ -9,7 +9,6 @@ libtommath/*.vcproj tools/tcl.hpj.in tools/tcl.wse.in win/buildall.vc.bat -win/coffbase.txt win/makefile.vc win/rules.vc win/tcl.dsp diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob index 2041cb6..bfdcc18 100644 --- a/.fossil-settings/crnl-glob +++ b/.fossil-settings/crnl-glob @@ -9,7 +9,6 @@ libtommath/*.vcproj tools/tcl.hpj.in tools/tcl.wse.in win/buildall.vc.bat -win/coffbase.txt win/makefile.vc win/rules.vc win/tcl.dsp diff --git a/.fossil-settings/encoding-glob b/.fossil-settings/encoding-glob index 8582dd4..ed50a55 100644 --- a/.fossil-settings/encoding-glob +++ b/.fossil-settings/encoding-glob @@ -1,7 +1,6 @@ tools/tcl.hpj.in tools/tcl.wse.in win/buildall.vc.bat -win/coffbase.txt win/makefile.vc win/rules.vc win/tcl.dsp diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index 3689a13..8e29b00 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -833,7 +833,6 @@ F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = ""; }; F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = ""; }; F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = ""; }; - F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = ""; }; F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D447508F272BA004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = ""; }; F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; @@ -1754,7 +1753,6 @@ F96D447008F272BA004A47F5 /* aclocal.m4 */, F96D447108F272BA004A47F5 /* buildall.vc.bat */, F96D447208F272BA004A47F5 /* cat.c */, - F96D447308F272BA004A47F5 /* coffbase.txt */, F96D447408F272BA004A47F5 /* configure */, F96D447508F272BA004A47F5 /* configure.ac */, F96D447708F272BA004A47F5 /* Makefile.in */, diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 36f3b99..574aaae 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -834,7 +834,6 @@ F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = ""; }; F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = ""; }; F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = ""; }; - F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = ""; }; F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D447508F272BA004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = ""; }; F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; @@ -1755,7 +1754,6 @@ F96D447008F272BA004A47F5 /* aclocal.m4 */, F96D447108F272BA004A47F5 /* buildall.vc.bat */, F96D447208F272BA004A47F5 /* cat.c */, - F96D447308F272BA004A47F5 /* coffbase.txt */, F96D447408F272BA004A47F5 /* configure */, F96D447508F272BA004A47F5 /* configure.ac */, F96D447708F272BA004A47F5 /* Makefile.in */, diff --git a/unix/Makefile.in b/unix/Makefile.in index e2f4189..3df33d8 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2047,7 +2047,6 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win - cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win cp -p $(TOP_DIR)/win/README $(DISTDIR)/win diff --git a/win/coffbase.txt b/win/coffbase.txt deleted file mode 100644 index 3314f26..0000000 --- a/win/coffbase.txt +++ /dev/null @@ -1,43 +0,0 @@ -; -; This file defines the virtual base addresses for the Dynamic Link Libraries -; that are part of the Tcl system. The first token on a line is the key (or name -; of the DLL) and the second token is the virtual base address, in hexidecimal. -; The third token is the maximum size of the DLL image file, including symbols. -; -; Using a specified "prefered load address" should speed loading time by avoiding -; relocations (NT supported only). It is assumed extension authors will contribute -; their modules to this grand-master list. You can use the dumpbin utility with -; the /headers option to get the "size of image" data (already in hex). If the -; maximum size is too small a linker warning will occur. Modules can overlap when -; they're mutually exclusive. This info is placed in the DLL's PE header by the -; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,` option. - -tcl 0x10000000 0x00200000 -tcldde 0x10200000 0x00010000 -tclreg 0x10210000 0x00010000 -tk 0x10220000 0x00200000 -expect 0x10480000 0x00080000 -itcl 0x10500000 0x00080000 -itk 0x10580000 0x00080000 -bltlite 0x10600000 0x00080000 -blt 0x10680000 0x00080000 -iocpsock 0x10700000 0x00080000 -tls 0x10780000 0x00100000 -winico 0x10880000 0x00010000 -sample 0x108B0000 0x00010000 -tile 0x10900000 0x00080000 -memchan 0x109D0000 0x00010000 -tdom 0x109E0000 0x00080000 -tclvfs 0x10A70000 0x00010000 -tkvideo 0x10B00000 0x00010000 -tclsdl 0x10B20000 0x00080000 -vqtcl 0x10C00000 0x00010000 -tdbc 0x10C40000 0x00010000 -thread 0x10C80000 0x00020000 -nsf 0x10ca0000 0x00080000 -; -; insert new packages here -; -snack 0x1E000000 0x00400000 -sound 0x1E400000 0x00400000 -snackogg 0x1E800000 0x00200000 diff --git a/win/makefile.vc b/win/makefile.vc index bbc40df..c404fdc 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -634,7 +634,7 @@ $(TCLLIB): $(TCLOBJS) $** << !else - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \ + $(link32) $(dlllflags) -out:$@ \ $(baselibs) @<< $** << @@ -657,7 +657,7 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** !else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ + $(link32) $(dlllflags) -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) !endif @@ -667,7 +667,7 @@ $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ + $(link32) $(dlllflags) -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) !endif diff --git a/win/rules.vc b/win/rules.vc index 9654a63..c7c3c61 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -592,7 +592,6 @@ TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib" -COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" !else @@ -605,7 +604,6 @@ TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib" -COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" !endif -- cgit v0.12 From 5015dd8a1f1a346f1105d9d31a21ab7c496746c9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Oct 2017 14:46:26 +0000 Subject: Fix missing line (after manual merge-conflict). Fix compiler warning on linux64. --- generic/tcl.h | 6 +++++- generic/tclStringObj.c | 1 + 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index b847fef..5c32781 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -424,7 +424,11 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # define TCL_LL_MODIFIER "ll" #endif /* !TCL_LL_MODIFIER */ #ifndef TCL_Z_MODIFIER -# define TCL_Z_MODIFIER "" +# if defined(__GNUC__) && !defined(_WIN32) +# define TCL_Z_MODIFIER "z" +# else +# define TCL_Z_MODIFIER "" +# endif #endif /* !TCL_Z_MODIFIER */ #define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) #define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 6d065c3..98f4755 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2028,6 +2028,7 @@ Tcl_AppendFormatToObj( if (gotHash || (ch == 'p')) { switch (ch) { case 'o': + Tcl_AppendToObj(segment, "0o", 2); segmentLimit -= 2; break; case 'p': -- cgit v0.12 From a72fed191ebed3ff0a7a22b976155f08082c9fdf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 14 Oct 2017 22:52:26 +0000 Subject: fix unixFCmd test-cases, as result of the octal behavior change --- tests/unixFCmd.test | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 183c145..08eb664 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -221,12 +221,12 @@ test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup { cleanup } -constraints {unix notRoot} -body { close [open tf1 a] - file attributes tf1 -permissions 0472 + file attributes tf1 -permissions 0o472 file copy tf1 tf2 file attributes tf2 -permissions } -cleanup { cleanup -} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w- +} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w- test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} { } {} @@ -375,11 +375,11 @@ proc permcheck {testnum permList expected} { set result } $expected } -permcheck unixFCmd-17.5 rwxrwxrwx 00777 -permcheck unixFCmd-17.6 r--r---w- 00442 -permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547} -permcheck unixFCmd-17.11 --x--x--x 00111 -permcheck unixFCmd-17.12 {0 a+rwx} {00000 00777} +permcheck unixFCmd-17.5 rwxrwxrwx 0o777 +permcheck unixFCmd-17.6 r--r---w- 0o442 +permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547} +permcheck unixFCmd-17.11 --x--x--x 0o111 +permcheck unixFCmd-17.12 {0 a+rwx} {00000 0o777} file delete -force -- foo.test test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup { -- cgit v0.12 From 237b4d22a295dc64ee912a86d34cf1d178a07363 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Oct 2017 11:55:57 +0000 Subject: Add support for 'L' length modifier (either long double or mp_int) and 'a'/'A' modifiers (floating point in hex notation) --- generic/tclStringObj.c | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 98f4755..084a6c9 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2534,15 +2534,26 @@ AppendPrintfToObjVA( Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( va_arg(argList, Tcl_WideInt))); break; + case 3: + Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj( + va_arg(argList, mp_int *))); + break; } break; + case 'a': + case 'A': case 'e': case 'E': case 'f': case 'g': case 'G': + if (size > 0) { Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( - va_arg(argList, double))); + (double)va_arg(argList, long double))); + } else { + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + va_arg(argList, double))); + } seekingConversion = 0; break; case '*': @@ -2562,7 +2573,6 @@ AppendPrintfToObjVA( gotPrecision = 1; p++; break; - /* TODO: support for bignum arguments */ case 'l': ++size; p++; @@ -2590,6 +2600,10 @@ AppendPrintfToObjVA( } p++; break; + case 'L': + size = 3; + p++; + break; case 'h': size = -1; default: -- cgit v0.12 From 5470f1329925b63a1ac3def74b82b9b3a4851f0e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 23 Oct 2017 13:47:57 +0000 Subject: tclWinPanic.c is in the \win directory, not in \generic! --- win/tcl.dsp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tcl.dsp b/win/tcl.dsp index abad0bb..214449c 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1304,10 +1304,6 @@ SOURCE=..\generic\tclOOStubLib.c # End Source File # Begin Source File -SOURCE=..\generic\tclWinPanic.c -# End Source File -# Begin Source File - SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File @@ -1532,6 +1528,10 @@ SOURCE=.\tclWinNotify.c # End Source File # Begin Source File +SOURCE=.\tclWinPanic.c +# End Source File +# Begin Source File + SOURCE=.\tclWinPipe.c # End Source File # Begin Source File -- cgit v0.12 From 172896b15a2b5b8a1163c9de824e20297a876ed5 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 23 Oct 2017 16:20:18 +0000 Subject: Implementation branch for TIP 114 - Eliminate Octal Parsing... --- doc/GetInt.3 | 7 +- doc/expr.n | 4 +- doc/scan.n | 6 +- generic/tclBasic.c | 1 - generic/tclExecute.c | 14 +--- generic/tclInt.h | 2 - generic/tclStrToD.c | 65 +--------------- generic/tclUtil.c | 68 ----------------- tests/assemble.test | 2 +- tests/compExpr-old.test | 24 +++--- tests/compile.test | 2 +- tests/execute.test | 22 +++--- tests/expr-old.test | 64 ++++++++-------- tests/expr.test | 46 ++++++------ tests/get.test | 8 +- tests/lindex.test | 16 ++-- tests/mathop.test | 194 ++++++++++++++++++++++++------------------------ tests/string.test | 4 +- tests/stringComp.test | 4 +- tests/while-old.test | 2 +- tests/while.test | 4 +- 21 files changed, 205 insertions(+), 354 deletions(-) mode change 100644 => 100755 generic/tclStrToD.c diff --git a/doc/GetInt.3 b/doc/GetInt.3 index eba549d..5562e28 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -64,12 +64,9 @@ if the first such characters are then \fIsrc\fR is expected to be in octal form; otherwise, if the first such characters are .QW \fB0b\fR -then \fIsrc\fR is expected to be in binary form; otherwise, -if the first such character is -.QW \fB0\fR then \fIsrc\fR -is expected to be in octal form; otherwise, \fIsrc\fR -is expected to be in decimal form. +is expected to be in binary form; otherwise, \fIsrc\fR is +expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a diff --git a/doc/expr.n b/doc/expr.n index d33623c..9cb1625 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -50,9 +50,7 @@ An integer operand may be specified in decimal (the normal case, the optional first two characters are \fB0d\fR), binary (the first two characters are \fB0b\fR), octal (the first two characters are \fB0o\fR), or hexadecimal -(the first two characters are \fB0x\fR) form. For -compatibility with older Tcl releases, an operand that begins with \fB0\fR is -interpreted as an octal integer even if the second character is not \fBo\fR. +(the first two characters are \fB0x\fR) form. A floating-point number may be specified in any of several common decimal formats, and may use the decimal point \fB.\fR, \fBe\fR or \fBE\fR for scientific notation, and diff --git a/doc/scan.n b/doc/scan.n index 0c24fea..e87bef1 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -224,12 +224,10 @@ set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP -Parse a \fIHH:MM\fR time string, noting that this avoids problems with -octal numbers by forcing interpretation as decimals (if we did not -care, we would use the \fB%i\fR conversion instead): +Parse a \fIHH:MM\fR time string: .PP .CS -set string "08:08" ;# *Not* octal! +set string "08:08" if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} { error "not a valid time string" } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d4fa833..682709b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3583,7 +3583,6 @@ OldMathFuncProc( Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", -1)); - TclCheckBadOctal(interp, TclGetString(valuePtr)); ckfree(args); return TCL_ERROR; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f4c71ec..d43ddfd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -9626,16 +9626,7 @@ IllegalExprOperandType( } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; - const char *bytes = TclGetStringFromObj(opndPtr, &numBytes); - - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } + description = "non-numeric string"; } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { @@ -9646,7 +9637,8 @@ IllegalExprOperandType( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%s\"", description, operator)); + "can't use %s \"%s\" as operand of \"%s\"", description, + Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 0b5ff0c..63df300 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2894,8 +2894,6 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, - const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c old mode 100644 new mode 100755 index 630e498..6502733 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -483,7 +483,7 @@ TclParseNumber( enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, ZERO_D, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -528,7 +528,6 @@ TclParseNumber( char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ - int explicitOctal = 0; #define ALL_BITS (~(Tcl_WideUInt)0) #define MOST_BITS (ALL_BITS >> 1) @@ -660,7 +659,6 @@ TclParseNumber( goto zerob; } if (c == 'o' || c == 'O') { - explicitOctal = 1; state = ZERO_O; break; } @@ -668,10 +666,7 @@ TclParseNumber( state = ZERO_D; break; } -#ifdef TCL_NO_DEPRECATED goto decimal; -#endif - /* FALLTHROUGH */ case OCTAL: /* @@ -734,58 +729,6 @@ TclParseNumber( state = OCTAL; break; } - /* FALLTHROUGH */ - - case BAD_OCTAL: - if (explicitOctal) { - /* - * No forgiveness for bad digits in explicitly octal numbers. - */ - - goto endgame; - } - if (flags & TCL_PARSE_INTEGER_ONLY) { - /* - * No seeking floating point when parsing only integer. - */ - - goto endgame; - } -#ifndef TCL_NO_DEPRECATED - - /* - * Scanned a number with a leading zero that contains an 8, 9, - * radix point or E. This is an invalid octal number, but might - * still be floating point. - */ - - if (c == '0') { - numTrailZeros++; - state = BAD_OCTAL; - break; - } else if (isdigit(UCHAR(c))) { - if (objPtr != NULL) { - significandOverflow = AccumulateDecimalDigit( - (unsigned)(c-'0'), numTrailZeros, - &significandWide, &significandBig, - significandOverflow); - } - if (numSigDigs != 0) { - numSigDigs += (numTrailZeros + 1); - } else { - numSigDigs = 1; - } - numTrailZeros = 0; - state = BAD_OCTAL; - break; - } else if (c == '.') { - state = FRACTION; - break; - } else if (c == 'E' || c == 'e') { - state = EXPONENT_START; - break; - } -#endif goto endgame; /* @@ -900,9 +843,7 @@ TclParseNumber( * digits. */ -#ifdef TCL_NO_DEPRECATED decimal: -#endif acceptState = state; acceptPoint = p; acceptLen = len; @@ -1186,7 +1127,6 @@ TclParseNumber( TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: - case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: @@ -1412,9 +1352,6 @@ TclParseNumber( Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); - if (state == BAD_OCTAL) { - Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); - } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 608cd15..6a727a1 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3655,7 +3655,6 @@ TclGetIntForIndex( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } @@ -3799,73 +3798,6 @@ SetEndOffsetFromAny( /* *---------------------------------------------------------------------- * - * TclCheckBadOctal -- - * - * This function checks for a bad octal value and appends a meaningful - * error to the interp's result. - * - * Results: - * 1 if the argument was a bad octal, else 0. - * - * Side effects: - * The interpreter's result is modified. - * - *---------------------------------------------------------------------- - */ - -int -TclCheckBadOctal( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ - const char *value) /* String to check. */ -{ - register const char *p = value; - - /* - * A frequent mistake is invalid octal values due to an unwanted leading - * zero. Try to generate a meaningful error message. - */ - - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '+' || *p == '-') { - p++; - } - if (*p == '0') { - if ((p[1] == 'o') || p[1] == 'O') { - p += 2; - } - while (isdigit(UCHAR(*p))) { /* INTL: digit. */ - p++; - } - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '\0') { - /* - * Reached end of string. - */ - - if (interp != NULL) { - /* - * Don't reset the result here because we want this result to - * be added to an existing error message as extra info. - */ - - Tcl_AppendToObj(Tcl_GetObjResult(interp), - " (looks like invalid octal number)", -1); - } - return 1; - } - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. diff --git a/tests/assemble.test b/tests/assemble.test index d17bfd9..9d6965e 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -781,7 +781,7 @@ test assemble-7.43 {uplus} { } } -returnCodes error - -result {can't use non-numeric floating-point value as operand of "+"} + -result {can't use non-numeric floating-point value "NaN" as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bae26a0..7144487 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -285,10 +285,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -309,10 +309,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 @@ -377,10 +377,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test compExpr-old-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -399,10 +399,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -430,10 +430,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -451,10 +451,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 diff --git a/tests/compile.test b/tests/compile.test index 2fa4147..c76bd82 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -323,7 +323,7 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} -} -returnCodes error -match glob -result {*invalid octal number*} +} -returnCodes error -match glob -result {*} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; array set var {one two many} }} } -returnCodes error -result {list must have an even number of elements} diff --git a/tests/execute.test b/tests/execute.test index 5b8ce2d..2480a95 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -174,7 +174,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} @@ -199,7 +199,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { @@ -226,7 +226,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} @@ -251,7 +251,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { @@ -278,7 +278,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} @@ -303,7 +303,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { @@ -330,7 +330,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} @@ -355,7 +355,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { @@ -382,7 +382,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { @@ -409,7 +409,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { @@ -457,7 +457,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "foo" as operand of "!"}} # INST_BITNOT not tested # INST_CALL_BUILTIN_FUNC1 not tested diff --git a/tests/expr-old.test b/tests/expr-old.test index 3adfb63..54191b6 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -197,34 +197,34 @@ test expr-old-2.38 {floating-point operators} { test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "4.0" as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "27.0" as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "3.0" as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "3.0" as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg -} {1 {can't use floating-point value as operand of "|"}} +} {1 {can't use floating-point value "24.0" as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} # Check the string operators individually. @@ -265,46 +265,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "a" as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "a" as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "%"}} +} {1 {can't use non-numeric string "a" as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of ">>"}} +} {1 {can't use non-numeric string "a" as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "|"}} +} {1 {can't use non-numeric string "a" as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -493,7 +493,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0 test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * @@ -507,10 +507,10 @@ test expr-old-26.4 {error conditions} { set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * @@ -534,7 +534,7 @@ test expr-old-26.12 {error conditions} -body { } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * @@ -963,7 +963,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} -body { test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o289" as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} @@ -1003,11 +1003,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} { test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "10;" as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string " +" as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} @@ -1015,7 +1015,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} { test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o99 " as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} diff --git a/tests/expr.test b/tests/expr.test index 8e083c5..664b479 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -257,7 +257,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} { } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -304,10 +304,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -328,10 +328,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { @@ -456,10 +456,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test expr-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -478,10 +478,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -509,10 +509,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -529,10 +529,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -844,15 +844,15 @@ test expr-21.13 {non-numeric boolean literals} -body { } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "true " as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err @@ -872,23 +872,23 @@ test expr-21.20 {non-numeric boolean variables} { test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "o" as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use empty string as operand of "!"}} +} {1 {can't use non-numeric string "" as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg @@ -901,7 +901,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "/"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} @@ -937,10 +937,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "xx" as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "a" as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} diff --git a/tests/get.test b/tests/get.test index d6a7206..c82b7e5 100644 --- a/tests/get.test +++ b/tests/get.test @@ -98,17 +98,17 @@ test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} { } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} # Bug 7114ac6141 test get-3.3 {tcl_GetInt with iffy numbers} testgetint { - lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} { + lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} { catch {testgetint 44 $x} x set x } -} {44 44 44 44 54 51 52 46} +} {44 44 44 44 54 54 52 46} test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { - lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} { + lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } -} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} +} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} # cleanup ::tcltest::cleanupTests diff --git a/tests/lindex.test b/tests/lindex.test index 29eb898..4802e28 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -70,11 +70,11 @@ test lindex-3.4 {integer 3} testevalex { test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.6 {bad octal} -constraints testevalex -body { set x -0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] @@ -105,11 +105,11 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.7 {bad octal} -constraints testevalex -body { set x end--0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result @@ -261,11 +261,11 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-11.6 {bad octal} -body { set x -0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} # Indices relative to end @@ -307,11 +307,11 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.7 {bad octal} -body { set x end--0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result diff --git a/tests/mathop.test b/tests/mathop.test index f122b7b..0808d42 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -114,22 +114,22 @@ namespace eval ::testmathop { test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError @@ -152,22 +152,22 @@ namespace eval ::testmathop { test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -189,22 +189,22 @@ namespace eval ::testmathop { test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError @@ -227,22 +227,22 @@ namespace eval ::testmathop { test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -261,7 +261,7 @@ namespace eval ::testmathop { test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -278,7 +278,7 @@ namespace eval ::testmathop { test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -287,10 +287,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 @@ -301,7 +301,7 @@ namespace eval ::testmathop { test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -310,10 +310,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 @@ -324,7 +324,7 @@ namespace eval ::testmathop { test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -333,10 +333,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 @@ -377,32 +377,32 @@ namespace eval ::testmathop { test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError @@ -419,32 +419,32 @@ namespace eval ::testmathop { test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -487,32 +487,32 @@ namespace eval ::testmathop { test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError @@ -529,32 +529,32 @@ namespace eval ::testmathop { test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -597,32 +597,32 @@ namespace eval ::testmathop { test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError @@ -639,32 +639,32 @@ namespace eval ::testmathop { test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] - lappend exp "can't use non-numeric string as operand of \"$op\"\ + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] - lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ + lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} @@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] - lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] - lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] - lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] - lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] - lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { @@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } { set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 @@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } { set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] @@ -1240,9 +1240,9 @@ test mathop-25.23 { exp operator errors } { lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 diff --git a/tests/string.test b/tests/string.test index 549944d..f3160a8 100644 --- a/tests/string.test +++ b/tests/string.test @@ -280,10 +280,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} { } 0 test string-5.17 {string index, bad integer} -body { list [catch {string index "abc" 0o8} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.18 {string index, bad integer} -body { list [catch {string index "abc" end-0o0289} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.19 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] -1 } {} diff --git a/tests/stringComp.test b/tests/stringComp.test index 2aeb08e..3ce2b72 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -355,11 +355,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} -body { proc foo {} {string index "abc" 0o8} list [catch {foo} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test stringComp-5.18 {string index, bad integer} -body { proc foo {} {string index "abc" end-0o0289} list [catch {foo} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo diff --git a/tests/while-old.test b/tests/while-old.test index ee17d0b..e33bd0b 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} { test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 diff --git a/tests/while.test b/tests/while.test index 642ec93..c25b404 100644 --- a/tests/while.test +++ b/tests/while.test @@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body { } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ @@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body { test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while -- cgit v0.12 From 40ce2eccbc52b403d4a4b7bc479fbde987a14e18 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 24 Oct 2017 21:24:07 +0000 Subject: 'array for' implementation (TIP #421) from Brad Lanam --- doc/array.n | 7 + generic/tclVar.c | 388 +++++++++++++++++++++++++++++++++++++++++++++++++---- tests/set-old.test | 6 +- tests/var.test | 160 +++++++++++++++++++++- 4 files changed, 528 insertions(+), 33 deletions(-) diff --git a/doc/array.n b/doc/array.n index 25ad0c6..751c688 100644 --- a/doc/array.n +++ b/doc/array.n @@ -47,6 +47,13 @@ been the return value from a previous invocation of Returns 1 if \fIarrayName\fR is an array variable, 0 if there is no variable by that name or if it is a scalar variable. .TP +\fBarray for {\fIkeyVariable ?valueVariable?\fB} \fIarrayName body\fR +The first argument is a one or two element list of variable names for the +key and value of each entry in the array. The second argument is the +array name to iterate over. The third argument is the body to execute +for each key and value returned. +The ordering of the returned keys is undefined. +.TP \fBarray get \fIarrayName\fR ?\fIpattern\fR? Returns a list containing pairs of elements. The first element in each pair is the name of an element in \fIarrayName\fR diff --git a/generic/tclVar.c b/generic/tclVar.c index 3dd6790..d6f3e96 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -165,6 +165,7 @@ typedef struct ArraySearch { struct ArraySearch *nextPtr;/* Next in list of all active searches for * this variable, or NULL if this is the last * one. */ + Tcl_Obj *arrayNameObj; /* name of the array object */ } ArraySearch; /* @@ -173,6 +174,8 @@ typedef struct ArraySearch { static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *patternPtr, int includeLinks); +static void ArrayDoneSearch (Interp *iPtr, Var *varPtr, ArraySearch *searchPtr); +static Tcl_NRPostProc ArrayForLoopCallback; static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags, int index); @@ -3098,6 +3101,321 @@ TclArraySet( /* *---------------------------------------------------------------------- * + * ArrayForNRCmd + * ArrayForLoopCallback + * ArrayObjFirst + * ArrayObjNext + * + * These functions implement the "array for" Tcl command. + * array for {k v} a {} + * The array for command iterates over the array, setting the + * the specified loop variables, and executing the body each iteration. + * + * ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr + * inside the structure and calls VarHashFirstEntry to start the hash + * iteration. + * + * ArrayForNRCmd() does not execute the body or set the loop variables, + * it only initializes the iterator. + * + * ArrayForLoopCallback() iterates over the entire array, executing + * the body each time. + * + * ArrayObjFirst() Does not execute the body or set the key/value variables. + * + *---------------------------------------------------------------------- + */ +void +ArrayObjFirst( + Tcl_Interp *interp, + Tcl_Obj *arrayNameObj, + Var *varPtr, + ArraySearch *searchPtr) +{ + Interp *iPtr = (Interp *) interp; + Tcl_HashEntry *hPtr; + int isNew; + + searchPtr->varPtr = varPtr; + searchPtr->arrayNameObj = arrayNameObj; + + /* add the search to the search table */ + hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew); + if (isNew) { + searchPtr->id = 1; + varPtr->flags |= VAR_SEARCH_ACTIVE; + searchPtr->nextPtr = NULL; + } else { + searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; + searchPtr->nextPtr = Tcl_GetHashValue(hPtr); + } + searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, + &searchPtr->search); + Tcl_SetHashValue(hPtr, searchPtr); +} + +int +ArrayObjNext( + Tcl_Interp *interp, + Var *varPtr, /* array */ + ArraySearch *searchPtr, + Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the key + * written into, or NULL. */ + Tcl_Obj **valuePtrPtr /* Pointer to a variable to have the + * value written into, or NULL.*/ + ) +{ + Tcl_Obj *keyObj; + Tcl_Obj *valueObj = NULL; + int gotValue; + int donerc; + + donerc = TCL_BREAK; + + if ((varPtr->flags & VAR_SEARCH_ACTIVE) != VAR_SEARCH_ACTIVE) { + donerc = TCL_ERROR; + return donerc; + } + + gotValue = 0; + while (1) { + Tcl_HashEntry *hPtr = searchPtr->nextEntry; + if (hPtr != NULL) { + searchPtr->nextEntry = NULL; + } else { + hPtr = Tcl_NextHashEntry(&searchPtr->search); + if (hPtr == NULL) { + gotValue = 0; + break; + } + } + varPtr = VarHashGetValue(hPtr); + if (!TclIsVarUndefined(varPtr)) { + gotValue = 1; + break; + } + } + + if (! gotValue) { + return donerc; + } + + donerc = TCL_CONTINUE; + + keyObj = VarHashGetKey(varPtr); + *keyPtrPtr = keyObj; + valueObj = Tcl_ObjGetVar2(interp, searchPtr->arrayNameObj, + keyObj, TCL_LEAVE_ERR_MSG); + *valuePtrPtr = valueObj; + + return donerc; +} + +static int +ArrayForNRCmd( + ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + Interp *iPtr = (Interp *) interp; + Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; + Tcl_Obj **varv; + Tcl_Obj *arrayNameObj; + ArraySearch *searchPtr = NULL; + Var *varPtr; + Var *arrayPtr; + int varc; + + /* + * array for {k v} a body + */ + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "{key value} arrayName script"); + return TCL_ERROR; + } + + /* + * Parse arguments. + */ + + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { + return TCL_ERROR; + } + if (varc != 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must have two variable names", -1)); + Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL); + return TCL_ERROR; + } + + arrayNameObj = objv[2]; + keyVarObj = varv[0]; + valueVarObj = varv[1]; + scriptObj = objv[3]; + + /* + * Locate the array variable. + */ + + varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0, + /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + + /* + * Special array trace used to keep the env array in sync for array names, + * array get, etc. + */ + + if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) + && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { + if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL, + (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| + TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) { + return TCL_ERROR; + } + } + + /* + * Verify that it is indeed an array variable. This test comes after the + * traces; the variable may actually become an array as an effect of said + * traces. + */ + + if ((varPtr == NULL) || !TclIsVarArray(varPtr) + || TclIsVarUndefined(varPtr)) { + const char *varName = Tcl_GetString(arrayNameObj); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", varName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL); + return TCL_ERROR; + } + + /* + * Make a new array search, put it on the stack. + */ + + searchPtr = ckalloc(sizeof(ArraySearch)); + searchPtr->arrayNameObj = NULL; + ArrayObjFirst(interp, arrayNameObj, varPtr, searchPtr); + + /* + * Make sure that these objects (which we need throughout the body of the + * loop) don't vanish. + */ + + Tcl_IncrRefCount(keyVarObj); + Tcl_IncrRefCount(valueVarObj); + Tcl_IncrRefCount(scriptObj); + + /* + * Run the script. + */ + + TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj, + valueVarObj, scriptObj); + return TCL_OK; +} + +static int +ArrayForLoopCallback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *) interp; + ArraySearch *searchPtr = data[0]; + Tcl_Obj *keyVarObj = data[1]; + Tcl_Obj *valueVarObj = data[2]; + Tcl_Obj *scriptObj = data[3]; + Tcl_Obj *keyObj, *valueObj; + Var *varPtr; + Var *arrayPtr; + int done; + + /* + * Process the result from the previous execution of the script body. + */ + + done = TCL_ERROR; + varPtr = TclObjLookupVarEx(interp, searchPtr->arrayNameObj, NULL, /*flags*/ 0, + /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + + if (result == TCL_CONTINUE) { + result = TCL_OK; + } else if (result != TCL_OK) { + if (result == TCL_BREAK) { + Tcl_ResetResult(interp); + result = TCL_OK; + } else if (result == TCL_ERROR) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"array for\" body line %d)", + Tcl_GetErrorLine(interp))); + } + goto arrayfordone; + } + + /* + * Get the next mapping from the array. + */ + + keyObj = NULL; + valueObj = NULL; + done = ArrayObjNext (interp, varPtr, searchPtr, &keyObj, &valueObj); + + result = TCL_OK; + if (done != TCL_CONTINUE) { + Tcl_ResetResult(interp); + if (done == TCL_ERROR) { + varPtr->flags |= TCL_LEAVE_ERR_MSG; + Tcl_AddErrorInfo(interp, "array changed during iteration"); + result = done; + } + goto arrayfordone; + } + if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + goto arrayfordone; + } + if (valueObj != NULL) { + if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + goto arrayfordone; + } + } + + /* + * Run the script. + */ + + TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj, + valueVarObj, scriptObj); + return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); + + /* + * For unwinding everything once the iterating is done. + */ + + arrayfordone: + /* if the search was terminated by an array change, the + * VAR_SEARCH_ACTIVE flag will no longer be set + */ + if (done != TCL_ERROR) { + ArrayDoneSearch (iPtr, varPtr, searchPtr); + ckfree(searchPtr); + } + + TclDecrRefCount(keyVarObj); + TclDecrRefCount(valueVarObj); + TclDecrRefCount(scriptObj); + return result; +} + +/* + *---------------------------------------------------------------------- + * * ArrayStartSearchCmd -- * * This object-based function is invoked to process the "array @@ -3197,6 +3515,50 @@ ArrayStartSearchCmd( /* *---------------------------------------------------------------------- * + * ArrayDoneSearch -- + * + * Removes the search from the hash of active searches. + * + *---------------------------------------------------------------------- + */ +static void +ArrayDoneSearch ( + Interp *iPtr, + Var *varPtr, + ArraySearch *searchPtr) +{ + Tcl_HashEntry *hPtr; + ArraySearch *prevPtr; + + /* + * Unhook the search from the list of searches associated with the + * variable. + */ + + hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr); + if (hPtr == NULL) { + return; + } + if (searchPtr == Tcl_GetHashValue(hPtr)) { + if (searchPtr->nextPtr) { + Tcl_SetHashValue(hPtr, searchPtr->nextPtr); + } else { + varPtr->flags &= ~VAR_SEARCH_ACTIVE; + Tcl_DeleteHashEntry(hPtr); + } + } else { + for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) { + if (prevPtr->nextPtr == searchPtr) { + prevPtr->nextPtr = searchPtr->nextPtr; + break; + } + } + } +} + +/* + *---------------------------------------------------------------------- + * * ArrayAnyMoreCmd -- * * This object-based function is invoked to process the "array anymore" @@ -3437,9 +3799,8 @@ ArrayDoneSearchCmd( { Interp *iPtr = (Interp *) interp; Var *varPtr, *arrayPtr; - Tcl_HashEntry *hPtr; Tcl_Obj *varNameObj, *searchObj; - ArraySearch *searchPtr, *prevPtr; + ArraySearch *searchPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId"); @@ -3493,27 +3854,7 @@ ArrayDoneSearchCmd( return TCL_ERROR; } - /* - * Unhook the search from the list of searches associated with the - * variable. - */ - - hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr); - if (searchPtr == Tcl_GetHashValue(hPtr)) { - if (searchPtr->nextPtr) { - Tcl_SetHashValue(hPtr, searchPtr->nextPtr); - } else { - varPtr->flags &= ~VAR_SEARCH_ACTIVE; - Tcl_DeleteHashEntry(hPtr); - } - } else { - for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) { - if (prevPtr->nextPtr == searchPtr) { - prevPtr->nextPtr = searchPtr->nextPtr; - break; - } - } - } + ArrayDoneSearch (iPtr, varPtr, searchPtr); ckfree(searchPtr); return TCL_OK; } @@ -4372,6 +4713,7 @@ TclInitArrayCmd( {"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0}, + {"for", NULL, TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0}, {"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, {"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, diff --git a/tests/set-old.test b/tests/set-old.test index 6138ed8..3b4184c 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -340,7 +340,7 @@ test set-old-8.6 {array command} { catch {unset a} set a(22) 3 list [catch {array gorp a} msg] $msg -} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}} +} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}} test set-old-8.7 {array command, anymore option} { catch {unset a} list [catch {array anymore a x} msg] $msg @@ -652,7 +652,7 @@ test set-old-8.52 {array command, array names -regexp on regexp pattern} { set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} -test set-old-8.52.1 {array command, array names -regexp, backrefs} { +?test set-old-8.52.1 {array command, array names -regexp, backrefs} { catch {unset a} set a(1*2) 1 set a(12) 1 @@ -940,7 +940,7 @@ catch {rename foo {}} # cleanup ::tcltest::cleanupTests -return +return # Local Variables: # mode: tcl diff --git a/tests/var.test b/tests/var.test index a9d93ac..630202a 100644 --- a/tests/var.test +++ b/tests/var.test @@ -53,7 +53,7 @@ catch {unset arr} test var-1.1 {TclLookupVar, Array handling} -setup { catch {unset a} } -body { - set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd + set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd set i 10 set arr(foo) 37 list [$x i] $i [$x arr(foo)] $arr(foo) @@ -234,7 +234,7 @@ test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup { set a 123321 proc p {} { # create global xx linked to global a - testupvar 1 a {} xx global + testupvar 1 a {} xx global } list [p] $xx [set xx 789] $a } -result {{} 123321 789 789} @@ -246,7 +246,7 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a - testupvar 1 a {} vv namespace + testupvar 1 a {} vv namespace } p } @@ -548,11 +548,11 @@ test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body { namespace eval test_ns_var { variable arrayvar(1) } } -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array" test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body { - namespace eval test_ns_var { + namespace eval test_ns_var { variable arrayvar set arrayvar(1) x variable arrayvar(1) y - } + } } -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array" test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} { variable @@ -790,7 +790,7 @@ test var-15.1 {segfault in [unset], [Bug 735335]} { set var $name } # - # Note that the variable name has to be + # Note that the variable name has to be # unused previously for the segfault to # be triggered. # @@ -997,7 +997,153 @@ test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup { rename getbytes {} rename doit {} } -result 0 - + +unset -nocomplain a k v +test var-23.1 {array command, for loop, too many args} -returnCodes error -body { + array for {k v} c d e {} +} -result {wrong # args: should be "array for {key value} arrayName script"} +test var-23.2 {array command, for loop, not enough args} -returnCodes error -body { + array for {k v} {} +} -result {wrong # args: should be "array for {key value} arrayName script"} +test var-23.3 {array command, for loop, too many list args} -setup { + unset -nocomplain a +} -returnCodes error -body { + array for {k v w} a {} +} -result {must have two variable names} +test var-23.4 {array command, for loop, not enough list args} -setup { + unset -nocomplain a +} -returnCodes error -body { + array for {k} a {} +} -result {must have two variable names} +test var-23.5 {array command, for loop, no array} -setup { + unset -nocomplain a +} -returnCodes error -body { + array for {k v} a {} +} -result {"a" isn't an array} +test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup { + catch {rename p ""} +} -returnCodes error -body { + apply {{x} { + if {$x==1} { + return [array for {k v} a {}] + } + set a(x) 123 + }} 1 +} -result {"a" isn't an array} +test var-23.7 {array enumeration} -setup { + unset -nocomplain a + set reslist [list] +} -body { + array set a {a 1 b 2 c 3} + array for {k v} a { + lappend reslist $k $v + } + lsort -stride 2 -index 0 $reslist +} -cleanup { + unset -nocomplain a + unset -nocomplain reslist +} -result {a 1 b 2 c 3} +test var-23.9 {array enumeration, nested} -setup { + unset -nocomplain a + set reslist [list] +} -body { + array set a {a 1 b 2 c 3} + array for {k1 v1} a { + lappend reslist $k1 $v1 + set r2 {} + array for {k2 v2} a { + lappend r2 $k2 $v2 + } + lappend reslist [lsort -stride 2 -index 0 $r2] + } + # there is no guarantee in which order the array contents will be + # returned. + lsort -stride 3 -index 0 $reslist +} -cleanup { + unset -nocomplain a + unset -nocomplain reslist +} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}} +test var-23.10 {array enumeration, delete key} -match glob -setup { + unset -nocomplain a + set reslist [list] +} -body { + set retval {} + try { + array set a {a 1 b 2 c 3 d 4} + array for {k v} a { + lappend reslist $k $v + if { $k eq "a" } { + unset a(c) + } + } + lsort -stride 2 -index 0 $reslist + } on error {err res} { + set retval [dict get $res -errorinfo] + } + set retval +} -cleanup { + unset -nocomplain a + unset -nocomplain reslist + unset -nocomplain retval +} -result {array changed during iteration*} +test var-23.11 {array enumeration, insert key} -match glob -setup { + unset -nocomplain a + set reslist [list] +} -body { + set retval {} + try { + array set a {a 1 b 2 c 3 d 4} + array for {k v} a { + lappend reslist $k $v + if { $k eq "a" } { + set a(e) 5 + } + } + lsort -stride 2 -index 0 $reslist + } on error {err res} { + set retval [dict get $res -errorinfo] + } +} -cleanup { + unset -nocomplain a + unset -nocomplain reslist +} -result {array changed during iteration*} +test var-23.12 {array enumeration, change value} -setup { + unset -nocomplain a + set reslist [list] +} -body { + array set a {a 1 b 2 c 3} + array for {k v} a { + lappend reslist $k $v + if { $k eq "a" } { + set a(c) 9 + } + } + lsort -stride 2 -index 0 $reslist +} -cleanup { + unset -nocomplain a + unset -nocomplain reslist +} -result {a 1 b 2 c 9} +test var-23.13 {array enumeration, number of traces} -setup { + set ::countarrayfor 0 + proc ::tracearrayfor { args } { + incr ::countarrayfor + } + unset -nocomplain ::a + set reslist [list] +} -body { + array set ::a {a 1 b 2 c 3} + foreach {k} [array names a] { + trace add variable ::a($k) read ::tracearrayfor + } + array for {k v} ::a { + lappend reslist $k $v + } + set ::countarrayfor +} -cleanup { + unset -nocomplain ::countarrayfor + unset -nocomplain ::a + unset -nocomplain reslist +} -result 3 catch {namespace delete ns} catch {unset arr} -- cgit v0.12 From d8cae66217adcfb4920030071e54e37b5a88a1c4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Wed, 25 Oct 2017 17:31:09 +0000 Subject: Fix typo in set-old.test --- tests/set-old.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/set-old.test b/tests/set-old.test index 3b4184c..b2e7aa6 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -652,7 +652,7 @@ test set-old-8.52 {array command, array names -regexp on regexp pattern} { set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} -?test set-old-8.52.1 {array command, array names -regexp, backrefs} { +test set-old-8.52.1 {array command, array names -regexp, backrefs} { catch {unset a} set a(1*2) 1 set a(12) 1 -- cgit v0.12 From 67e505d2abdb7ddb2d38ee7e579785a410008188 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 27 Oct 2017 08:45:13 +0000 Subject: First implementation of [http://core.tcl.tk/tips/doc/trunk/tip/481.md|TIP #481]: Extend size range of various Tcl_Get*() functions --- generic/tcl.decls | 12 ++++++++++++ generic/tcl.h | 8 ++++++++ generic/tclDecls.h | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclObj.c | 48 ++++++++++++++++++++++++++++++++++++++++++++-- generic/tclStringObj.c | 26 ++++++++++++++++++++++++- generic/tclStubInit.c | 5 +++++ generic/tclTest.c | 26 +++++++++++++------------ generic/tclTestObj.c | 5 +++-- 8 files changed, 165 insertions(+), 17 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..85b7b81 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2332,6 +2332,18 @@ declare 631 { const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData) } +# TIP #481 +declare 634 { + int Tcl_GetValue(Tcl_Interp *interp, Tcl_Obj *objPtr, + void *intPtr, int flags) +} +declare 635 { + char *Tcl_GetStringFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr) +} +declare 636 { + Tcl_UniChar *Tcl_GetUnicodeFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tcl.h b/generic/tcl.h index 07d841d..17406e1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1153,6 +1153,14 @@ typedef struct Tcl_DString { #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_READ_ONLY 0x80 + +/* + * Types for Tcl_GetValue(): + */ + +#define TCL_TYPE_I(type) (0x100 | (int)sizeof(type)) /* signed integer */ +#define TCL_TYPE_U(type) (0x200 | (int)sizeof(type)) /* unsigned integer */ +#define TCL_TYPE_D(type) (0x300 | (int)sizeof(type)) /* float/double/long double */ /* *---------------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..b4b0320 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1831,6 +1831,17 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); +/* Slot 632 is reserved */ +/* Slot 633 is reserved */ +/* 634 */ +EXTERN int Tcl_GetValue(Tcl_Interp *interp, Tcl_Obj *objPtr, + void *intPtr, int flags); +/* 635 */ +EXTERN char * Tcl_GetStringFromObj2(Tcl_Obj *objPtr, + size_t *lengthPtr); +/* 636 */ +EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj2(Tcl_Obj *objPtr, + size_t *lengthPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2498,6 +2509,11 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + void (*reserved632)(void); + void (*reserved633)(void); + int (*tcl_GetValue) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *intPtr, int flags); /* 634 */ + char * (*tcl_GetStringFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 635 */ + Tcl_UniChar * (*tcl_GetUnicodeFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 636 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3792,6 +3808,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ #define Tcl_OpenTcpServerEx \ (tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */ +/* Slot 632 is reserved */ +/* Slot 633 is reserved */ +#define Tcl_GetValue \ + (tclStubsPtr->tcl_GetValue) /* 634 */ +#define Tcl_GetStringFromObj2 \ + (tclStubsPtr->tcl_GetStringFromObj2) /* 635 */ +#define Tcl_GetUnicodeFromObj2 \ + (tclStubsPtr->tcl_GetUnicodeFromObj2) /* 636 */ #endif /* defined(USE_TCL_STUBS) */ @@ -3966,6 +3990,34 @@ extern const TclStubs *tclStubsPtr; # endif #endif +#undef Tcl_GetDoubleFromObj +#undef Tcl_GetIntFromObj +#undef Tcl_GetStringFromObj +#undef Tcl_GetUnicodeFromObj +#if defined(USE_TCL_STUBS) +#define Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) \ + (sizeof(*dblPtr) == sizeof(double) ? tclStubsPtr->tcl_GetDoubleFromObj(interp, objPtr, (double *)dblPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr))) +#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? tclStubsPtr->tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr))) +#define Tcl_GetUIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? tclStubsPtr->tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_U(*intPtr))) +#define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr)) +#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetUnicodeFromObj2(objPtr, (size_t *)sizePtr)) +#else +#define Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) \ + (sizeof(*dblPtr) == sizeof(double) ? (Tcl_GetDoubleFromObj)(interp, objPtr, (double *)dblPtr) : Tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr))) +#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? Tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : Tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr))) +#define Tcl_GetUIntFromObj(interp, objPtr, intPtr) \ + (sizeof(*intPtr) == sizeof(int) ? Tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : Tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_U(*intPtr))) +#define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? Tcl_GetStringFromObj(objPtr, (int *)sizePtr) : Tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr)) +#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*sizePtr) <= sizeof(int) ? Tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : Tcl_GetUnicodeFromObj2(objPtr, (size_t *)sizePtr)) +#endif + /* * Deprecated Tcl procedures: */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 1a00011..f61ccb7 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1659,7 +1659,7 @@ Tcl_GetString( /* *---------------------------------------------------------------------- * - * Tcl_GetStringFromObj -- + * Tcl_GetStringFromObj/Tcl_GetStringFromObj2 -- * * Returns the string representation's byte array pointer and length for * an object. @@ -1679,6 +1679,7 @@ Tcl_GetString( *---------------------------------------------------------------------- */ +#undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should @@ -1694,6 +1695,21 @@ Tcl_GetStringFromObj( } return objPtr->bytes; } +char * +Tcl_GetStringFromObj2( + register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + * be returned. */ + register size_t *lengthPtr) /* If non-NULL, the location where the string + * rep's byte array length should * be stored. + * If NULL, no length is stored. */ +{ + (void) TclGetString(objPtr); + + if (lengthPtr != NULL) { + *lengthPtr = objPtr->length; + } + return objPtr->bytes; +} /* *---------------------------------------------------------------------- @@ -2273,6 +2289,7 @@ Tcl_SetDoubleObj( *---------------------------------------------------------------------- */ +#undef Tcl_GetDoubleFromObj int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -2466,7 +2483,7 @@ Tcl_SetIntObj( /* *---------------------------------------------------------------------- * - * Tcl_GetIntFromObj -- + * Tcl_GetIntFromObj/Tcl_GetValue -- * * Attempt to return an int from the Tcl object "objPtr". If the object * is not already an int, an attempt will be made to convert it to one. @@ -2489,6 +2506,7 @@ Tcl_SetIntObj( *---------------------------------------------------------------------- */ +#undef Tcl_GetIntFromObj int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -2516,6 +2534,32 @@ Tcl_GetIntFromObj( return TCL_OK; #endif } +int +Tcl_GetValue( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr, /* The object from which to get a int. */ + register void *ptr, /* Place to store resulting int. */ + register int flags) +{ + double value; + int result; + if (flags == TCL_TYPE_I(int)) { + return Tcl_GetIntFromObj(interp, objPtr, ptr); + } + if (flags == TCL_TYPE_I(Tcl_WideInt)) { + return Tcl_GetWideIntFromObj(interp, objPtr, ptr); + } + if (flags == TCL_TYPE_D(double)) { + return Tcl_GetDoubleFromObj(interp, objPtr, ptr); + } + result = Tcl_GetDoubleFromObj(interp, objPtr, &value); + if (flags == TCL_TYPE_D(float)) { + *(float *)ptr = (float) value; + } else { + *(long double *)ptr = (long double) value; + } + return result; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 7c1d42b..0195656 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -540,7 +540,7 @@ Tcl_GetUnicode( /* *---------------------------------------------------------------------- * - * Tcl_GetUnicodeFromObj -- + * Tcl_GetUnicodeFromObj/Tcl_GetUnicodeFromObj2 -- * * Get the Unicode form of the String object with length. If the object * is not already a String object, it will be converted to one. If the @@ -556,6 +556,7 @@ Tcl_GetUnicode( *---------------------------------------------------------------------- */ +#undef Tcl_GetUnicodeFromObj Tcl_UniChar * Tcl_GetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the unicode string @@ -579,6 +580,29 @@ Tcl_GetUnicodeFromObj( } return stringPtr->unicode; } +Tcl_UniChar * +Tcl_GetUnicodeFromObj2( + Tcl_Obj *objPtr, /* The object to find the unicode string + * for. */ + size_t *lengthPtr) /* If non-NULL, the location where the string + * rep's unichar length should be stored. If + * NULL, no length is stored. */ +{ + String *stringPtr; + + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + + if (stringPtr->hasUnicode == 0) { + FillUnicodeRep(objPtr); + stringPtr = GET_STRING(objPtr); + } + + if (lengthPtr != NULL) { + *lengthPtr = stringPtr->numChars; + } + return stringPtr->unicode; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..b765206 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1536,6 +1536,11 @@ const TclStubs tclStubs = { Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ Tcl_OpenTcpServerEx, /* 631 */ + 0, /* 632 */ + 0, /* 633 */ + Tcl_GetValue, /* 634 */ + Tcl_GetStringFromObj2, /* 635 */ + Tcl_GetUnicodeFromObj2, /* 636 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index ebd90ae..5bb99cc 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1733,9 +1733,9 @@ TestdoubledigitsObjCmd(ClientData unused, }; const Tcl_ObjType* doubleType; - double d; + long double d; int status; - int ndigits; + size_t ndigits; int type; int decpt; int signum; @@ -1752,16 +1752,18 @@ TestdoubledigitsObjCmd(ClientData unused, if (status != TCL_OK) { doubleType = Tcl_GetObjType("double"); if (objv[1]->typePtr == doubleType - || TclIsNaN(objv[1]->internalRep.doubleValue)) { + && TclIsNaN(objv[1]->internalRep.doubleValue)) { + double d1; status = TCL_OK; - memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double)); + memcpy(&d1, &(objv[1]->internalRep.doubleValue), sizeof(double)); + d = d1; } } if (status != TCL_OK || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", TCL_EXACT, &type) != TCL_OK) { - fprintf(stderr, "bad value? %g\n", d); + fprintf(stderr, "bad value? %Lg\n", d); return TCL_ERROR; } type = types[type]; @@ -3084,7 +3086,7 @@ TestlinkCmd( } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3142,7 +3144,7 @@ TestlinkCmd( if (argv[15][0]) { Tcl_WideInt w; tmp = Tcl_NewStringObj(argv[15], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3192,7 +3194,7 @@ TestlinkCmd( } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3259,7 +3261,7 @@ TestlinkCmd( if (argv[15][0]) { Tcl_WideInt w; tmp = Tcl_NewStringObj(argv[15], -1); - if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; } @@ -3527,7 +3529,7 @@ TestparserObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int length, dummy; + size_t length, dummy; Tcl_Parse parse; if (objc != 3) { @@ -3583,7 +3585,7 @@ TestexprparserObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int length, dummy; + size_t length, dummy; Tcl_Parse parse; if (objc != 3) { @@ -3870,7 +3872,7 @@ TestprintObjCmd( } if (objc > 1) { - Tcl_GetWideIntFromObj(interp, objv[2], &argv1); + Tcl_GetIntFromObj(interp, objv[2], &argv1); } argv2 = (size_t)argv1; Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2)); diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 5627608..f08b893 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1163,7 +1163,8 @@ TeststringobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; - int varIndex, option, i, length; + int varIndex, option; + size_t length, i; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; @@ -1230,7 +1231,7 @@ TeststringobjCmd( if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } - for (i = 3; i < objc; i++) { + for (i = 3; i < (size_t)objc; i++) { strings[i-3] = Tcl_GetString(objv[i]); } for ( ; i < 12 + 3; i++) { -- cgit v0.12 From fe508fa3b5c9dffaebbd68b86344a799a45075c4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Oct 2017 08:47:33 +0000 Subject: Experimental branch meant to eliminate the "wideint" type, just merge it to a single "int" type. No effect on linux64 and similar systems, code simplification for Win64 and 32-bit system. No TIP yet, implementation ongoing. --- generic/tclCmdMZ.c | 4 ++-- generic/tclDisassemble.c | 6 +++--- generic/tclExecute.c | 8 ++++---- generic/tclGet.c | 2 +- generic/tclInt.h | 14 +++++++------- generic/tclObj.c | 26 +++++++++++++------------- generic/tclProc.c | 4 ++-- generic/tclStrToD.c | 8 ++++---- generic/tclStubInit.c | 2 +- generic/tclUtil.c | 8 ++++---- 10 files changed, 41 insertions(+), 41 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 2195aa1..522b76f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1580,9 +1580,9 @@ StringIsCmd( result = length1 == 0; } } else if (((index == STR_IS_TRUE) && - objPtr->internalRep.longValue == 0) + objPtr->internalRep.wideValue == 0) || ((index == STR_IS_FALSE) && - objPtr->internalRep.longValue != 0)) { + objPtr->internalRep.wideValue != 0)) { result = 0; } break; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index d61ed42..70a5847 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -797,7 +797,7 @@ TclNewInstNameObj( Tcl_Obj *objPtr = Tcl_NewObj(); objPtr->typePtr = &tclInstNameType; - objPtr->internalRep.longValue = (long) inst; + objPtr->internalRep.wideValue = (long) inst; objPtr->bytes = NULL; return objPtr; @@ -817,7 +817,7 @@ static void UpdateStringOfInstName( Tcl_Obj *objPtr) { - int inst = objPtr->internalRep.longValue; + int inst = objPtr->internalRep.wideValue; char *s, buf[20]; int len; @@ -825,7 +825,7 @@ UpdateStringOfInstName( sprintf(buf, "inst_%d", inst); s = buf; } else { - s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name; + s = (char *) tclInstructionTable[objPtr->internalRep.wideValue].name; } len = strlen(s); objPtr->bytes = ckalloc(len + 1); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f4c71ec..b068e0d 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -503,7 +503,7 @@ VarHashCreateVar( (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ *(ptrPtr) = (ClientData) \ - (&((objPtr)->internalRep.longValue)), TCL_OK) : \ + (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclDoubleType) \ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ ? (*(tPtr) = TCL_NUMBER_NAN) \ @@ -518,7 +518,7 @@ VarHashCreateVar( (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ *(ptrPtr) = (ClientData) \ - (&((objPtr)->internalRep.longValue)), TCL_OK) : \ + (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclWideIntType) \ ? (*(tPtr) = TCL_NUMBER_WIDE, \ *(ptrPtr) = (ClientData) \ @@ -545,7 +545,7 @@ VarHashCreateVar( #define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ ((((objPtr)->typePtr == &tclIntType) \ || ((objPtr)->typePtr == &tclBooleanType)) \ - ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ + ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) /* @@ -6692,7 +6692,7 @@ TEBCresume( iterVarPtr = LOCAL(infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; - iterNum = valuePtr->internalRep.longValue + 1; + iterNum = valuePtr->internalRep.wideValue + 1; TclSetLongObj(valuePtr, iterNum); /* diff --git a/generic/tclGet.c b/generic/tclGet.c index 97e8c7b..727db0a 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -142,7 +142,7 @@ Tcl_GetBoolean( Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - *boolPtr = obj.internalRep.longValue; + *boolPtr = obj.internalRep.wideValue; } return code; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 0b5ff0c..feffeba 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2453,17 +2453,17 @@ typedef struct List { #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType) \ - ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #if (LONG_MAX == INT_MAX) #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType) \ - ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + ? ((*(intPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((objPtr)->typePtr == &tclIntType) \ - ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) #else #define TclGetIntFromObj(interp, objPtr, intPtr) \ @@ -2484,7 +2484,7 @@ typedef struct List { #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.longValue), TCL_OK) : \ + ((objPtr)->internalRep.wideValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) #else /* !TCL_WIDE_INT_IS_LONG */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ @@ -2492,7 +2492,7 @@ typedef struct List { ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ ((objPtr)->typePtr == &tclIntType) \ ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.longValue), TCL_OK) : \ + ((objPtr)->internalRep.wideValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) #endif /* TCL_WIDE_INT_IS_LONG */ @@ -4545,7 +4545,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->internalRep.wideValue = (long)(i); \ (objPtr)->typePtr = &tclIntType; \ } while (0) @@ -4589,7 +4589,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->internalRep.wideValue = (long)(i); \ (objPtr)->typePtr = &tclIntType; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) diff --git a/generic/tclObj.c b/generic/tclObj.c index 1a00011..f0bcc5e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1810,7 +1810,7 @@ Tcl_DbNewBooleanObj( TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; - objPtr->internalRep.longValue = (boolValue != 0); + objPtr->internalRep.wideValue = (boolValue != 0); objPtr->typePtr = &tclIntType; return objPtr; } @@ -1888,11 +1888,11 @@ Tcl_GetBooleanFromObj( { do { if (objPtr->typePtr == &tclIntType) { - *boolPtr = (objPtr->internalRep.longValue != 0); + *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } if (objPtr->typePtr == &tclBooleanType) { - *boolPtr = (int) objPtr->internalRep.longValue; + *boolPtr = (int) objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { @@ -1960,7 +1960,7 @@ TclSetBooleanFromAny( if (objPtr->bytes == NULL) { if (objPtr->typePtr == &tclIntType) { - switch (objPtr->internalRep.longValue) { + switch (objPtr->internalRep.wideValue) { case 0L: case 1L: return TCL_OK; } @@ -2107,13 +2107,13 @@ ParseBoolean( goodBoolean: TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = newBool; + objPtr->internalRep.wideValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; numericBoolean: TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = newBool; + objPtr->internalRep.wideValue = newBool; objPtr->typePtr = &tclIntType; return TCL_OK; } @@ -2294,7 +2294,7 @@ Tcl_GetDoubleFromObj( return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - *dblPtr = objPtr->internalRep.longValue; + *dblPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { @@ -2569,7 +2569,7 @@ UpdateStringOfInt( char buffer[TCL_INTEGER_SPACE]; register int len; - len = TclFormatInt(buffer, objPtr->internalRep.longValue); + len = TclFormatInt(buffer, objPtr->internalRep.wideValue); objPtr->bytes = ckalloc(len + 1); memcpy(objPtr->bytes, buffer, (unsigned) len + 1); @@ -2679,7 +2679,7 @@ Tcl_DbNewLongObj( TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; - objPtr->internalRep.longValue = longValue; + objPtr->internalRep.wideValue = longValue; objPtr->typePtr = &tclIntType; return objPtr; } @@ -2759,7 +2759,7 @@ Tcl_GetLongFromObj( { do { if (objPtr->typePtr == &tclIntType) { - *longPtr = objPtr->internalRep.longValue; + *longPtr = objPtr->internalRep.wideValue; return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG @@ -3080,7 +3080,7 @@ Tcl_GetWideIntFromObj( } #endif if (objPtr->typePtr == &tclIntType) { - *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue; + *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { @@ -3402,7 +3402,7 @@ GetBignumFromObj( return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - TclInitBignumFromLong(bignumValue, objPtr->internalRep.longValue); + TclInitBignumFromLong(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG @@ -3653,7 +3653,7 @@ TclGetNumberFromObj( } if (objPtr->typePtr == &tclIntType) { *typePtr = TCL_NUMBER_LONG; - *clientDataPtr = &objPtr->internalRep.longValue; + *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG diff --git a/generic/tclProc.c b/generic/tclProc.c index 96bdcf3..133f41d 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -826,7 +826,7 @@ TclObjGetFrame( level = curLevel - level; result = 1; } else if (objPtr->typePtr == &levelReferenceType) { - level = (int) objPtr->internalRep.longValue; + level = (int) objPtr->internalRep.wideValue; result = 1; } else { name = TclGetString(objPtr); @@ -834,7 +834,7 @@ TclObjGetFrame( if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) { TclFreeIntRep(objPtr); objPtr->typePtr = &levelReferenceType; - objPtr->internalRep.longValue = level; + objPtr->internalRep.wideValue = level; result = 1; } else { result = -1; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 630e498..c8bc7b5 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1289,10 +1289,10 @@ TclParseNumber( } else { objPtr->typePtr = &tclIntType; if (signum) { - objPtr->internalRep.longValue = + objPtr->internalRep.wideValue = - (long) octalSignificandWide; } else { - objPtr->internalRep.longValue = + objPtr->internalRep.wideValue = (long) octalSignificandWide; } } @@ -1336,10 +1336,10 @@ TclParseNumber( } else { objPtr->typePtr = &tclIntType; if (signum) { - objPtr->internalRep.longValue = + objPtr->internalRep.wideValue = - (long) significandWide; } else { - objPtr->internalRep.longValue = + objPtr->internalRep.wideValue = (long) significandWide; } } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..c8b4dce 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -244,7 +244,7 @@ static Tcl_Obj *dbNewLongObj( TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; - objPtr->internalRep.longValue = (long) intValue; + objPtr->internalRep.wideValue = (long) intValue; objPtr->typePtr = &tclIntType; return objPtr; #else diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 608cd15..da4dc49 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3598,7 +3598,7 @@ TclGetIntForIndex( * be converted to one, use it. */ - *indexPtr = endValue + objPtr->internalRep.longValue; + *indexPtr = endValue + objPtr->internalRep.wideValue; return TCL_OK; } @@ -3690,9 +3690,9 @@ UpdateStringOfEndOffset( register int len = 3; memcpy(buffer, "end", 4); - if (objPtr->internalRep.longValue != 0) { + if (objPtr->internalRep.wideValue != 0) { buffer[len++] = '-'; - len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue)); + len += TclFormatInt(buffer+len, -(objPtr->internalRep.wideValue)); } objPtr->bytes = ckalloc((unsigned) len+1); memcpy(objPtr->bytes, buffer, (unsigned) len+1); @@ -3790,7 +3790,7 @@ SetEndOffsetFromAny( */ TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = offset; + objPtr->internalRep.wideValue = offset; objPtr->typePtr = &tclEndOffsetType; return TCL_OK; -- cgit v0.12 From aad24c7ffcbdb7271ba73f1548b5be00185df1b2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Oct 2017 11:01:28 +0000 Subject: Change (internal) TclFormatInt() signature, so it can handle WideInt's directly. Ongoing simplifications ... --- generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 4 +-- generic/tclObj.c | 83 +++------------------------------------------------ generic/tclTimer.c | 32 +++++++------------- generic/tclUtil.c | 21 +++++++++---- 5 files changed, 33 insertions(+), 109 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index dea698c..63ed6c6 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -114,7 +114,7 @@ declare 23 { } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { - int TclFormatInt(char *buffer, long n) + int TclFormatInt(char *buffer, Tcl_WideInt n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5bccfe5..2d437d5 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -113,7 +113,7 @@ EXTERN int TclFindElement(Tcl_Interp *interp, /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN int TclFormatInt(char *buffer, long n); +EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ @@ -668,7 +668,7 @@ typedef struct TclIntStubs { void (*reserved21)(void); int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ - int (*tclFormatInt) (char *buffer, long n); /* 24 */ + int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ void (*reserved26)(void); void (*reserved27)(void); diff --git a/generic/tclObj.c b/generic/tclObj.c index f0bcc5e..bf1a2e6 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -210,10 +210,6 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); -#ifndef TCL_WIDE_INT_IS_LONG -static void UpdateStringOfWideInt(Tcl_Obj *objPtr); -static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -#endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); @@ -275,8 +271,8 @@ const Tcl_ObjType tclWideIntType = { "wideInt", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ - UpdateStringOfWideInt, /* updateStringProc */ - SetWideIntFromAny /* setFromAnyProc */ + UpdateStringOfInt, /* updateStringProc */ + SetIntFromAny /* setFromAnyProc */ }; #endif const Tcl_ObjType tclBignumType = { @@ -2538,9 +2534,8 @@ SetIntFromAny( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Pointer to the object to convert */ { - long l; - - return TclGetLongFromObj(interp, objPtr, &l); + Tcl_WideInt w; + return Tcl_GetWideIntFromObj(interp, objPtr, &w); } /* @@ -2836,49 +2831,6 @@ Tcl_GetLongFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } -#ifndef TCL_WIDE_INT_IS_LONG - -/* - *---------------------------------------------------------------------- - * - * UpdateStringOfWideInt -- - * - * Update the string representation for a wide integer object. Note: this - * function does not free an existing old string rep so storage will be - * lost if this has not already been done. - * - * Results: - * None. - * - * Side effects: - * The object's string is set to a valid string that results from the - * wideInt-to-string conversion. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfWideInt( - register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ -{ - char buffer[TCL_INTEGER_SPACE+2]; - register unsigned len; - register Tcl_WideInt wideVal = objPtr->internalRep.wideValue; - - /* - * Note that sprintf will generate a compiler warning under Mingw claiming - * %I64 is an unknown format specifier. Just ignore this warning. We can't - * use %L as the format specifier since that gets printed as a 32 bit - * value. - */ - - sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal); - len = strlen(buffer); - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, len + 1); - objPtr->length = len; -} -#endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- @@ -3133,33 +3085,6 @@ Tcl_GetWideIntFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } -#ifndef TCL_WIDE_INT_IS_LONG - -/* - *---------------------------------------------------------------------- - * - * SetWideIntFromAny -- - * - * Attempts to force the internal representation for a Tcl object to - * tclWideIntType, specifically. - * - * Results: - * The return value is a standard object Tcl result. If an error occurs - * during conversion, an error message is left in the interpreter's - * result unless "interp" is NULL. - * - *---------------------------------------------------------------------- - */ - -static int -SetWideIntFromAny( - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Obj *objPtr) /* Pointer to the object to convert */ -{ - Tcl_WideInt w; - return Tcl_GetWideIntFromObj(interp, objPtr, &w); -} -#endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 3467305..4bb5a35 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -1045,37 +1045,27 @@ AfterDelay( if (iPtr->limit.timeEvent == NULL || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); -#ifndef TCL_WIDE_INT_IS_LONG - if (diff > LONG_MAX) { - diff = LONG_MAX; - } -#endif if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } - if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { - diff = 1; - } + if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { + diff = 1; + } if (diff > 0) { - Tcl_Sleep((long) diff); - if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { - break; - } + Tcl_Sleep((int) diff); + if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { + break; + } } else { - break; - } + break; + } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); -#ifndef TCL_WIDE_INT_IS_LONG - if (diff > LONG_MAX) { - diff = LONG_MAX; - } -#endif if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } if (diff > 0) { - Tcl_Sleep((long) diff); + Tcl_Sleep((int) diff); } if (Tcl_AsyncReady()) { if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { @@ -1089,7 +1079,7 @@ AfterDelay( return TCL_ERROR; } } - Tcl_GetTime(&now); + Tcl_GetTime(&now); } while (TCL_TIME_BEFORE(now, endTime)); return TCL_OK; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index da4dc49..27e1877 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3489,9 +3489,9 @@ int TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ - long n) /* The integer to format. */ + Tcl_WideInt n) /* The integer to format. */ { - long intVal; + Tcl_WideInt intVal; int i; int numFormatted, j; const char *digits = "0123456789"; @@ -3514,7 +3514,7 @@ TclFormatInt( intVal = -n; /* [Bug 3390638] Workaround for*/ if (n == -n || intVal == n) { /* broken compiler optimizers. */ - return sprintf(buffer, "%ld", n); + return sprintf(buffer, "%" TCL_LL_MODIFIER "d", n); } /* @@ -3722,7 +3722,7 @@ SetEndOffsetFromAny( Tcl_Interp *interp, /* Tcl interpreter or NULL */ Tcl_Obj *objPtr) /* Pointer to the object to parse */ { - int offset; /* Offset in the "end-offset" expression */ + Tcl_WideInt offset; /* Offset in the "end-offset" expression */ register const char *bytes; /* String rep of the object */ int length; /* Length of the object's string rep */ @@ -3758,15 +3758,24 @@ SetEndOffsetFromAny( } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything - * after "end-" to Tcl_GetInt, then reverse for offset. + * after "end-" to TclParseNumber. */ if (TclIsSpaceProc(bytes[4])) { goto badIndexFormat; } - if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { + if (TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL, + TCL_PARSE_INTEGER_ONLY) != TCL_OK) { return TCL_ERROR; } + if ((objPtr->typePtr != &tclIntType) +#ifndef TCL_WIDE_INT_IS_LONG + && (objPtr->typePtr != &tclWideIntType) +#endif + ) { + goto badIndexFormat; + } + offset = objPtr->internalRep.wideValue; if (bytes[3] == '-') { offset = -offset; } -- cgit v0.12 From 6642181b9d3599f1bde42f466b34f2d44f9a26e8 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2017 12:41:21 +0000 Subject: Rebase tip-278 branch to workaround CVS conversion woes. --- generic/tclVar.c | 12 ++++++------ tests/namespace-old.test | 24 ++++++++++++++---------- tests/namespace.test | 36 ++++++++++++++++++++++++------------ tests/parse.test | 6 +++--- tests/tcltest.test | 1 + tests/var.test | 9 +++++---- 6 files changed, 53 insertions(+), 35 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 7c8bb73..4f2d435 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -816,12 +816,8 @@ TclLookupSimpleVar( *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { - if (flags & TCL_AVOID_RESOLVERS) { - flags = (flags | TCL_NAMESPACE_ONLY); - } - if (flags & TCL_NAMESPACE_ONLY) { - *indexPtr = -2; - } + flags = (flags | TCL_NAMESPACE_ONLY); + *indexPtr = -2; } /* @@ -5709,6 +5705,10 @@ ObjFindNamespaceVar( * Find the namespace(s) that contain the variable. */ + if (!(flags & TCL_GLOBAL_ONLY)) { + flags |= TCL_NAMESPACE_ONLY; + } + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 1d6a805..3f8737b 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -293,12 +293,13 @@ namespace eval test_ns_hier1 { namespace eval test_ns_hier2a {} namespace eval test_ns_hier2b {} } +# TIP 278: secondary lookup disabled for vars, tests disabled with # test namespace-old-5.4 {nested namespaces can access global namespace} { - list [namespace eval test_ns_hier1 {set test_ns_var_global}] \ + list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \ [namespace eval test_ns_hier1 {test_ns_cmd_global}] \ - [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \ + [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \ [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}] -} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}} +} {{} {cmd in ::} {} {cmd in ::}} test namespace-old-5.5 {variables in different namespaces don't conflict} { list [set test_ns_hier1::test_ns_level] \ [set test_ns_hier1::test_ns_hier2::test_ns_level] @@ -468,11 +469,12 @@ test namespace-old-6.11 {commands affect all parent namespaces} { } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{cache2 version} {cache2 version}} +# TIP 278: secondary lookup disabled, catch added, result changed from {global version} test namespace-old-6.12 {define test variables} { variable test_ns_cache_var "global version" set trigger {set test_ns_cache_var} - namespace eval test_ns_cache1 $trigger -} {global version} + list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg +} {1 {can't read "test_ns_cache_var": no such variable}} set trigger {set test_ns_cache_var} test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 { @@ -481,22 +483,24 @@ test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 $trigger } {cache1 version} variable ::test_ns_cache_var "global version" +# TIP 278: secondary lookup disabled, catch added, result changed from {global version} test namespace-old-6.14 {deleting variables changes variable epoch} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 {unset test_ns_cache_var}] \ - [namespace eval test_ns_cache1 $trigger] -} {{cache1 version} {} {global version}} + [catch {namespace eval test_ns_cache1 $trigger}] +} {{cache1 version} {} 1} +# TIP 278: secondary lookup disabled, catch added, result changed test namespace-old-6.15 {define test namespaces} { namespace eval test_ns_cache2 { variable test_ns_cache_var "global cache2 version" } set trigger2 {set test_ns_cache2::test_ns_cache_var} - list [namespace eval test_ns_cache1 $trigger2] \ - [namespace eval test_ns_cache1::test_ns_cache2 $trigger] -} {{global cache2 version} {global version}} + catch {list [namespace eval test_ns_cache1 $trigger2] \ + [namespace eval test_ns_cache1::test_ns_cache2 $trigger]} +} 1 set trigger2 {set test_ns_cache2::test_ns_cache_var} test namespace-old-6.16 {public variables affect all parent namespaces} { variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" diff --git a/tests/namespace.test b/tests/namespace.test index f6f817b..24c1c7d 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -46,9 +46,9 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} { set l {} lappend l [namespace current] namespace eval test_ns_1 { - lappend l [namespace current] + lappend ::l [namespace current] namespace eval foo { - lappend l [namespace current] + lappend ::l [namespace current] } } lappend l [namespace current] @@ -633,6 +633,8 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup [catch {namespace children test_ns_777} msg] $msg } } -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} + +# TIP 278: secondary lookup disabled, results changed from {10 20} test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 @@ -644,9 +646,11 @@ test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { } } -body { namespace eval test_ns_1 { - list $v $test_ns_2::v + # list $v $test_ns_2::v + list [catch {set v} msg] $msg [catch {set test_ns_2::v} msg] $msg } -} -result {10 20} +} -result {1 {can't read "v": no such variable} 0 20} + test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { namespace eval foo {} @@ -707,15 +711,17 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} lappend l [test_ns_1::test_ns_2:: hello] } -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} + +# TIP 278: secondary lookup disabled, added catch, result changed from y test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { variable {} - set test_ns_1::(x) y + catch {set test_ns_1::(x) y} ::msg } - set test_ns_1::(x) -} -result y + list $::msg [catch {set test_ns_1::(x)} msg] $msg +} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}} test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -returnCodes error -body { @@ -888,13 +894,15 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup { set x } } -result {777} + +# TIP 278: secondary lookup disabled, catch added, result changed from 314159 test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { namespace eval test_ns_1 { variable x 777 unset x - set x ;# must be global x now + list [catch {set x} msg] $msg ;# must not be global x now } -} {314159} +} {1 {can't read "x": no such variable}} test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body { namespace eval test_ns_1 { set wuzzat @@ -906,6 +914,8 @@ test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { } set test_ns_1::a } {hello} + +# TIP 278: secondary lookup disabled, result changed from 1 test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup { namespace eval test_ns_1 {} } -body { @@ -919,7 +929,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} - namespace eval test_ns_1 set a 1 namespace delete test_ns_1 return $a -} -result 1 +} -result 0 catch {unset a} catch {unset x} @@ -1540,6 +1550,8 @@ test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup { [namespace which ::test_ns_2::cmd2] } } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} + +# TIP 278: secondary lookup disabled, catch added, result changed test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { @@ -1559,12 +1571,12 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { } } -body { namespace eval test_ns_3 { - list [namespace which -variable env] \ + list [catch {namespace which -variable env } msg] $msg \ [namespace which -variable v3] \ [namespace which -variable ::test_ns_2::v2] \ [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg } -} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} +} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}} test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} diff --git a/tests/parse.test b/tests/parse.test index 287c392..d36472e 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -376,12 +376,12 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { return "new result" } set handler1 [testasync create async1] - set aresult xxx - set acode yyy + set ::aresult xxx + set ::acode yyy } -cleanup { testasync delete } -body { - list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult + list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult } -result {{new result} 0 original} test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { list [catch {testevalobjv 0 error message} msg] $msg diff --git a/tests/tcltest.test b/tests/tcltest.test index 728a018..cd3c621 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -544,6 +544,7 @@ set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable + switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 00333 diff --git a/tests/var.test b/tests/var.test index 9816d98..e32dbcf 100644 --- a/tests/var.test +++ b/tests/var.test @@ -247,10 +247,11 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a - testupvar 1 a {} vv namespace + testupvar 2 a {} vv namespace } p } + # Modified: that should create a global var according to the docs! list $test_ns_var::vv [set test_ns_var::vv 123] $a } -result {456 123 123} test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup { @@ -442,7 +443,7 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup { set six 666 namespace eval test_ns_var { variable five 5 six - lappend a $five + lappend ::a $five } lappend a $test_ns_var::five \ [set test_ns_var::six 6] [set test_ns_var::six] $six @@ -469,9 +470,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l set a "" namespace eval test_ns_var { variable eight 8 - lappend a $eight + lappend ::a $eight variable eight - lappend a $eight + lappend ::a $eight } set a } {8 8} -- cgit v0.12 From ca470c3d4eeb58156583417df4011087612bb186 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Oct 2017 14:32:52 +0000 Subject: more progress in code simplifications --- generic/tclAssembly.c | 2 +- generic/tclBasic.c | 30 +++------- generic/tclCmdMZ.c | 4 -- generic/tclExecute.c | 163 ++++++-------------------------------------------- generic/tclInt.h | 8 +-- generic/tclObj.c | 30 +--------- generic/tclTimer.c | 2 - generic/tclUtil.c | 2 - 8 files changed, 30 insertions(+), 211 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 4c5ae68..c7ded6e 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -4266,7 +4266,7 @@ AddBasicBlockRangeToErrorInfo( Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { - TclSetLongObj(lineNo, bbPtr->successor1->startLine); + TclSetWideIntObj(lineNo, bbPtr->successor1->startLine); Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e6022ac..a911028 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -7442,12 +7442,12 @@ ExprAbsFunc( return TCL_ERROR; } - if (type == TCL_NUMBER_LONG) { - long l = *((const long *) ptr); + if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) { + Tcl_WideInt l = *((const Tcl_WideInt *) ptr); - if (l > (long)0) { + if (l > (Tcl_WideInt)0) { goto unChanged; - } else if (l == (long)0) { + } else if (l == (Tcl_WideInt)0) { const char *string = objv[1]->bytes; if (string) { while (*string != '0') { @@ -7459,11 +7459,11 @@ ExprAbsFunc( } } goto unChanged; - } else if (l == LONG_MIN) { - TclInitBignumFromLong(&big, l); + } else if (l == LLONG_MIN) { + TclInitBignumFromWideInt(&big, l); goto tooLarge; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(-l)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l)); return TCL_OK; } @@ -7487,22 +7487,6 @@ ExprAbsFunc( return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG - if (type == TCL_NUMBER_WIDE) { - Tcl_WideInt w = *((const Tcl_WideInt *) ptr); - - if (w >= (Tcl_WideInt)0) { - goto unChanged; - } - if (w == LLONG_MIN) { - TclInitBignumFromWideInt(&big, w); - goto tooLarge; - } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w)); - return TCL_OK; - } -#endif - if (type == TCL_NUMBER_BIG) { if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) { Tcl_GetBignumFromObj(NULL, objv[1], &big); diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 522b76f..c984bbe 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1596,9 +1596,7 @@ StringIsCmd( /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || -#ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || -#endif (objPtr->typePtr == &tclBignumType)) { break; } @@ -1633,9 +1631,7 @@ StringIsCmd( goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || -#ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || -#endif (objPtr->typePtr == &tclBignumType)) { break; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b068e0d..3e64805 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1892,7 +1892,6 @@ TclIncrObj( TclSetLongObj(valuePtr, sum); return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG { Tcl_WideInt w1 = (Tcl_WideInt) augend; Tcl_WideInt w2 = (Tcl_WideInt) addend; @@ -1905,7 +1904,6 @@ TclIncrObj( TclSetWideIntObj(valuePtr, w1 + w2); return TCL_OK; } -#endif } if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { @@ -1925,7 +1923,6 @@ TclIncrObj( return TCL_ERROR; } -#ifndef TCL_WIDE_INT_IS_LONG if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, sum; @@ -1942,7 +1939,6 @@ TclIncrObj( return TCL_OK; } } -#endif Tcl_TakeBignumFromObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); @@ -3626,9 +3622,7 @@ TEBCresume( { Tcl_Obj *incrPtr; -#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w; -#endif long increment; case INST_INCR_SCALAR1: @@ -3750,7 +3744,6 @@ TEBCresume( } goto doneIncr; } -#ifndef TCL_WIDE_INT_IS_LONG w = (Tcl_WideInt)augend; TRACE(("%u %ld => ", opnd, increment)); @@ -3770,9 +3763,7 @@ TEBCresume( TclSetWideIntObj(objPtr, w+increment); } goto doneIncr; -#endif } /* end if (type == TCL_NUMBER_LONG) */ -#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt sum; @@ -3804,7 +3795,6 @@ TEBCresume( goto doneIncr; } } -#endif } if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ @@ -5915,7 +5905,6 @@ TEBCresume( if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { type1 = TCL_NUMBER_WIDE; } -#ifndef TCL_WIDE_INT_IS_LONG } else if (type1 == TCL_NUMBER_WIDE) { /* value is between WIDE_MIN and WIDE_MAX */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ @@ -5923,7 +5912,6 @@ TEBCresume( if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { type1 = TCL_NUMBER_LONG; } -#endif } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ @@ -6307,7 +6295,6 @@ TEBCresume( w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 + w2; -#ifdef TCL_WIDE_INT_IS_LONG /* * Check for overflow. */ @@ -6315,14 +6302,12 @@ TEBCresume( if (Overflowing(w1, w2, wResult)) { goto overflow; } -#endif goto wideResultOfArithmetic; case INST_SUB: w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 - w2; -#ifdef TCL_WIDE_INT_IS_LONG /* * Must check for overflow. The macro tests for overflows in * sums by looking at the sign bits. As we have a subtraction @@ -6336,7 +6321,6 @@ TEBCresume( if (Overflowing(w1, ~w2, wResult)) { goto overflow; } -#endif wideResultOfArithmetic: TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { @@ -8124,14 +8108,6 @@ ExecuteExtendedBinaryMathOp( Tcl_Obj *valuePtr, /* The first operand on the stack. */ Tcl_Obj *value2Ptr) /* The second operand on the stack. */ { -#define LONG_RESULT(l) \ - if (Tcl_IsShared(valuePtr)) { \ - TclNewLongObj(objResultPtr, l); \ - return objResultPtr; \ - } else { \ - Tcl_SetLongObj(valuePtr, l); \ - return NULL; \ - } #define WIDE_RESULT(w) \ if (Tcl_IsShared(valuePtr)) { \ return Tcl_NewWideIntObj(w); \ @@ -8186,7 +8162,6 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } } -#ifndef TCL_WIDE_INT_IS_LONG if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *)ptr1); if (type2 != TCL_NUMBER_BIG) { @@ -8231,7 +8206,6 @@ ExecuteExtendedBinaryMathOp( mp_clear(&big2); return NULL; } -#endif Tcl_GetBignumFromObj(NULL, valuePtr, &big1); Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); @@ -8258,14 +8232,10 @@ ExecuteExtendedBinaryMathOp( */ switch (type2) { - case TCL_NUMBER_LONG: - invalid = (*((const long *)ptr2) < 0L); - break; -#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: + case TCL_NUMBER_LONG: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; -#endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); invalid = (mp_cmp_d(&big2, 0) == MP_LT); @@ -8345,11 +8315,9 @@ ExecuteExtendedBinaryMathOp( case TCL_NUMBER_LONG: zero = (*(const long *)ptr1 > 0L); break; -#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; -#endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); zero = (mp_cmp_d(&big1, 0) == MP_GT); @@ -8362,11 +8330,10 @@ ExecuteExtendedBinaryMathOp( if (zero) { return constants[0]; } - LONG_RESULT(-1); + WIDE_RESULT(-1); } shift = (int)(*(const long *)ptr2); -#ifndef TCL_WIDE_INT_IS_LONG /* * Handle shifts within the native wide range. */ @@ -8377,11 +8344,10 @@ ExecuteExtendedBinaryMathOp( if (w1 >= (Tcl_WideInt)0) { return constants[0]; } - LONG_RESULT(-1); + WIDE_RESULT(-1); } WIDE_RESULT(w1 >> shift); } -#endif } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); @@ -8549,7 +8515,6 @@ ExecuteExtendedBinaryMathOp( BIG_RESULT(&bigResult); } -#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -8570,7 +8535,6 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(wResult); } -#endif l1 = *((const long *)ptr1); l2 = *((const long *)ptr2); @@ -8588,7 +8552,7 @@ ExecuteExtendedBinaryMathOp( /* Unused, here to silence compiler warning. */ lResult = 0; } - LONG_RESULT(lResult); + WIDE_RESULT(lResult); case INST_EXPON: { int oddExponent = 0, negativeExponent = 0; @@ -8627,13 +8591,11 @@ ExecuteExtendedBinaryMathOp( negativeExponent = (l2 < 0); oddExponent = (int) (l2 & 1); break; -#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); break; -#endif case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT); @@ -8657,7 +8619,7 @@ ExecuteExtendedBinaryMathOp( return EXPONENT_OF_ZERO; case -1: if (oddExponent) { - LONG_RESULT(-1); + WIDE_RESULT(-1); } /* fallthrough */ case 1: @@ -8695,7 +8657,7 @@ ExecuteExtendedBinaryMathOp( if (!oddExponent) { return constants[1]; } - LONG_RESULT(-1); + WIDE_RESULT(-1); } } @@ -8720,14 +8682,9 @@ ExecuteExtendedBinaryMathOp( * Reduce small powers of 2 to shifts. */ - if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { - LONG_RESULT(1L << l2); - } -#if !defined(TCL_WIDE_INT_IS_LONG) - if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) { + if ((Tcl_WideUInt) l2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) { WIDE_RESULT(((Tcl_WideInt) 1) << l2); } -#endif goto overflowExpon; } if (l1 == -2) { @@ -8737,14 +8694,9 @@ ExecuteExtendedBinaryMathOp( * Reduce small powers of 2 to shifts. */ - if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { - LONG_RESULT(signum * (1L << l2)); - } -#if !defined(TCL_WIDE_INT_IS_LONG) if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2)); } -#endif goto overflowExpon; } #if (LONG_MAX == 0x7fffffff) @@ -8783,7 +8735,7 @@ ExecuteExtendedBinaryMathOp( lResult *= lResult; /* b**8 */ break; } - LONG_RESULT(lResult); + WIDE_RESULT(lResult); } if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize @@ -8796,7 +8748,7 @@ ExecuteExtendedBinaryMathOp( * table lookup. */ - LONG_RESULT(Exp32Value[base]); + WIDE_RESULT(Exp32Value[base]); } } if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize @@ -8811,7 +8763,7 @@ ExecuteExtendedBinaryMathOp( lResult = (oddExponent) ? -Exp32Value[base] : Exp32Value[base]; - LONG_RESULT(lResult); + WIDE_RESULT(lResult); } } #endif @@ -8819,10 +8771,8 @@ ExecuteExtendedBinaryMathOp( #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) if (type1 == TCL_NUMBER_LONG) { w1 = l1; -#ifndef TCL_WIDE_INT_IS_LONG } else if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); -#endif } else { goto overflowExpon; } @@ -9022,9 +8972,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = w1 + w2; -#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) -#endif { /* * Check for overflow. @@ -9038,9 +8986,7 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = w1 - w2; -#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) -#endif { /* * Must check for overflow. The macro tests for overflows @@ -9164,12 +9110,10 @@ ExecuteExtendedUnaryMathOp( switch (opcode) { case INST_BITNOT: -#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } -#endif Tcl_TakeBignumFromObj(NULL, valuePtr, &big); /* ~a = - a - 1 */ mp_neg(&big, &big); @@ -9180,13 +9124,6 @@ ExecuteExtendedUnaryMathOp( case TCL_NUMBER_DOUBLE: DOUBLE_RESULT(-(*((const double *) ptr))); case TCL_NUMBER_LONG: - w = (Tcl_WideInt) (*((const long *) ptr)); - if (w != LLONG_MIN) { - WIDE_RESULT(-w); - } - TclInitBignumFromLong(&big, *(const long *) ptr); - break; -#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w = *((const Tcl_WideInt *) ptr); if (w != LLONG_MIN) { @@ -9194,7 +9131,6 @@ ExecuteExtendedUnaryMathOp( } TclInitBignumFromWideInt(&big, w); break; -#endif default: Tcl_TakeBignumFromObj(NULL, valuePtr, &big); } @@ -9205,7 +9141,6 @@ ExecuteExtendedUnaryMathOp( Tcl_Panic("unexpected opcode"); return NULL; } -#undef LONG_RESULT #undef WIDE_RESULT #undef BIG_RESULT #undef DOUBLE_RESULT @@ -9237,31 +9172,24 @@ TclCompareTwoNumbers( ClientData ptr1, ptr2; mp_int big1, big2; double d1, d2, tmp; - long l1, l2; -#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w1, w2; -#endif (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (type1) { case TCL_NUMBER_LONG: - l1 = *((const long *)ptr1); + case TCL_NUMBER_WIDE: + w1 = *((const Tcl_WideInt *)ptr1); switch (type2) { case TCL_NUMBER_LONG: - l2 = *((const long *)ptr2); - longCompare: - return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); -#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); - w1 = (Tcl_WideInt)l1; - goto wideCompare; -#endif + wideCompare: + return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); - d1 = (double) l1; + d1 = (double) w1; /* * If the double has a fractional part, or if the long can be @@ -9269,7 +9197,7 @@ TclCompareTwoNumbers( * doubles. */ - if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1 + if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) { goto doubleCompare; } @@ -9292,44 +9220,6 @@ TclCompareTwoNumbers( if (d2 > (double)LONG_MAX) { return MP_LT; } - l2 = (long) d2; - goto longCompare; - case TCL_NUMBER_BIG: - Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); - if (mp_cmp_d(&big2, 0) == MP_LT) { - compare = MP_GT; - } else { - compare = MP_LT; - } - mp_clear(&big2); - return compare; - } - -#ifndef TCL_WIDE_INT_IS_LONG - case TCL_NUMBER_WIDE: - w1 = *((const Tcl_WideInt *)ptr1); - switch (type2) { - case TCL_NUMBER_WIDE: - w2 = *((const Tcl_WideInt *)ptr2); - wideCompare: - return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); - case TCL_NUMBER_LONG: - l2 = *((const long *)ptr2); - w2 = (Tcl_WideInt)l2; - goto wideCompare; - case TCL_NUMBER_DOUBLE: - d2 = *((const double *)ptr2); - d1 = (double) w1; - if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) - || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) { - goto doubleCompare; - } - if (d2 < (double)LLONG_MIN) { - return MP_GT; - } - if (d2 > (double)LLONG_MAX) { - return MP_LT; - } w2 = (Tcl_WideInt) d2; goto wideCompare; case TCL_NUMBER_BIG: @@ -9342,7 +9232,6 @@ TclCompareTwoNumbers( mp_clear(&big2); return compare; } -#endif case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); @@ -9352,21 +9241,6 @@ TclCompareTwoNumbers( doubleCompare: return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); case TCL_NUMBER_LONG: - l2 = *((const long *)ptr2); - d2 = (double) l2; - if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2 - || modf(d1, &tmp) != 0.0) { - goto doubleCompare; - } - if (d1 < (double)LONG_MIN) { - return MP_LT; - } - if (d1 > (double)LONG_MAX) { - return MP_GT; - } - l1 = (long) d1; - goto longCompare; -#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; @@ -9382,7 +9256,6 @@ TclCompareTwoNumbers( } w1 = (Tcl_WideInt) d1; goto wideCompare; -#endif case TCL_NUMBER_BIG: if (TclIsInfinite(d1)) { return (d1 > 0.0) ? MP_GT : MP_LT; @@ -9410,10 +9283,8 @@ TclCompareTwoNumbers( case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { -#ifndef TCL_WIDE_INT_IS_LONG - case TCL_NUMBER_WIDE: -#endif case TCL_NUMBER_LONG: + case TCL_NUMBER_WIDE: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); return compare; diff --git a/generic/tclInt.h b/generic/tclInt.h index feffeba..bb02ddf 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2720,9 +2720,7 @@ MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; -#ifndef TCL_WIDE_INT_IS_LONG MODULE_SCOPE const Tcl_ObjType tclWideIntType; -#endif MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; @@ -4545,11 +4543,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.wideValue = (long)(i); \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \ (objPtr)->typePtr = &tclIntType; \ } while (0) -#ifndef TCL_WIDE_INT_IS_LONG +#ifdef TCL_WIDE_INT_IS_LONG +#define TclSetWideIntObj(objPtr, w) TclSetLongObj(objPtr, w) +#else #define TclSetWideIntObj(objPtr, w) \ do { \ TclInvalidateStringRep(objPtr); \ diff --git a/generic/tclObj.c b/generic/tclObj.c index bf1a2e6..78d7518 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -266,7 +266,6 @@ const Tcl_ObjType tclIntType = { UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; -#ifndef TCL_WIDE_INT_IS_LONG const Tcl_ObjType tclWideIntType = { "wideInt", /* name */ NULL, /* freeIntRepProc */ @@ -274,7 +273,6 @@ const Tcl_ObjType tclWideIntType = { UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; -#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ @@ -403,9 +401,6 @@ TclInitObjSubsystem(void) /* For backward compatibility only ... */ Tcl_RegisterObjType(&oldBooleanType); -#ifndef TCL_WIDE_INT_IS_LONG - Tcl_RegisterObjType(&tclWideIntType); -#endif #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); @@ -1912,12 +1907,10 @@ Tcl_GetBooleanFromObj( *boolPtr = 1; return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } -#endif } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0))); return TCL_ERROR; @@ -1967,11 +1960,9 @@ TclSetBooleanFromAny( goto badBoolean; } -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { goto badBoolean; } -#endif if (objPtr->typePtr == &tclDoubleType) { goto badBoolean; @@ -2300,12 +2291,10 @@ Tcl_GetDoubleFromObj( *dblPtr = TclBignumToDouble(&big); return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *dblPtr = (double) objPtr->internalRep.wideValue; return TCL_OK; } -#endif } while (SetDoubleFromAny(interp, objPtr) == TCL_OK); return TCL_ERROR; } @@ -2757,7 +2746,6 @@ Tcl_GetLongFromObj( *longPtr = objPtr->internalRep.wideValue; return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { /* * We return any integer in the range -ULONG_MAX to ULONG_MAX @@ -2776,7 +2764,6 @@ Tcl_GetLongFromObj( } goto tooLarge; } -#endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2815,9 +2802,7 @@ Tcl_GetLongFromObj( return TCL_OK; } } -#ifndef TCL_WIDE_INT_IS_LONG tooLarge: -#endif if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_Obj *msg = Tcl_NewStringObj(s, -1); @@ -2983,16 +2968,9 @@ Tcl_SetWideIntObj( if ((wideValue >= (Tcl_WideInt) LONG_MIN) && (wideValue <= (Tcl_WideInt) LONG_MAX)) { - TclSetLongObj(objPtr, (long) wideValue); + TclSetLongObj(objPtr, wideValue); } else { -#ifndef TCL_WIDE_INT_IS_LONG TclSetWideIntObj(objPtr, wideValue); -#else - mp_int big; - - TclInitBignumFromWideInt(&big, wideValue); - Tcl_SetBignumObj(objPtr, &big); -#endif } } @@ -3025,12 +3003,10 @@ Tcl_GetWideIntFromObj( /* Place to store resulting long. */ { do { -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } -#endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.wideValue; return TCL_OK; @@ -3330,13 +3306,11 @@ GetBignumFromObj( TclInitBignumFromLong(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { TclInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } -#endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3581,13 +3555,11 @@ TclGetNumberFromObj( *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } -#endif if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 4bb5a35..279e110 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -819,9 +819,7 @@ Tcl_AfterObjCmd( */ if (objv[1]->typePtr == &tclIntType -#ifndef TCL_WIDE_INT_IS_LONG || objv[1]->typePtr == &tclWideIntType -#endif || objv[1]->typePtr == &tclBignumType || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK)) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 27e1877..198424f 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3769,9 +3769,7 @@ SetEndOffsetFromAny( return TCL_ERROR; } if ((objPtr->typePtr != &tclIntType) -#ifndef TCL_WIDE_INT_IS_LONG && (objPtr->typePtr != &tclWideIntType) -#endif ) { goto badIndexFormat; } -- cgit v0.12 From 3aa68b1a0bf5f1f0d08c76c900f86e3366c062bd Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2017 14:56:57 +0000 Subject: Patch to make changes to Tcl 9 prescribed by TIPs 330 and 336. This makes the Tcl_Interp struct fully opaque. No interp->result or interp->errorline --- doc/Interp.3 | 13 -- doc/SetResult.3 | 13 -- generic/tcl.h | 42 +----- generic/tclBasic.c | 109 ++------------- generic/tclHistory.c | 7 - generic/tclInt.h | 74 +++-------- generic/tclLoad.c | 11 ++ generic/tclResult.c | 368 ++------------------------------------------------- generic/tclStubLib.c | 5 +- generic/tclTest.c | 8 +- generic/tclUtil.c | 74 ----------- tests/result.test | 4 +- 12 files changed, 62 insertions(+), 666 deletions(-) diff --git a/doc/Interp.3 b/doc/Interp.3 index 731007b..daf76fb 100644 --- a/doc/Interp.3 +++ b/doc/Interp.3 @@ -33,19 +33,6 @@ the pointer as described below is no longer supported. The supported public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead. .PP -For legacy programs and extensions no longer being maintained, compiles -against the Tcl 8.6 header files are only possible with the compiler -directives -.CS -#define USE_INTERP_RESULT -.CE -and/or -.CS -#define USE_INTERP_ERRORLINE -.CE -depending on which fields of the \fBTcl_Interp\fR struct are accessed. -These directives may be embedded in code or supplied via compiler options. -.PP The \fIresult\fR and \fIfreeProc\fR fields are used to return results or error messages from commands. This information is returned by command procedures back to \fBTcl_Eval\fR, diff --git a/doc/SetResult.3 b/doc/SetResult.3 index e5b81d7..545787c 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -197,19 +197,6 @@ It also sets \fIinterp->freeProc\fR to zero, but does not change \fIinterp->result\fR or clear error state. \fBTcl_FreeResult\fR is most commonly used when a procedure is about to replace one result value with another. -.SS "DIRECT ACCESS TO INTERP->RESULT" -.PP -It used to be legal for programs to -directly read and write \fIinterp->result\fR -to manipulate the interpreter result. The Tcl headers no longer -permit this access by default, and C code still doing this must -be updated to use supported routines \fBTcl_GetObjResult\fR, -\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR. -As a migration aid, access can be restored with the compiler directive -.CS -#define USE_INTERP_RESULT -.CE -but this is meant only to offer life support to otherwise dead code. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how diff --git a/generic/tcl.h b/generic/tcl.h index 07d841d..47f0b01 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -492,39 +492,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ -typedef struct Tcl_Interp -#ifndef TCL_NO_DEPRECATED -{ - /* TIP #330: Strongly discourage extensions from using the string - * result. */ -#ifdef USE_INTERP_RESULT - char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); - /* If the last command returned a string - * result, this points to it. */ - void (*freeProc) (char *blockPtr) - TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); - /* Zero means the string result is statically - * allocated. TCL_DYNAMIC means it was - * allocated with ckalloc and should be freed - * with ckfree. Other values give the address - * of function to invoke to free the result. - * Tcl_Eval must free it before executing next - * command. */ -#else - char *resultDontUse; /* Don't use in extensions! */ - void (*freeProcDontUse) (char *); /* Don't use in extensions! */ -#endif -#ifdef USE_INTERP_ERRORLINE - int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine"); - /* When TCL_ERROR is returned, this gives the - * line number within the command where the - * error occurred (1 if first line). */ -#else - int errorLineDontUse; /* Don't use in extensions! */ -#endif -} -#endif /* !TCL_NO_DEPRECATED */ -Tcl_Interp; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -673,8 +641,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_BREAK 3 #define TCL_CONTINUE 4 -#define TCL_RESULT_SIZE 200 - /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): @@ -865,13 +831,7 @@ int Tcl_IsShared(Tcl_Obj *objPtr); */ typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e6022ac..4f11a1a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -510,13 +510,12 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; -#ifdef TCL_NO_DEPRECATED - iPtr->result = &tclEmptyString; -#else - iPtr->result = iPtr->resultSpace; -#endif - iPtr->freeProc = NULL; + iPtr->legacyResult = NULL; + /* Special invalid value: Any attempt to free the legacy result + * will cause a crash. */ + iPtr->legacyFreeProc = (void (*) (void))-1; iPtr->errorLine = 0; + iPtr->stubTable = &tclStubs; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); @@ -574,12 +573,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; -#ifndef TCL_NO_DEPRECATED - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; -#endif - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -608,9 +601,6 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); -#ifndef TCL_NO_DEPRECATED - iPtr->resultSpace[0] = 0; -#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -721,12 +711,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ @@ -1521,7 +1505,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1543,12 +1526,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } -#ifndef TCL_NO_DEPRECATED - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } -#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2482,7 +2459,7 @@ TclInvokeStringCommand( * in the Command structure. * * Results: - * A standard Tcl string result value. + * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_ObjCmdProc, @@ -2523,13 +2500,6 @@ TclInvokeObjectCommand( } /* - * Move the interpreter's object result to the string result, then reset - * the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ @@ -3833,7 +3803,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -3845,8 +3815,8 @@ TclInterpReady( register Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -4426,24 +4396,9 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { - Interp *iPtr = (Interp *) interp; NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - * - * This only needs to be done for the first item in the list: all other - * are for NR function calls, and those are Tcl_Obj based. - */ - - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } - while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; @@ -5911,16 +5866,7 @@ Tcl_Eval( * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { - int code = Tcl_EvalEx(interp, script, -1, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; + return Tcl_EvalEx(interp, script, -1, 0); } /* @@ -6343,9 +6289,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6372,9 +6315,6 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6400,14 +6340,6 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } return result; } } @@ -6723,11 +6655,6 @@ Tcl_ExprString( } } - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -6834,19 +6761,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { - if (iPtr->result[0] != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * expect interp->result to continue to be set, so we'll take - * special pains to avoid clearing it, until we drop support for - * interp->result completely. - */ - - iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); - } else { - iPtr->errorInfo = iPtr->objResultPtr; - } + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -6924,7 +6839,7 @@ Tcl_VarEvalVA( * * Results: * A standard Tcl return result. An error message or other result may be - * left in interp->result. + * left in the interp. * * Side effects: * Depends on what was done by the command. diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 47806d4..0c8201a 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -74,13 +74,6 @@ Tcl_RecordAndEval( result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Discard the Tcl object created to hold the command. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 0b5ff0c..6278267 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1773,41 +1773,31 @@ typedef struct AllocCache { typedef struct Interp { /* - * Note: the first three fields must match exactly the fields in a - * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the - * other. - * - * The interpreter's result is held in both the string and the - * objResultPtr fields. These fields hold, respectively, the result's - * string or object value. The interpreter's result is always in the - * result field if that is non-empty, otherwise it is in objResultPtr. - * The two fields are kept consistent unless some C code sets - * interp->result directly. Programs should not access result and - * objResultPtr directly; instead, they should always get and set the - * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and - * Tcl_GetStringResult. See the SetResult man page for details. + * The first two fields were named "result" and "freeProc" in earlier + * verions of Tcl. They are no longer used within Tcl, and are no + * longer available to be accessed by extensions. However, they cannot + * be removed. Why? There is a deployed base of stub-enabled extensions + * that query the value of iPtr->stubTable. For them to continue to work, + * the location of the field "stubTable" within the Interp struct cannot + * change. The most robust way to assure that is to leave all fields up to + * that one undisturbed. */ - char *result; /* If the last command returned a string - * result, this points to it. Should not be - * accessed directly; see comment above. */ - Tcl_FreeProc *freeProc; /* Zero means a string result is statically - * allocated. TCL_DYNAMIC means string result - * was allocated with ckalloc and should be - * freed with ckfree. Other values give - * address of procedure to invoke to free the - * string result. Tcl_Eval must free it before - * executing next command. */ + const char *legacyResult; + void (*legacyFreeProc) (void); int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. On - * previous versions of Tcl this is a pointer - * to the objResultPtr or a pointer to a - * buckets array in a hash table. We therefore - * have to do some careful checking before we - * can use this. */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultptr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1858,25 +1848,6 @@ typedef struct Interp { * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* - * Information used by Tcl_AppendResult to keep track of partial results. - * See Tcl_AppendResult code for details. - */ - -#ifndef TCL_NO_DEPRECATED - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ -#else - char *appendResultDontUse; - int appendAvlDontUse; - int appendUsedDontUse; -#endif - - /* * Information about packages. Used only in tclPkg.c. */ @@ -1898,7 +1869,6 @@ typedef struct Interp { * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ - int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the @@ -1936,12 +1906,6 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ -#ifndef TCL_NO_DEPRECATED - char resultSpace[TCL_RESULT_SIZE+1]; - /* Static space holding small results. */ -#else - char resultSpaceDontUse[TCL_RESULT_SIZE+1]; -#endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index e0bb5ef..87bb1c1 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -470,6 +470,17 @@ Tcl_LoadObjCmd( */ if (code != TCL_OK) { + Interp *iPtr = (Interp *) target; + if (iPtr->legacyResult && !iPtr->legacyFreeProc) { + /* + * A call to Tcl_InitStubs() determined the caller extension and + * this interp are incompatible in their stubs mechanisms, and + * recorded the error in the oldest legacy place we have to do so. + */ + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); + iPtr->legacyResult = NULL; + iPtr->legacyFreeProc = (void (*) (void))-1; + } Tcl_TransferResult(target, code, interp); goto done; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 57a6de5..0f44ed2 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,9 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -#ifndef TCL_NO_DEPRECATED -static void SetupAppendBuffer(Interp *iPtr, int newSpace); -#endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in @@ -250,44 +247,6 @@ Tcl_SaveResult( statePtr->objResultPtr = iPtr->objResultPtr; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); - - /* - * Save the string result. - */ - - statePtr->freeProc = iPtr->freeProc; - if (iPtr->result == iPtr->resultSpace) { - /* - * Copy the static string data out of the interp buffer. - */ - - statePtr->result = statePtr->resultSpace; - strcpy(statePtr->result, iPtr->result); - statePtr->appendResult = NULL; - } else if (iPtr->result == iPtr->appendResult) { - /* - * Move the append buffer out of the interp. - */ - - statePtr->appendResult = iPtr->appendResult; - statePtr->appendAvl = iPtr->appendAvl; - statePtr->appendUsed = iPtr->appendUsed; - statePtr->result = statePtr->appendResult; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - } else { - /* - * Move the dynamic or static string out of the interpreter. - */ - - statePtr->result = iPtr->result; - statePtr->appendResult = NULL; - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - iPtr->freeProc = 0; } /* @@ -319,39 +278,6 @@ Tcl_RestoreResult( Tcl_ResetResult(interp); /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } - - /* * Restore the object result. */ @@ -383,14 +309,6 @@ Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { TclDecrRefCount(statePtr->objResultPtr); - - if (statePtr->result == statePtr->appendResult) { - ckfree(statePtr->appendResult); - } else if (statePtr->freeProc == TCL_DYNAMIC) { - ckfree(statePtr->result); - } else if (statePtr->freeProc) { - statePtr->freeProc(statePtr->result); - } } /* @@ -420,49 +338,15 @@ Tcl_SetResult( * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { - Interp *iPtr = (Interp *) interp; - register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; - char *oldResult = iPtr->result; - - if (result == NULL) { - iPtr->resultSpace[0] = 0; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } else if (freeProc == TCL_VOLATILE) { - int length = strlen(result); - - if (length > TCL_RESULT_SIZE) { - iPtr->result = ckalloc(length + 1); - iPtr->freeProc = TCL_DYNAMIC; - } else { - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } - memcpy(iPtr->result, result, (unsigned) length+1); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); + if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { + return; } - - /* - * If the old result was dynamically-allocated, free it up. Do it here, - * rather than at the beginning, in case the new result value was part of - * the old result value. - */ - - if (oldFreeProc != 0) { - if (oldFreeProc == TCL_DYNAMIC) { - ckfree(oldResult); - } else { - oldFreeProc(oldResult); - } + if (freeProc == TCL_DYNAMIC) { + ckfree(result); + } else { + (*freeProc)(result); } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); } #endif /* !TCL_NO_DEPRECATED */ @@ -488,20 +372,7 @@ Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; -#ifdef TCL_NO_DEPRECATED return Tcl_GetString(iPtr->objResultPtr); -#else - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; -#endif } /* @@ -542,23 +413,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - -#ifndef TCL_NO_DEPRECATED - /* - * Reset the string result since we just set the result object. - */ - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif } /* @@ -587,34 +441,6 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; -#ifndef TCL_NO_DEPRECATED - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - - if (iPtr->result[0] != 0) { - ResetObjResult(iPtr); - - objResultPtr = iPtr->objResultPtr; - length = strlen(iPtr->result); - TclInitStringRep(objResultPtr, iPtr->result, length); - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->result[0] = 0; - } -#endif /* !TCL_NO_DEPRECATED */ return iPtr->objResultPtr; } @@ -651,23 +477,6 @@ Tcl_AppendResultVA( } Tcl_AppendStringsToObjVA(objPtr, argList); Tcl_SetObjResult(interp, objPtr); - - /* - * Strictly we should call Tcl_GetStringResult(interp) here to make sure - * that interp->result is correct according to the old contract, but that - * makes the performance of much code (e.g. in Tk) absolutely awful. So we - * leave it out; code that really wants interp->result can just insert the - * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion] - */ - -#ifdef USE_INTERP_RESULT - /* - * Ensure that the interp->result is legal so old Tcl 7.* code still - * works. There's still embarrasingly much of it about... - */ - - (void) Tcl_GetStringResult(interp); -#endif /* USE_INTERP_RESULT */ } /* @@ -733,7 +542,6 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; -#ifdef TCL_NO_DEPRECATED Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; @@ -747,134 +555,7 @@ Tcl_AppendElement( } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); -#else - char *dst; - int size; - int flags; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* - * See how much space is needed, and grow the append buffer if needed to - * accommodate the list element. - */ - - size = Tcl_ScanElement(element, &flags) + 1; - if ((iPtr->result != iPtr->appendResult) - || (iPtr->appendResult[iPtr->appendUsed] != 0) - || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { - SetupAppendBuffer(iPtr, size+iPtr->appendUsed); - } - - /* - * Convert the string into a list element and copy it to the buffer that's - * forming, with a space separator if needed. - */ - - dst = iPtr->appendResult + iPtr->appendUsed; - if (TclNeedSpace(iPtr->appendResult, dst)) { - iPtr->appendUsed++; - *dst = ' '; - dst++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; - } - iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); -#endif /* !TCL_NO_DEPRECATED */ -} - -/* - *---------------------------------------------------------------------- - * - * SetupAppendBuffer -- - * - * This function makes sure that there is an append buffer properly - * initialized, if necessary, from the interpreter's result, and that it - * has at least enough room to accommodate newSpace new bytes of - * information. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static void -SetupAppendBuffer( - Interp *iPtr, /* Interpreter whose result is being set up. */ - int newSpace) /* Make sure that at least this many bytes of - * new information may be added. */ -{ - int totalSpace; - - /* - * Make the append buffer larger, if that's necessary, then copy the - * result into the append buffer and make the append buffer the official - * Tcl result. - */ - - if (iPtr->result != iPtr->appendResult) { - /* - * If an oversized buffer was used recently, then free it up so we go - * back to a smaller buffer. This avoids tying up memory forever after - * a large operation. - */ - - if (iPtr->appendAvl > 500) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - } - iPtr->appendUsed = strlen(iPtr->result); - } else if (iPtr->result[iPtr->appendUsed] != 0) { - /* - * Most likely someone has modified a result created by - * Tcl_AppendResult et al. so that it has a different size. Just - * recompute the size. - */ - - iPtr->appendUsed = strlen(iPtr->result); - } - - totalSpace = newSpace + iPtr->appendUsed; - if (totalSpace >= iPtr->appendAvl) { - char *new; - - if (totalSpace < 100) { - totalSpace = 200; - } else { - totalSpace *= 2; - } - new = ckalloc(totalSpace); - strcpy(new, iPtr->result); - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - iPtr->appendResult = new; - iPtr->appendAvl = totalSpace; - } else if (iPtr->result != iPtr->appendResult) { - strcpy(iPtr->appendResult, iPtr->result); - } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; } -#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -882,18 +563,16 @@ SetupAppendBuffer( * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. + * result, resetting the interpreter's result object. Tcl_FreeResult is + * most commonly used when a function is about to replace one result + * value with another. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. + * Frees the memory associated with interp's result but does not change + * any part of the error dictionary. * *---------------------------------------------------------------------- */ @@ -904,17 +583,6 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; -#ifndef TCL_NO_DEPRECATED - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - -#endif /* !TCL_NO_DEPRECATED */ ResetObjResult(iPtr); } @@ -944,18 +612,6 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); -#ifndef TCL_NO_DEPRECATED - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif /* !TCL_NO_DEPRECATED */ if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 5261591..a135465 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -66,8 +66,9 @@ Tcl_InitStubs( */ if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { - iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism"; - iPtr->freeProc = 0; + iPtr->legacyResult + = "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index ebd90ae..6e357c2 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -5187,7 +5187,6 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5255,12 +5254,9 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { - int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount; - - Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak"); + case RESULT_DYNAMIC: + Tcl_AppendElement(interp, freeCount ? "freed" : "leak"); break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 608cd15..3f809d5 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2923,86 +2923,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { -#ifdef TCL_NO_DEPRECATED Tcl_Obj *obj = Tcl_GetObjResult(interp); const char *bytes = TclGetString(obj); Tcl_DStringFree(dsPtr); Tcl_DStringAppend(dsPtr, bytes, obj->length); Tcl_ResetResult(interp); -#else - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no string result, we only have to deal with two cases: - * - * 1. When the string rep is the empty string, when we don't copy but - * instead use the staticSpace in the DString to hold an empty string. - - * 2. When the string rep is not there or there's a real string rep, when - * we use Tcl_GetString to fetch (or generate) the string rep - which - * we know to have been allocated with ckalloc() - and use it to - * populate the DString space. Then, we free the internal rep. and set - * the object's string representation back to the canonical empty - * string. - */ - - if (!iPtr->result[0] && iPtr->objResultPtr - && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == &tclEmptyString) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->string[0] = 0; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = TclGetString(iPtr->objResultPtr); - dsPtr->length = iPtr->objResultPtr->length; - dsPtr->spaceAvl = dsPtr->length + 1; - TclFreeIntRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = &tclEmptyString; - iPtr->objResultPtr->length = 0; - } - return; - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif /* !TCL_NO_DEPRECATED */ } /* diff --git a/tests/result.test b/tests/result.test index 859e546..1eff46e 100644 --- a/tests/result.test +++ b/tests/result.test @@ -31,7 +31,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 -} {dynamic result presentOrFreed} +} {dynamic result freed} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} @@ -43,7 +43,7 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 -} {42 presentOrFreed} +} {42 freed} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} -- cgit v0.12 From 9e80ee005ea69417d49687f4e51dd80bba72deee Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2017 15:15:06 +0000 Subject: tidying --- generic/tcl.h | 5 ++--- generic/tclBasic.c | 3 +-- generic/tclInt.h | 4 ++-- generic/tclLoad.c | 22 +++++++++++----------- generic/tclStubLib.c | 3 +-- generic/tclUtil.c | 6 +++--- 6 files changed, 20 insertions(+), 23 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 47f0b01..0d40f41 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -825,9 +825,8 @@ int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- - * The following structure contains the state needed by Tcl_SaveResult. No-one - * outside of Tcl should access any of these fields. This structure is - * typically allocated on the stack. + * The following type contains the state needed by Tcl_SaveResult. This + * structure is typically allocated on the stack. */ typedef struct Tcl_SavedResult { diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4f11a1a..32808b8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6654,7 +6654,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - return code; } @@ -6761,7 +6760,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { - iPtr->errorInfo = iPtr->objResultPtr; + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); diff --git a/generic/tclInt.h b/generic/tclInt.h index 6278267..9b5efd1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1774,7 +1774,7 @@ typedef struct AllocCache { typedef struct Interp { /* * The first two fields were named "result" and "freeProc" in earlier - * verions of Tcl. They are no longer used within Tcl, and are no + * versions of Tcl. They are no longer used within Tcl, and are no * longer available to be accessed by extensions. However, they cannot * be removed. Why? There is a deployed base of stub-enabled extensions * that query the value of iPtr->stubTable. For them to continue to work, @@ -1792,7 +1792,7 @@ typedef struct Interp { /* Pointer to the exported Tcl stub table. In * ancient pre-8.1 versions of Tcl this was a * pointer to the objResultptr or a pointer to a - * buckets array in a hash table. Deployed stubs + * buckets array in a hash table. Deployed stubs * enabled extensions check for a NULL pointer value * and for a TCL_STUBS_MAGIC value to verify they * are not [load]ing into one of those pre-stubs diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 87bb1c1..4e6ee2f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -470,17 +470,17 @@ Tcl_LoadObjCmd( */ if (code != TCL_OK) { - Interp *iPtr = (Interp *) target; - if (iPtr->legacyResult && !iPtr->legacyFreeProc) { - /* - * A call to Tcl_InitStubs() determined the caller extension and - * this interp are incompatible in their stubs mechanisms, and - * recorded the error in the oldest legacy place we have to do so. - */ - Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); - iPtr->legacyResult = NULL; - iPtr->legacyFreeProc = (void (*) (void))-1; - } + Interp *iPtr = (Interp *) target; + if (iPtr->legacyResult && !iPtr->legacyFreeProc) { + /* + * A call to Tcl_InitStubs() determined the caller extension and + * this interp are incompatible in their stubs mechanisms, and + * recorded the error in the oldest legacy place we have to do so. + */ + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); + iPtr->legacyResult = NULL; + iPtr->legacyFreeProc = (void (*) (void))-1; + } Tcl_TransferResult(target, code, interp); goto done; } diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index a135465..b26fb01 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -66,8 +66,7 @@ Tcl_InitStubs( */ if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { - iPtr->legacyResult - = "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism"; iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 3f809d5..5c0f55c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2923,11 +2923,11 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { - Tcl_Obj *obj = Tcl_GetObjResult(interp); - const char *bytes = TclGetString(obj); + int length; + char *bytes = TclGetStringFromObj(Tcl_GetObjResult(interp), &length); Tcl_DStringFree(dsPtr); - Tcl_DStringAppend(dsPtr, bytes, obj->length); + Tcl_DStringAppend(dsPtr, bytes, length); Tcl_ResetResult(interp); } -- cgit v0.12 From 312263821fb4b272cff0d1b7de06da1260a75112 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2017 15:25:36 +0000 Subject: tidy --- generic/tclInt.h | 18 +++++++++--------- generic/tclResult.c | 5 ++++- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 9b5efd1..84c8f5f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1789,15 +1789,15 @@ typedef struct Interp { * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. In - * ancient pre-8.1 versions of Tcl this was a - * pointer to the objResultptr or a pointer to a - * buckets array in a hash table. Deployed stubs - * enabled extensions check for a NULL pointer value - * and for a TCL_STUBS_MAGIC value to verify they - * are not [load]ing into one of those pre-stubs - * interps. - */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultPtr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ diff --git a/generic/tclResult.c b/generic/tclResult.c index 0f44ed2..fb97e0b 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -372,6 +372,7 @@ Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; + return Tcl_GetString(iPtr->objResultPtr); } @@ -441,6 +442,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; + return iPtr->objResultPtr; } @@ -572,7 +574,8 @@ Tcl_AppendElement( * * Side effects: * Frees the memory associated with interp's result but does not change - * any part of the error dictionary. + * any part of the error dictionary (i.e., the errorinfo and errorcode + * remain the same). * *---------------------------------------------------------------------- */ -- cgit v0.12 From 9a322ef01682c544f3a875c9c5f961b4428a9aee Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2017 15:35:58 +0000 Subject: tidy? --- generic/tclInt.h | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 84c8f5f..6f87abc 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1789,15 +1789,15 @@ typedef struct Interp { * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. In - * ancient pre-8.1 versions of Tcl this was a - * pointer to the objResultPtr or a pointer to a - * buckets array in a hash table. Deployed stubs - * enabled extensions check for a NULL pointer value - * and for a TCL_STUBS_MAGIC value to verify they - * are not [load]ing into one of those pre-stubs - * interps. - */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultPtr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ -- cgit v0.12 From b8b341fea6c287382301eb3de4309197d4390b60 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Oct 2017 16:46:49 +0000 Subject: Fix some pointer arthemeric (only visible on big-endian systems) --- generic/tclExecute.c | 53 ++++++++++++++++++++++++---------------------------- generic/tclInt.h | 19 ++++++++++++++++++- generic/tclObj.c | 7 +------ 3 files changed, 43 insertions(+), 36 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3e64805..ee9e2e0 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1878,8 +1878,8 @@ TclIncrObj( } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - long augend = *((const long *) ptr1); - long addend = *((const long *) ptr2); + long augend = *((const Tcl_WideInt *) ptr1); + long addend = *((const Tcl_WideInt *) ptr2); long sum = augend + addend; /* @@ -3722,7 +3722,7 @@ TEBCresume( objPtr = varPtr->value.objPtr; if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { if (type == TCL_NUMBER_LONG) { - long augend = *((const long *)ptr); + long augend = *((const Tcl_WideInt *)ptr); long sum = augend + increment; /* @@ -5897,19 +5897,14 @@ TEBCresume( case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; - } else if (type1 == TCL_NUMBER_LONG) { + } else if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { /* value is between LONG_MIN and LONG_MAX */ /* [string is integer] is -UINT_MAX to UINT_MAX range */ int i; if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { type1 = TCL_NUMBER_WIDE; - } - } else if (type1 == TCL_NUMBER_WIDE) { - /* value is between WIDE_MIN and WIDE_MAX */ - /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ - int i; - if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { + } else { type1 = TCL_NUMBER_LONG; } } else if (type1 == TCL_NUMBER_BIG) { @@ -5957,8 +5952,8 @@ TEBCresume( goto convertComparison; } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - l1 = *((const long *)ptr1); - l2 = *((const long *)ptr2); + l1 = *((const Tcl_WideInt *)ptr1); + l2 = *((const Tcl_WideInt *)ptr2); compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); } else { compare = TclCompareTwoNumbers(valuePtr, value2Ptr); @@ -6036,8 +6031,8 @@ TEBCresume( */ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - l1 = *((const long *)ptr1); - l2 = *((const long *)ptr2); + l1 = *((const Tcl_WideInt *)ptr1); + l2 = *((const Tcl_WideInt *)ptr2); switch (*pc) { case INST_MOD: @@ -6287,8 +6282,8 @@ TEBCresume( if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { Tcl_WideInt w1, w2, wResult; - l1 = *((const long *)ptr1); - l2 = *((const long *)ptr2); + l1 = *((const Tcl_WideInt *)ptr1); + l2 = *((const Tcl_WideInt *)ptr2); switch (*pc) { case INST_ADD: @@ -6434,7 +6429,7 @@ TEBCresume( goto gotError; } if (type1 == TCL_NUMBER_LONG) { - l1 = *((const long *) ptr1); + l1 = *((const Tcl_WideInt *) ptr1); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, ~l1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); @@ -6471,7 +6466,7 @@ TEBCresume( TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); case TCL_NUMBER_LONG: - l1 = *((const long *) ptr1); + l1 = *((const Tcl_WideInt *) ptr1); if (l1 != LONG_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, -l1); @@ -8150,7 +8145,7 @@ ExecuteExtendedBinaryMathOp( l2 = 0; /* silence gcc warning */ if (type2 == TCL_NUMBER_LONG) { - l2 = *((const long *)ptr2); + l2 = *((const Tcl_WideInt *)ptr2); if (l2 == 0) { return DIVIDED_BY_ZERO; } @@ -8255,7 +8250,7 @@ ExecuteExtendedBinaryMathOp( * Zero shifted any number of bits is still zero. */ - if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) { + if ((type1==TCL_NUMBER_LONG) && (*((const Tcl_WideInt *)ptr1) == (long)0)) { return constants[0]; } @@ -8269,7 +8264,7 @@ ExecuteExtendedBinaryMathOp( */ if ((type2 != TCL_NUMBER_LONG) - || (*((const long *)ptr2) > (long) INT_MAX)) { + || (*((const Tcl_WideInt *)ptr2) > (long) INT_MAX)) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) in * an mp_int, but since we're using mp_mul_2d() to do the @@ -8281,7 +8276,7 @@ ExecuteExtendedBinaryMathOp( "integer value too large to represent", -1)); return GENERAL_ARITHMETIC_ERROR; } - shift = (int)(*((const long *)ptr2)); + shift = (int)(*((const Tcl_WideInt *)ptr2)); /* * Handle shifts within the native wide range. @@ -8302,7 +8297,7 @@ ExecuteExtendedBinaryMathOp( */ if ((type2 != TCL_NUMBER_LONG) - || (*(const long *)ptr2 > INT_MAX)) { + || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) { /* * Again, technically, the value to be shifted could be an * mp_int so huge that a right shift by (INT_MAX+1) bits could @@ -8313,7 +8308,7 @@ ExecuteExtendedBinaryMathOp( switch (type1) { case TCL_NUMBER_LONG: - zero = (*(const long *)ptr1 > 0L); + zero = (*(const Tcl_WideInt *)ptr1 > 0L); break; case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); @@ -8332,7 +8327,7 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(-1); } - shift = (int)(*(const long *)ptr2); + shift = (int)(*(const Tcl_WideInt *)ptr2); /* * Handle shifts within the native wide range. @@ -8535,8 +8530,8 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(wResult); } - l1 = *((const long *)ptr1); - l2 = *((const long *)ptr2); + l1 = *((const Tcl_WideInt *)ptr1); + l2 = *((const Tcl_WideInt *)ptr2); switch (opcode) { case INST_BITAND: @@ -8570,7 +8565,7 @@ ExecuteExtendedBinaryMathOp( } l1 = l2 = 0; if (type2 == TCL_NUMBER_LONG) { - l2 = *((const long *) ptr2); + l2 = *((const Tcl_WideInt *) ptr2); if (l2 == 0) { /* * Anything to the zero power is 1. @@ -8606,7 +8601,7 @@ ExecuteExtendedBinaryMathOp( } if (type1 == TCL_NUMBER_LONG) { - l1 = *((const long *)ptr1); + l1 = *((const Tcl_WideInt *)ptr1); } if (negativeExponent) { if (type1 == TCL_NUMBER_LONG) { diff --git a/generic/tclInt.h b/generic/tclInt.h index bb02ddf..3799287 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4589,11 +4589,25 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (long)(i); \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \ (objPtr)->typePtr = &tclIntType; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) +#ifndef TCL_WIDE_INT_IS_LONG +#define TclNewWideObj(objPtr, i) \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \ + (objPtr)->typePtr = &tclWideIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) +#else +#define TclNewWideObj(objPtr, i) TclNewLongObj(objPtr, i) +#endif #define TclNewDoubleObj(objPtr, d) \ do { \ TclIncrObjsAllocated(); \ @@ -4619,6 +4633,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclNewLongObj(objPtr, l) \ (objPtr) = Tcl_NewLongObj(l) +#define TclNewWideObj(objPtr, w) \ + (objPtr) = Tcl_NewWideIntObj(w) + #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) diff --git a/generic/tclObj.c b/generic/tclObj.c index 78d7518..e4613ba 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3550,12 +3550,7 @@ TclGetNumberFromObj( *clientDataPtr = &objPtr->internalRep.doubleValue; return TCL_OK; } - if (objPtr->typePtr == &tclIntType) { - *typePtr = TCL_NUMBER_LONG; - *clientDataPtr = &objPtr->internalRep.wideValue; - return TCL_OK; - } - if (objPtr->typePtr == &tclWideIntType) { + if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclWideIntType) { *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; -- cgit v0.12 From b0a9f6c55b529b1b7ad08fabce66218512634149 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 09:48:57 +0000 Subject: Simplify implementation of Tcl_SaveResult/Tcl_RestoreResult/Tcl_DiscardResult by no longer assuming that Tcl_SavedResult is a struct. Backported from "novem" branch. --- doc/SaveResult.3 | 4 ++-- generic/tcl.h | 8 +++----- generic/tclDecls.h | 10 +++++----- generic/tclResult.c | 6 +++--- 4 files changed, 13 insertions(+), 15 deletions(-) diff --git a/doc/SaveResult.3 b/doc/SaveResult.3 index b2270a2..6dd6cb6 100644 --- a/doc/SaveResult.3 +++ b/doc/SaveResult.3 @@ -54,9 +54,9 @@ is called, Tcl will take care of memory management. .PP The second triplet stores the snapshot of only the interpreter result (not its complete state) in memory allocated by the caller. -These routines are passed a pointer to a \fBTcl_SavedResult\fR structure +These routines are passed a pointer to \fBTcl_SavedResult\fR that is used to store enough information to restore the interpreter result. -This structure can be allocated on the stack of the calling +\fBTcl_SavedResult\fR can be allocated on the stack of the calling procedure. These routines do not save the state of any error information in the interpreter (e.g. the \fB\-errorcode\fR or \fB\-errorinfo\fR return options, when an error is in progress). diff --git a/generic/tcl.h b/generic/tcl.h index 0d40f41..6d4e6bb 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -825,13 +825,11 @@ int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- - * The following type contains the state needed by Tcl_SaveResult. This - * structure is typically allocated on the stack. + * The following type contains the state needed by Tcl_SaveResult. It + * is typically allocated on the stack. */ -typedef struct Tcl_SavedResult { - Tcl_Obj *objResultPtr; -} Tcl_SavedResult; +typedef Tcl_Obj *Tcl_SavedResult; /* *---------------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..17d60a8 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3888,20 +3888,20 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_SaveResult #define Tcl_SaveResult(interp, statePtr) \ do { \ - (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \ - Tcl_IncrRefCount((statePtr)->objResultPtr); \ + *(statePtr) = Tcl_GetObjResult(interp); \ + Tcl_IncrRefCount(*(statePtr)); \ Tcl_SetObjResult(interp, Tcl_NewObj()); \ } while(0) #undef Tcl_RestoreResult #define Tcl_RestoreResult(interp, statePtr) \ do { \ Tcl_ResetResult(interp); \ - Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \ - Tcl_DecrRefCount((statePtr)->objResultPtr); \ + Tcl_SetObjResult(interp, *(statePtr)); \ + Tcl_DecrRefCount(*(statePtr)); \ } while(0) #undef Tcl_DiscardResult #define Tcl_DiscardResult(statePtr) \ - Tcl_DecrRefCount((statePtr)->objResultPtr) + Tcl_DecrRefCount(*(statePtr)) #undef Tcl_SetResult #define Tcl_SetResult(interp, result, freeProc) \ do { \ diff --git a/generic/tclResult.c b/generic/tclResult.c index fb97e0b..5a8ef61 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -244,7 +244,7 @@ Tcl_SaveResult( * reference. Put an empty object into the interpreter. */ - statePtr->objResultPtr = iPtr->objResultPtr; + *statePtr = iPtr->objResultPtr; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); } @@ -282,7 +282,7 @@ Tcl_RestoreResult( */ Tcl_DecrRefCount(iPtr->objResultPtr); - iPtr->objResultPtr = statePtr->objResultPtr; + iPtr->objResultPtr = *statePtr; } /* @@ -308,7 +308,7 @@ void Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { - TclDecrRefCount(statePtr->objResultPtr); + Tcl_DecrRefCount(*statePtr); } /* -- cgit v0.12 From c8fbbd8f3eef002f8913793c394ddc6f9e416da1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 11:37:29 +0000 Subject: Fix 2 failing test-cases, broken by some earlier commit --- generic/tclExecute.c | 68 ++++++++++++++++++++++++++-------------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ee9e2e0..76e1496 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5893,13 +5893,15 @@ TEBCresume( ClientData ptr1, ptr2; int type1, type2; long l1, l2, lResult; + Tcl_WideInt w1, w2, wResult; case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; } else if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { - /* value is between LONG_MIN and LONG_MAX */ + /* value is between WIDE_MIN and WIDE_MAX */ /* [string is integer] is -UINT_MAX to UINT_MAX range */ + /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ int i; if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { @@ -5909,10 +5911,14 @@ TEBCresume( } } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ + /* [string is integer] is -UINT_MAX to UINT_MAX range */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ + int i; Tcl_WideInt w; - if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { + if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { + type1 = TCL_NUMBER_LONG; + } else if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { type1 = TCL_NUMBER_WIDE; } } @@ -5951,10 +5957,10 @@ TEBCresume( compare = MP_EQ; goto convertComparison; } - if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - l1 = *((const Tcl_WideInt *)ptr1); - l2 = *((const Tcl_WideInt *)ptr2); - compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); + if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + w1 = *((const Tcl_WideInt *)ptr1); + w2 = *((const Tcl_WideInt *)ptr2); + compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); } else { compare = TclCompareTwoNumbers(valuePtr, value2Ptr); } @@ -6280,15 +6286,13 @@ TEBCresume( */ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - Tcl_WideInt w1, w2, wResult; - - l1 = *((const Tcl_WideInt *)ptr1); - l2 = *((const Tcl_WideInt *)ptr2); + w1 = *((const Tcl_WideInt *)ptr1); + w2 = *((const Tcl_WideInt *)ptr2); + l1 = w1; + l2 = w2; switch (*pc) { case INST_ADD: - w1 = (Tcl_WideInt) l1; - w2 = (Tcl_WideInt) l2; wResult = w1 + w2; /* * Check for overflow. @@ -6300,8 +6304,6 @@ TEBCresume( goto wideResultOfArithmetic; case INST_SUB: - w1 = (Tcl_WideInt) l1; - w2 = (Tcl_WideInt) l2; wResult = w1 - w2; /* * Must check for overflow. The macro tests for overflows in @@ -6328,40 +6330,40 @@ TEBCresume( NEXT_INST_F(1, 1, 0); case INST_DIV: - if (l2 == 0) { + if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; - } else if ((l1 == LONG_MIN) && (l2 == -1)) { + } else if ((w1 == LLONG_MIN) && (w2 == -1)) { /* - * Can't represent (-LONG_MIN) as a long. + * Can't represent (-LLONG_MIN) as a long. */ goto overflow; } - lResult = l1 / l2; + wResult = w1 / w2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ - if (((lResult < 0) || ((lResult == 0) && - ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && - ((lResult * l2) != l1)) { - lResult -= 1; + if (((wResult < 0) || ((wResult == 0) && + ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) && + ((wResult * w2) != w1)) { + wResult -= 1; } - goto longResultOfArithmetic; + goto wideResultOfArithmetic; case INST_MULT: if (((sizeof(long) >= 2*sizeof(int)) - && (l1 <= INT_MAX) && (l1 >= INT_MIN) - && (l2 <= INT_MAX) && (l2 >= INT_MIN)) + && (w1 <= INT_MAX) && (w1 >= INT_MIN) + && (w2 <= INT_MAX) && (w2 >= INT_MIN)) || ((sizeof(long) >= 2*sizeof(short)) - && (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN) - && (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) { - lResult = l1 * l2; - goto longResultOfArithmetic; + && (w1 <= SHRT_MAX) && (w1 >= SHRT_MIN) + && (w2 <= SHRT_MAX) && (w2 >= SHRT_MIN))) { + wResult = w1 * w2; + goto wideResultOfArithmetic; } } @@ -8227,8 +8229,8 @@ ExecuteExtendedBinaryMathOp( */ switch (type2) { - case TCL_NUMBER_WIDE: case TCL_NUMBER_LONG: + case TCL_NUMBER_WIDE: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; case TCL_NUMBER_BIG: @@ -8250,7 +8252,7 @@ ExecuteExtendedBinaryMathOp( * Zero shifted any number of bits is still zero. */ - if ((type1==TCL_NUMBER_LONG) && (*((const Tcl_WideInt *)ptr1) == (long)0)) { + if ((type1==TCL_NUMBER_LONG || type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) { return constants[0]; } @@ -8308,8 +8310,6 @@ ExecuteExtendedBinaryMathOp( switch (type1) { case TCL_NUMBER_LONG: - zero = (*(const Tcl_WideInt *)ptr1 > 0L); - break; case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; @@ -8981,7 +8981,7 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = w1 - w2; - if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) + if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { /* * Must check for overflow. The macro tests for overflows -- cgit v0.12 From 8fd76cb8733824c202c3eda72e9716013c8c2d82 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 12:39:16 +0000 Subject: more simplifications --- generic/tclExecute.c | 57 ++++++++++------------------------------------------ 1 file changed, 11 insertions(+), 46 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 76e1496..ed4c00f 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1877,35 +1877,6 @@ TclIncrObj( return TCL_ERROR; } - if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - long augend = *((const Tcl_WideInt *) ptr1); - long addend = *((const Tcl_WideInt *) ptr2); - long sum = augend + addend; - - /* - * Overflow when (augend and sum have different sign) and (augend and - * addend have the same sign). This is encapsulated in the Overflowing - * macro. - */ - - if (!Overflowing(augend, addend, sum)) { - TclSetLongObj(valuePtr, sum); - return TCL_OK; - } - { - Tcl_WideInt w1 = (Tcl_WideInt) augend; - Tcl_WideInt w2 = (Tcl_WideInt) addend; - - /* - * We know the sum value is outside the long range, so we use the - * macro form that doesn't range test again. - */ - - TclSetWideIntObj(valuePtr, w1 + w2); - return TCL_OK; - } - } - if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { /* * Produce error message (reparse?!) @@ -8146,12 +8117,12 @@ ExecuteExtendedBinaryMathOp( /* TODO: Attempts to re-use unshared operands on stack */ l2 = 0; /* silence gcc warning */ - if (type2 == TCL_NUMBER_LONG) { - l2 = *((const Tcl_WideInt *)ptr2); - if (l2 == 0) { + if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) { + l2 = w2 = *((const Tcl_WideInt *)ptr2); + if (w2 == 0) { return DIVIDED_BY_ZERO; } - if ((l2 == 1) || (l2 == -1)) { + if ((w2 == 1) || (w2 == -1)) { /* * Div. by |1| always yields remainder of 0. */ @@ -8583,9 +8554,6 @@ ExecuteExtendedBinaryMathOp( switch (type2) { case TCL_NUMBER_LONG: - negativeExponent = (l2 < 0); - oddExponent = (int) (l2 & 1); - break; case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); negativeExponent = (w2 < 0); @@ -8600,12 +8568,12 @@ ExecuteExtendedBinaryMathOp( break; } - if (type1 == TCL_NUMBER_LONG) { - l1 = *((const Tcl_WideInt *)ptr1); + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + l1 = w1 = *((const Tcl_WideInt *)ptr1); } if (negativeExponent) { if (type1 == TCL_NUMBER_LONG) { - switch (l1) { + switch (w1) { case 0: /* * Zero to a negative power is div by zero error. @@ -8635,7 +8603,7 @@ ExecuteExtendedBinaryMathOp( } if (type1 == TCL_NUMBER_LONG) { - switch (l1) { + switch (w1) { case 0: /* * Zero to a positive power is zero. @@ -8764,9 +8732,7 @@ ExecuteExtendedBinaryMathOp( #endif } #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) - if (type1 == TCL_NUMBER_LONG) { - w1 = l1; - } else if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); } else { goto overflowExpon; @@ -9001,8 +8967,7 @@ ExecuteExtendedBinaryMathOp( break; case INST_MULT: - if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG) - || (sizeof(Tcl_WideInt) < 2*sizeof(long))) { + if ((w1 < INT_MIN) || (w1 > INT_MAX) || (w2 < INT_MIN) || (w2 > INT_MAX)) { goto overflowBasic; } wResult = w1 * w2; @@ -9105,7 +9070,7 @@ ExecuteExtendedUnaryMathOp( switch (opcode) { case INST_BITNOT: - if (type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } -- cgit v0.12 From 2f2459e12003ac4f386e21b70b7929fe73859258 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 14:40:33 +0000 Subject: more progress --- generic/tclExecute.c | 129 +++++++++++++++++++++++---------------------------- 1 file changed, 59 insertions(+), 70 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ed4c00f..704ee57 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5863,7 +5863,7 @@ TEBCresume( { ClientData ptr1, ptr2; int type1, type2; - long l1, l2, lResult; + long l1; Tcl_WideInt w1, w2, wResult; case INST_NUM_TYPE: @@ -6008,16 +6008,16 @@ TEBCresume( */ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - l1 = *((const Tcl_WideInt *)ptr1); - l2 = *((const Tcl_WideInt *)ptr2); + l1 = w1 = *((const Tcl_WideInt *)ptr1); + w2 = *((const Tcl_WideInt *)ptr2); switch (*pc) { case INST_MOD: - if (l2 == 0) { + if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; - } else if ((l2 == 1) || (l2 == -1)) { + } else if ((w2 == 1) || (w2 == -1)) { /* * Div. by |1| always yields remainder of 0. */ @@ -6026,7 +6026,7 @@ TEBCresume( objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); - } else if (l1 == 0) { + } else if (w1 == 0) { /* * 0 % (non-zero) always yields remainder of 0. */ @@ -6036,24 +6036,24 @@ TEBCresume( TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } else { - lResult = l1 / l2; + wResult = w1 / w2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ - if ((lResult < 0 || (lResult == 0 && - ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) && - (lResult * l2 != l1)) { - lResult -= 1; + if ((wResult < 0 || (wResult == 0 && + ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) && + (wResult * w2 != w1)) { + wResult -= 1; } - lResult = l1 - l2*lResult; - goto longResultOfArithmetic; + wResult = w1 - w2*wResult; + goto wideResultOfArithmetic; } case INST_RSHIFT: - if (l2 < 0) { + if (w2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR @@ -6064,7 +6064,7 @@ TEBCresume( CACHE_STACK_INFO(); #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; - } else if (l1 == 0) { + } else if (w1 == 0) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); @@ -6074,7 +6074,7 @@ TEBCresume( * Quickly force large right shifts to 0 or -1. */ - if (l2 >= (long)(CHAR_BIT*sizeof(long))) { + if (w2 >= (long)(CHAR_BIT*sizeof(long))) { /* * We assume that INT_MAX is much larger than the * number of bits in a long. This is a pretty safe @@ -6083,7 +6083,7 @@ TEBCresume( */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - if (l1 > 0L) { + if (w1 > 0L) { objResultPtr = TCONST(0); } else { TclNewLongObj(objResultPtr, -1); @@ -6096,12 +6096,12 @@ TEBCresume( * Handle shifts within the native long range. */ - lResult = l1 >> ((int) l2); - goto longResultOfArithmetic; + wResult = w1 >> ((int) w2); + goto wideResultOfArithmetic; } case INST_LSHIFT: - if (l2 < 0) { + if (w2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR @@ -6112,12 +6112,12 @@ TEBCresume( CACHE_STACK_INFO(); #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; - } else if (l1 == 0) { + } else if (w1 == 0) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); - } else if (l2 > (long) INT_MAX) { + } else if (w2 > (long) INT_MAX) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) * in an mp_int, but since we're using mp_mul_2d() to do @@ -6135,17 +6135,17 @@ TEBCresume( #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else { - int shift = (int) l2; + int shift = (int) w2; /* * Handle shifts within the native long range. */ - if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0) - && !((l1>0 ? l1 : ~l1) & + if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0) + && !((w1>0 ? w1 : ~w1) & -(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) { - lResult = l1 << shift; - goto longResultOfArithmetic; + wResult = w1 << shift; + goto wideResultOfArithmetic; } } @@ -6157,23 +6157,14 @@ TEBCresume( break; case INST_BITAND: - lResult = l1 & l2; - goto longResultOfArithmetic; + wResult = w1 & w2; + goto wideResultOfArithmetic; case INST_BITOR: - lResult = l1 | l2; - goto longResultOfArithmetic; + wResult = w1 | w2; + goto wideResultOfArithmetic; case INST_BITXOR: - lResult = l1 ^ l2; - longResultOfArithmetic: - TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - if (Tcl_IsShared(valuePtr)) { - TclNewLongObj(objResultPtr, lResult); - TRACE(("%s\n", O2S(objResultPtr))); - NEXT_INST_F(1, 2, 1); - } - TclSetLongObj(valuePtr, lResult); - TRACE(("%s\n", O2S(valuePtr))); - NEXT_INST_F(1, 1, 0); + wResult = w1 ^ w2; + goto wideResultOfArithmetic; } } @@ -6257,10 +6248,8 @@ TEBCresume( */ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - w1 = *((const Tcl_WideInt *)ptr1); + l1 = w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); - l1 = w1; - l2 = w2; switch (*pc) { case INST_ADD: @@ -6401,14 +6390,14 @@ TEBCresume( CACHE_STACK_INFO(); goto gotError; } - if (type1 == TCL_NUMBER_LONG) { - l1 = *((const Tcl_WideInt *) ptr1); + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + w1 = *((const Tcl_WideInt *) ptr1); if (Tcl_IsShared(valuePtr)) { - TclNewLongObj(objResultPtr, ~l1); + TclNewWideObj(objResultPtr, ~w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } - TclSetLongObj(valuePtr, ~l1); + TclSetWideIntObj(valuePtr, ~w1); TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -6439,7 +6428,7 @@ TEBCresume( TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); case TCL_NUMBER_LONG: - l1 = *((const Tcl_WideInt *) ptr1); + l1 = w1 = *((const Tcl_WideInt *) ptr1); if (l1 != LONG_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, -l1); @@ -8501,8 +8490,8 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(wResult); } - l1 = *((const Tcl_WideInt *)ptr1); - l2 = *((const Tcl_WideInt *)ptr2); + l1 = w1 = *((const Tcl_WideInt *)ptr1); + l2 = w2 = *((const Tcl_WideInt *)ptr2); switch (opcode) { case INST_BITAND: @@ -8536,14 +8525,14 @@ ExecuteExtendedBinaryMathOp( } l1 = l2 = 0; if (type2 == TCL_NUMBER_LONG) { - l2 = *((const Tcl_WideInt *) ptr2); - if (l2 == 0) { + l2 = w2 = *((const Tcl_WideInt *) ptr2); + if (w2 == 0) { /* * Anything to the zero power is 1. */ return constants[1]; - } else if (l2 == 1) { + } else if (w2 == 1) { /* * Anything to the first power is itself */ @@ -8640,25 +8629,25 @@ ExecuteExtendedBinaryMathOp( } if (type1 == TCL_NUMBER_LONG) { - if (l1 == 2) { + if (w1 == 2) { /* * Reduce small powers of 2 to shifts. */ - if ((Tcl_WideUInt) l2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) { - WIDE_RESULT(((Tcl_WideInt) 1) << l2); + if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) { + WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2); } goto overflowExpon; } - if (l1 == -2) { + if (w1 == -2) { int signum = oddExponent ? -1 : 1; /* * Reduce small powers of 2 to shifts. */ - if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ - WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2)); + if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ + WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2)); } goto overflowExpon; } @@ -8737,19 +8726,19 @@ ExecuteExtendedBinaryMathOp( } else { goto overflowExpon; } - if (l2 - 2 < (long)MaxBase64Size - && w1 <= MaxBase64[l2 - 2] - && w1 >= -MaxBase64[l2 - 2]) { + if (w2 - 2 < (long)MaxBase64Size + && w1 <= MaxBase64[w2 - 2] + && w1 >= -MaxBase64[w2 - 2]) { /* * Small powers of integers whose result is wide. */ wResult = w1 * w1; /* b**2 */ - switch (l2) { + switch (w2) { case 2: break; case 3: - wResult *= l1; /* b**3 */ + wResult *= w1; /* b**3 */ break; case 4: wResult *= wResult; /* b**4 */ @@ -8826,9 +8815,9 @@ ExecuteExtendedBinaryMathOp( */ if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize - && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) { + && w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) { base = Exp64Index[w1 - 3] - + (unsigned short) (l2 - 2 - MaxBase64Size); + + (unsigned short) (w2 - 2 - MaxBase64Size); if (base < Exp64Index[w1 - 2]) { /* * 64-bit number raised to intermediate power, done by @@ -8840,9 +8829,9 @@ ExecuteExtendedBinaryMathOp( } if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize - && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) { + && w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) { base = Exp64Index[-w1 - 3] - + (unsigned short) (l2 - 2 - MaxBase64Size); + + (unsigned short) (w2 - 2 - MaxBase64Size); if (base < Exp64Index[-w1 - 2]) { /* * 64-bit number raised to intermediate power, done by -- cgit v0.12 From db930a501ff7f2b3826325f52d9bbcf2f26eaead Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 14:48:28 +0000 Subject: Only use 64-bit tables for all platforms --- generic/tclExecute.c | 105 --------------------------------------------------- 1 file changed, 105 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 704ee57..2c77979 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -576,40 +576,6 @@ VarHashCreateVar( * Auxiliary tables used to compute powers of small integers. */ -#if (LONG_MAX == 0x7fffffff) - -/* - * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit - * signed integer. - */ - -static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14}; -static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long); - -/* - * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they - * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of - * powers of i+3; Exp32Value[i] gives the corresponding powers. - */ - -static const unsigned short Exp32Index[] = { - 0, 11, 18, 23, 26, 29, 31, 32, 33 -}; -static const size_t Exp32IndexSize = - sizeof(Exp32Index) / sizeof(unsigned short); -static const long Exp32Value[] = { - 19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721, - 129140163, 387420489, 1162261467, 262144, 1048576, 4194304, - 16777216, 67108864, 268435456, 1073741824, 1953125, 9765625, - 48828125, 244140625, 1220703125, 10077696, 60466176, 362797056, - 40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489, - 1000000000 -}; -static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long); -#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */ - -#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) - /* * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a * Tcl_WideInt. @@ -713,7 +679,6 @@ static const Tcl_WideInt Exp64Value[] = { (Tcl_WideInt)371293*371293*371293*13*13 }; static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt); -#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */ /* * Markers for ExecuteExtendedBinaryMathOp. @@ -8651,76 +8616,7 @@ ExecuteExtendedBinaryMathOp( } goto overflowExpon; } -#if (LONG_MAX == 0x7fffffff) - if (l2 - 2 < (long)MaxBase32Size - && l1 <= MaxBase32[l2 - 2] - && l1 >= -MaxBase32[l2 - 2]) { - /* - * Small powers of 32-bit integers. - */ - - lResult = l1 * l1; /* b**2 */ - switch (l2) { - case 2: - break; - case 3: - lResult *= l1; /* b**3 */ - break; - case 4: - lResult *= lResult; /* b**4 */ - break; - case 5: - lResult *= lResult; /* b**4 */ - lResult *= l1; /* b**5 */ - break; - case 6: - lResult *= l1; /* b**3 */ - lResult *= lResult; /* b**6 */ - break; - case 7: - lResult *= l1; /* b**3 */ - lResult *= lResult; /* b**6 */ - lResult *= l1; /* b**7 */ - break; - case 8: - lResult *= lResult; /* b**4 */ - lResult *= lResult; /* b**8 */ - break; - } - WIDE_RESULT(lResult); - } - - if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize - && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) { - base = Exp32Index[l1 - 3] - + (unsigned short) (l2 - 2 - MaxBase32Size); - if (base < Exp32Index[l1 - 2]) { - /* - * 32-bit number raised to intermediate power, done by - * table lookup. - */ - - WIDE_RESULT(Exp32Value[base]); - } - } - if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize - && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) { - base = Exp32Index[-l1 - 3] - + (unsigned short) (l2 - 2 - MaxBase32Size); - if (base < Exp32Index[-l1 - 2]) { - /* - * 32-bit number raised to intermediate power, done by - * table lookup. - */ - - lResult = (oddExponent) ? - -Exp32Value[base] : Exp32Value[base]; - WIDE_RESULT(lResult); - } - } -#endif } -#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); } else { @@ -8842,7 +8738,6 @@ ExecuteExtendedBinaryMathOp( WIDE_RESULT(wResult); } } -#endif overflowExpon: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); -- cgit v0.12 From 1cbd95eeee01fe3a144bba18c710be5c8442ff14 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 16:16:46 +0000 Subject: eliminate most use of (long) type, except for increments --- generic/tclExecute.c | 110 ++++++++++++++++++--------------------------------- 1 file changed, 39 insertions(+), 71 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2c77979..846b04f 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3657,9 +3657,9 @@ TEBCresume( objPtr = varPtr->value.objPtr; if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { - if (type == TCL_NUMBER_LONG) { - long augend = *((const Tcl_WideInt *)ptr); - long sum = augend + increment; + if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) { + Tcl_WideInt augend = *((const Tcl_WideInt *)ptr); + Tcl_WideInt sum = augend + increment; /* * Overflow when (augend and sum have different sign) and @@ -3671,12 +3671,12 @@ TEBCresume( TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ - TclNewLongObj(objResultPtr, sum); + TclNewWideObj(objResultPtr, sum); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; - TclSetLongObj(objPtr, sum); + TclSetWideIntObj(objPtr, sum); } goto doneIncr; } @@ -3699,38 +3699,7 @@ TEBCresume( TclSetWideIntObj(objPtr, w+increment); } goto doneIncr; - } /* end if (type == TCL_NUMBER_LONG) */ - if (type == TCL_NUMBER_WIDE) { - Tcl_WideInt sum; - - w = *((const Tcl_WideInt *) ptr); - sum = w + increment; - - /* - * Check for overflow. - */ - - if (!Overflowing(w, increment, sum)) { - TRACE(("%u %ld => ", opnd, increment)); - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared. */ - objResultPtr = Tcl_NewWideIntObj(sum); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - - /* - * We *do not* know the sum value is outside the - * long range (wide + long can yield long); use - * the function call that checks range. - */ - - Tcl_SetWideIntObj(objPtr, sum); - } - goto doneIncr; - } - } + } /* end if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) */ } if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ @@ -5828,7 +5797,6 @@ TEBCresume( { ClientData ptr1, ptr2; int type1, type2; - long l1; Tcl_WideInt w1, w2, wResult; case INST_NUM_TYPE: @@ -5972,8 +5940,8 @@ TEBCresume( * Check for common, simple case. */ - if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - l1 = w1 = *((const Tcl_WideInt *)ptr1); + if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); switch (*pc) { @@ -6039,7 +6007,7 @@ TEBCresume( * Quickly force large right shifts to 0 or -1. */ - if (w2 >= (long)(CHAR_BIT*sizeof(long))) { + if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) { /* * We assume that INT_MAX is much larger than the * number of bits in a long. This is a pretty safe @@ -6082,7 +6050,7 @@ TEBCresume( objResultPtr = TCONST(0); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); - } else if (w2 > (long) INT_MAX) { + } else if (w2 > (Tcl_WideInt) INT_MAX) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) * in an mp_int, but since we're using mp_mul_2d() to do @@ -6212,8 +6180,8 @@ TEBCresume( * an external function. */ - if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - l1 = w1 = *((const Tcl_WideInt *)ptr1); + if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); switch (*pc) { @@ -6393,14 +6361,15 @@ TEBCresume( TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); case TCL_NUMBER_LONG: - l1 = w1 = *((const Tcl_WideInt *) ptr1); - if (l1 != LONG_MIN) { + case TCL_NUMBER_WIDE: + w1 = *((const Tcl_WideInt *) ptr1); + if (w1 != LLONG_MIN) { if (Tcl_IsShared(valuePtr)) { - TclNewLongObj(objResultPtr, -l1); + TclNewWideObj(objResultPtr, -w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } - TclSetLongObj(valuePtr, -l1); + TclSetWideIntObj(valuePtr, -w1); TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -8056,7 +8025,6 @@ ExecuteExtendedBinaryMathOp( int type1, type2; ClientData ptr1, ptr2; double d1, d2, dResult; - long l1, l2, lResult; Tcl_WideInt w1, w2, wResult; mp_int big1, big2, bigResult, bigRemainder; Tcl_Obj *objResultPtr; @@ -8070,9 +8038,9 @@ ExecuteExtendedBinaryMathOp( case INST_MOD: /* TODO: Attempts to re-use unshared operands on stack */ - l2 = 0; /* silence gcc warning */ + w2 = 0; /* silence gcc warning */ if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) { - l2 = w2 = *((const Tcl_WideInt *)ptr2); + w2 = *((const Tcl_WideInt *)ptr2); if (w2 == 0) { return DIVIDED_BY_ZERO; } @@ -8190,7 +8158,7 @@ ExecuteExtendedBinaryMathOp( * counterparts, leading to incorrect results. */ - if ((type2 != TCL_NUMBER_LONG) + if ((type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) || (*((const Tcl_WideInt *)ptr2) > (long) INT_MAX)) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) in @@ -8223,7 +8191,7 @@ ExecuteExtendedBinaryMathOp( * Quickly force large right shifts to 0 or -1. */ - if ((type2 != TCL_NUMBER_LONG) + if ((type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) { /* * Again, technically, the value to be shifted could be an @@ -8258,7 +8226,7 @@ ExecuteExtendedBinaryMathOp( * Handle shifts within the native wide range. */ - if (type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { w1 = *(const Tcl_WideInt *)ptr1; if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) { if (w1 >= (Tcl_WideInt)0) { @@ -8435,7 +8403,7 @@ ExecuteExtendedBinaryMathOp( BIG_RESULT(&bigResult); } - if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -8455,24 +8423,24 @@ ExecuteExtendedBinaryMathOp( } WIDE_RESULT(wResult); } - l1 = w1 = *((const Tcl_WideInt *)ptr1); - l2 = w2 = *((const Tcl_WideInt *)ptr2); + w1 = *((const Tcl_WideInt *)ptr1); + w2 = *((const Tcl_WideInt *)ptr2); switch (opcode) { case INST_BITAND: - lResult = l1 & l2; + wResult = w1 & w2; break; case INST_BITOR: - lResult = l1 | l2; + wResult = w1 | w2; break; case INST_BITXOR: - lResult = l1 ^ l2; + wResult = w1 ^ w2; break; default: /* Unused, here to silence compiler warning. */ - lResult = 0; + wResult = 0; } - WIDE_RESULT(lResult); + WIDE_RESULT(wResult); case INST_EXPON: { int oddExponent = 0, negativeExponent = 0; @@ -8488,9 +8456,9 @@ ExecuteExtendedBinaryMathOp( dResult = pow(d1, d2); goto doubleResult; } - l1 = l2 = 0; - if (type2 == TCL_NUMBER_LONG) { - l2 = w2 = *((const Tcl_WideInt *) ptr2); + w2 = 0; + if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) { + w2 = *((const Tcl_WideInt *) ptr2); if (w2 == 0) { /* * Anything to the zero power is 1. @@ -8523,10 +8491,10 @@ ExecuteExtendedBinaryMathOp( } if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { - l1 = w1 = *((const Tcl_WideInt *)ptr1); + w1 = *((const Tcl_WideInt *)ptr1); } if (negativeExponent) { - if (type1 == TCL_NUMBER_LONG) { + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { switch (w1) { case 0: /* @@ -8556,7 +8524,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } - if (type1 == TCL_NUMBER_LONG) { + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { switch (w1) { case 0: /* @@ -8587,13 +8555,13 @@ ExecuteExtendedBinaryMathOp( * accept. */ - if (type2 != TCL_NUMBER_LONG) { + if (type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } - if (type1 == TCL_NUMBER_LONG) { + if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { if (w1 == 2) { /* * Reduce small powers of 2 to shifts. @@ -8817,7 +8785,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = w1 + w2; - if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) + if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { /* * Check for overflow. -- cgit v0.12 From adc216698f7b3e45354f185b714df1754c429aa9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Oct 2017 16:40:57 +0000 Subject: Eliminate most usage of TCL_NUMBER_LONG, just use TCL_NUMBER_WIDE in stead (since both have the same internal representation now) --- generic/tclBasic.c | 3 +-- generic/tclExecute.c | 67 +++++++++++++++++++++------------------------------- 2 files changed, 28 insertions(+), 42 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a911028..f69e861 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6466,7 +6466,6 @@ Tcl_ExprLongObj( resultPtr = Tcl_NewBignumObj(&big); /* FALLTHROUGH */ } - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: case TCL_NUMBER_BIG: result = TclGetLongFromObj(interp, resultPtr, ptr); @@ -7442,7 +7441,7 @@ ExprAbsFunc( return TCL_ERROR; } - if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_WIDE) { Tcl_WideInt l = *((const Tcl_WideInt *) ptr); if (l > (Tcl_WideInt)0) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 846b04f..9eed936 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -501,7 +501,7 @@ VarHashCreateVar( #ifdef TCL_WIDE_INT_IS_LONG #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ - ? (*(tPtr) = TCL_NUMBER_LONG, \ + ? (*(tPtr) = TCL_NUMBER_WIDE, \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclDoubleType) \ @@ -516,7 +516,7 @@ VarHashCreateVar( #else /* !TCL_WIDE_INT_IS_LONG */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ - ? (*(tPtr) = TCL_NUMBER_LONG, \ + ? (*(tPtr) = TCL_NUMBER_WIDE, \ *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ ((objPtr)->typePtr == &tclWideIntType) \ @@ -3657,7 +3657,7 @@ TEBCresume( objPtr = varPtr->value.objPtr; if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { - if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_WIDE) { Tcl_WideInt augend = *((const Tcl_WideInt *)ptr); Tcl_WideInt sum = augend + increment; @@ -3699,7 +3699,7 @@ TEBCresume( TclSetWideIntObj(objPtr, w+increment); } goto doneIncr; - } /* end if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) */ + } /* end if (type == TCL_NUMBER_WIDE) */ } if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ @@ -5802,7 +5802,7 @@ TEBCresume( case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; - } else if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + } else if (type1 == TCL_NUMBER_WIDE) { /* value is between WIDE_MIN and WIDE_MAX */ /* [string is integer] is -UINT_MAX to UINT_MAX range */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ @@ -5815,14 +5815,10 @@ TEBCresume( } } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ - /* [string is integer] is -UINT_MAX to UINT_MAX range */ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ - int i; Tcl_WideInt w; - if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { - type1 = TCL_NUMBER_LONG; - } else if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { + if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { type1 = TCL_NUMBER_WIDE; } } @@ -5861,7 +5857,7 @@ TEBCresume( compare = MP_EQ; goto convertComparison; } - if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) { w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ); @@ -5940,7 +5936,7 @@ TEBCresume( * Check for common, simple case. */ - if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) { w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); @@ -6180,7 +6176,7 @@ TEBCresume( * an external function. */ - if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) { w1 = *((const Tcl_WideInt *)ptr1); w2 = *((const Tcl_WideInt *)ptr2); @@ -6323,7 +6319,7 @@ TEBCresume( CACHE_STACK_INFO(); goto gotError; } - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); if (Tcl_IsShared(valuePtr)) { TclNewWideObj(objResultPtr, ~w1); @@ -6360,7 +6356,6 @@ TEBCresume( /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != LLONG_MIN) { @@ -8039,7 +8034,7 @@ ExecuteExtendedBinaryMathOp( /* TODO: Attempts to re-use unshared operands on stack */ w2 = 0; /* silence gcc warning */ - if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) { + if (type2 == TCL_NUMBER_WIDE) { w2 = *((const Tcl_WideInt *)ptr2); if (w2 == 0) { return DIVIDED_BY_ZERO; @@ -8122,7 +8117,6 @@ ExecuteExtendedBinaryMathOp( */ switch (type2) { - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; @@ -8145,7 +8139,7 @@ ExecuteExtendedBinaryMathOp( * Zero shifted any number of bits is still zero. */ - if ((type1==TCL_NUMBER_LONG || type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) { + if ((type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) { return constants[0]; } @@ -8158,7 +8152,7 @@ ExecuteExtendedBinaryMathOp( * counterparts, leading to incorrect results. */ - if ((type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) + if ((type2 != TCL_NUMBER_WIDE) || (*((const Tcl_WideInt *)ptr2) > (long) INT_MAX)) { /* * Technically, we could hold the value (1 << (INT_MAX+1)) in @@ -8191,7 +8185,7 @@ ExecuteExtendedBinaryMathOp( * Quickly force large right shifts to 0 or -1. */ - if ((type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) + if ((type2 != TCL_NUMBER_WIDE) || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) { /* * Again, technically, the value to be shifted could be an @@ -8202,7 +8196,6 @@ ExecuteExtendedBinaryMathOp( */ switch (type1) { - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; @@ -8226,7 +8219,7 @@ ExecuteExtendedBinaryMathOp( * Handle shifts within the native wide range. */ - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { w1 = *(const Tcl_WideInt *)ptr1; if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) { if (w1 >= (Tcl_WideInt)0) { @@ -8403,7 +8396,7 @@ ExecuteExtendedBinaryMathOp( BIG_RESULT(&bigResult); } - if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) { + if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -8457,7 +8450,7 @@ ExecuteExtendedBinaryMathOp( goto doubleResult; } w2 = 0; - if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) { + if (type2 == TCL_NUMBER_WIDE) { w2 = *((const Tcl_WideInt *) ptr2); if (w2 == 0) { /* @@ -8475,7 +8468,6 @@ ExecuteExtendedBinaryMathOp( } switch (type2) { - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); negativeExponent = (w2 < 0); @@ -8490,11 +8482,11 @@ ExecuteExtendedBinaryMathOp( break; } - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *)ptr1); } if (negativeExponent) { - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { switch (w1) { case 0: /* @@ -8524,7 +8516,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { switch (w1) { case 0: /* @@ -8551,17 +8543,17 @@ ExecuteExtendedBinaryMathOp( * which means the max exponent value is 2**28-1 = 0x0fffffff = * 268435455, which fits into a signed 32 bit int which is within the * range of the long int type. This means any numeric Tcl_Obj value - * not using TCL_NUMBER_LONG type must hold a value larger than we + * not using TCL_NUMBER_WIDE type must hold a value larger than we * accept. */ - if (type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) { + if (type2 != TCL_NUMBER_WIDE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { if (w1 == 2) { /* * Reduce small powers of 2 to shifts. @@ -8585,7 +8577,7 @@ ExecuteExtendedBinaryMathOp( goto overflowExpon; } } - if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) { + if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); } else { goto overflowExpon; @@ -8785,7 +8777,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = w1 + w2; - if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) + if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { /* * Check for overflow. @@ -8799,7 +8791,7 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = w1 - w2; - if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) + if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { /* * Must check for overflow. The macro tests for overflows @@ -8922,7 +8914,7 @@ ExecuteExtendedUnaryMathOp( switch (opcode) { case INST_BITNOT: - if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) { + if (type == TCL_NUMBER_WIDE) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } @@ -8935,7 +8927,6 @@ ExecuteExtendedUnaryMathOp( switch (type) { case TCL_NUMBER_DOUBLE: DOUBLE_RESULT(-(*((const double *) ptr))); - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: w = *((const Tcl_WideInt *) ptr); if (w != LLONG_MIN) { @@ -8990,11 +8981,9 @@ TclCompareTwoNumbers( (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (type1) { - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: w1 = *((const Tcl_WideInt *)ptr1); switch (type2) { - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); wideCompare: @@ -9052,7 +9041,6 @@ TclCompareTwoNumbers( d2 = *((const double *)ptr2); doubleCompare: return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; @@ -9095,7 +9083,6 @@ TclCompareTwoNumbers( case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { - case TCL_NUMBER_LONG: case TCL_NUMBER_WIDE: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); -- cgit v0.12 From 9e2ed8b729812f2ab4c70025a0e71f255bec1a78 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 1 Nov 2017 12:35:40 +0000 Subject: Finally, get rid of tclWideIntType completely --- generic/tclAssembly.c | 2 +- generic/tclBasic.c | 2 +- generic/tclCmdMZ.c | 4 +-- generic/tclExecute.c | 68 +++++++++++++++++---------------------------------- generic/tclInt.h | 53 +++++---------------------------------- generic/tclObj.c | 67 +++++++++++++++----------------------------------- generic/tclStrToD.c | 4 +-- generic/tclTimer.c | 1 - generic/tclUtil.c | 4 +-- generic/tclZlib.c | 2 +- 10 files changed, 56 insertions(+), 151 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index c7ded6e..0fd7c60 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -4266,7 +4266,7 @@ AddBasicBlockRangeToErrorInfo( Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { - TclSetWideIntObj(lineNo, bbPtr->successor1->startLine); + TclSetWideObj(lineNo, bbPtr->successor1->startLine); Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f69e861..f84b420 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3651,7 +3651,7 @@ OldMathFuncProc( */ if (funcResult.type == TCL_INT) { - TclNewLongObj(valuePtr, funcResult.intValue); + TclNewWideObj(valuePtr, funcResult.intValue); } else if (funcResult.type == TCL_WIDE_INT) { valuePtr = Tcl_NewWideIntObj(funcResult.wideValue); } else { diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index c984bbe..8ab687f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1596,7 +1596,6 @@ StringIsCmd( /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || - (objPtr->typePtr == &tclWideIntType) || (objPtr->typePtr == &tclBignumType)) { break; } @@ -1631,7 +1630,6 @@ StringIsCmd( goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || - (objPtr->typePtr == &tclWideIntType) || (objPtr->typePtr == &tclBignumType)) { break; } @@ -4289,7 +4287,7 @@ TclNRTryObjCmd( } info[0] = objv[i]; /* type */ - TclNewLongObj(info[1], code); /* returnCode */ + TclNewWideObj(info[1], code); /* returnCode */ if (info[2] == NULL) { /* errorCodePrefix */ TclNewObj(info[2]); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 9eed936..51f9bff 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -325,7 +325,7 @@ VarHashCreateVar( NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ - TclNewLongObj(objResultPtr, -1); \ + TclNewWideObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -346,7 +346,7 @@ VarHashCreateVar( NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ - TclNewLongObj(objResultPtr, -1); \ + TclNewWideObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -357,7 +357,7 @@ VarHashCreateVar( #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ - TclNewLongObj(objResultPtr, -1); \ + TclNewWideObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -366,7 +366,7 @@ VarHashCreateVar( #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ - TclNewLongObj(objResultPtr, -1); \ + TclNewWideObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -498,7 +498,6 @@ VarHashCreateVar( * ClientData *ptrPtr, int *tPtr); */ -#ifdef TCL_WIDE_INT_IS_LONG #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_WIDE, \ @@ -513,26 +512,6 @@ VarHashCreateVar( (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ ? TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) -#else /* !TCL_WIDE_INT_IS_LONG */ -#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ - (((objPtr)->typePtr == &tclIntType) \ - ? (*(tPtr) = TCL_NUMBER_WIDE, \ - *(ptrPtr) = (ClientData) \ - (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ - ((objPtr)->typePtr == &tclWideIntType) \ - ? (*(tPtr) = TCL_NUMBER_WIDE, \ - *(ptrPtr) = (ClientData) \ - (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ - ((objPtr)->typePtr == &tclDoubleType) \ - ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ - ? (*(tPtr) = TCL_NUMBER_NAN) \ - : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ - *(ptrPtr) = (ClientData) \ - (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ - (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ - ? TCL_ERROR : \ - TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) -#endif /* TCL_WIDE_INT_IS_LONG */ /* * Macro used in this file to save a function call for common uses of @@ -873,9 +852,9 @@ TclCreateExecEnv( + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; - TclNewLongObj(eePtr->constants[0], 0); + TclNewWideObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); - TclNewLongObj(eePtr->constants[1], 1); + TclNewWideObj(eePtr->constants[1], 1); Tcl_IncrRefCount(eePtr->constants[1]); eePtr->interp = interp; eePtr->callbackPtr = NULL; @@ -3676,7 +3655,7 @@ TEBCresume( varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; - TclSetWideIntObj(objPtr, sum); + TclSetWideObj(objPtr, sum); } goto doneIncr; } @@ -3696,7 +3675,7 @@ TEBCresume( * use macro form that doesn't range test again. */ - TclSetWideIntObj(objPtr, w+increment); + TclSetWideObj(objPtr, w+increment); } goto doneIncr; } /* end if (type == TCL_NUMBER_WIDE) */ @@ -3709,7 +3688,7 @@ TEBCresume( } else { objResultPtr = objPtr; } - TclNewLongObj(incrPtr, increment); + TclNewWideObj(incrPtr, increment); if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { Tcl_DecrRefCount(incrPtr); TRACE_ERROR(interp); @@ -3723,7 +3702,7 @@ TEBCresume( * All other cases, flow through to generic handling. */ - TclNewLongObj(incrPtr, increment); + TclNewWideObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); doIncrScalar: @@ -4421,7 +4400,7 @@ TEBCresume( NEXT_INST_F(1, 0, 1); } case INST_INFO_LEVEL_NUM: - TclNewLongObj(objResultPtr, iPtr->varFramePtr->level); + TclNewWideObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { @@ -4790,7 +4769,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - TclNewLongObj(objResultPtr, length); + TclNewWideObj(objResultPtr, length); TRACE_APPEND(("%d\n", length)); NEXT_INST_F(1, 1, 1); @@ -5261,7 +5240,7 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); - TclNewLongObj(objResultPtr, length); + TclNewWideObj(objResultPtr, length); TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); @@ -5616,7 +5595,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewLongObj(objResultPtr, match); + TclNewWideObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: @@ -5624,7 +5603,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewLongObj(objResultPtr, match); + TclNewWideObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: @@ -5822,7 +5801,7 @@ TEBCresume( type1 = TCL_NUMBER_WIDE; } } - TclNewLongObj(objResultPtr, type1); + TclNewWideObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); NEXT_INST_F(1, 1, 1); @@ -6015,7 +5994,7 @@ TEBCresume( if (w1 > 0L) { objResultPtr = TCONST(0); } else { - TclNewLongObj(objResultPtr, -1); + TclNewWideObj(objResultPtr, -1); } TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -6326,7 +6305,7 @@ TEBCresume( TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } - TclSetWideIntObj(valuePtr, ~w1); + TclSetWideObj(valuePtr, ~w1); TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -6364,7 +6343,7 @@ TEBCresume( TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } - TclSetWideIntObj(valuePtr, -w1); + TclSetWideObj(valuePtr, -w1); TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -6525,10 +6504,10 @@ TEBCresume( oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { - TclNewLongObj(iterVarPtr->value.objPtr, -1); + TclNewWideObj(iterVarPtr->value.objPtr, -1); Tcl_IncrRefCount(iterVarPtr->value.objPtr); } else { - TclSetLongObj(oldValuePtr, -1); + TclSetWideObj(oldValuePtr, -1); } TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex)); @@ -6563,7 +6542,7 @@ TEBCresume( iterVarPtr = LOCAL(infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; iterNum = valuePtr->internalRep.wideValue + 1; - TclSetLongObj(valuePtr, iterNum); + TclSetWideObj(valuePtr, iterNum); /* * Check whether all value lists are exhausted and we should stop the @@ -6896,7 +6875,7 @@ TEBCresume( NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: - TclNewLongObj(objResultPtr, result); + TclNewWideObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); @@ -7562,7 +7541,6 @@ TEBCresume( default: Tcl_Panic("clockRead instruction with unknown clock#"); } - /* TclNewWideObj(objResultPtr, wval); doesn't exist */ objResultPtr = Tcl_NewWideIntObj(wval); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(2, 0, 1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 3799287..34e3e43 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2451,12 +2451,13 @@ typedef struct List { * WARNING: these macros eval their args more than once. */ -#define TclGetLongFromObj(interp, objPtr, longPtr) \ +#define TclGetLongFromObj(interp, objPtr, longPtr) Tcl_GetLongFromObj(interp, objPtr, longPtr) +#define TclGetLongFromObjX(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) -#if (LONG_MAX == INT_MAX) +#if 0 #define TclGetIntFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? ((*(intPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ @@ -2480,21 +2481,11 @@ typedef struct List { * Tcl_WideInt *wideIntPtr); */ -#ifdef TCL_WIDE_INT_IS_LONG #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(wideIntPtr) = (Tcl_WideInt) \ ((objPtr)->internalRep.wideValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#else /* !TCL_WIDE_INT_IS_LONG */ -#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - (((objPtr)->typePtr == &tclWideIntType) \ - ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ - ((objPtr)->typePtr == &tclIntType) \ - ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.wideValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#endif /* TCL_WIDE_INT_IS_LONG */ /* * Flag values for TclTraceDictPath(). @@ -2720,7 +2711,6 @@ MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; -MODULE_SCOPE const Tcl_ObjType tclWideIntType; MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; @@ -4533,13 +4523,12 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * core. They should only be called on unshared objects. The ANSI C * "prototypes" for these macros are: * - * MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue); - * MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); + * MODULE_SCOPE void TclSetWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d); *---------------------------------------------------------------- */ -#define TclSetLongObj(objPtr, i) \ +#define TclSetWideObj(objPtr, i) \ do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ @@ -4547,18 +4536,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; (objPtr)->typePtr = &tclIntType; \ } while (0) -#ifdef TCL_WIDE_INT_IS_LONG -#define TclSetWideIntObj(objPtr, w) TclSetLongObj(objPtr, w) -#else -#define TclSetWideIntObj(objPtr, w) \ - do { \ - TclInvalidateStringRep(objPtr); \ - TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclWideIntType; \ - } while (0) -#endif - #define TclSetDoubleObj(objPtr, d) \ do { \ TclInvalidateStringRep(objPtr); \ @@ -4573,7 +4550,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * - * MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l); * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len); @@ -4583,7 +4559,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #ifndef TCL_MEM_DEBUG -#define TclNewLongObj(objPtr, i) \ +#define TclNewWideObj(objPtr, i) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ @@ -4594,20 +4570,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) -#ifndef TCL_WIDE_INT_IS_LONG -#define TclNewWideObj(objPtr, i) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \ - (objPtr)->typePtr = &tclWideIntType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ - } while (0) -#else -#define TclNewWideObj(objPtr, i) TclNewLongObj(objPtr, i) -#endif #define TclNewDoubleObj(objPtr, d) \ do { \ TclIncrObjsAllocated(); \ @@ -4630,9 +4592,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; } while (0) #else /* TCL_MEM_DEBUG */ -#define TclNewLongObj(objPtr, l) \ - (objPtr) = Tcl_NewLongObj(l) - #define TclNewWideObj(objPtr, w) \ (objPtr) = Tcl_NewWideIntObj(w) diff --git a/generic/tclObj.c b/generic/tclObj.c index e4613ba..04fdeaa 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -266,13 +266,6 @@ const Tcl_ObjType tclIntType = { UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; -const Tcl_ObjType tclWideIntType = { - "wideInt", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfInt, /* updateStringProc */ - SetIntFromAny /* setFromAnyProc */ -}; const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ @@ -1753,7 +1746,7 @@ Tcl_NewBooleanObj( { register Tcl_Obj *objPtr; - TclNewLongObj(objPtr, boolValue!=0); + TclNewWideObj(objPtr, boolValue!=0); return objPtr; } #endif /* TCL_MEM_DEBUG */ @@ -1848,7 +1841,7 @@ Tcl_SetBooleanObj( Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } - TclSetLongObj(objPtr, boolValue!=0); + TclSetWideObj(objPtr, boolValue!=0); } #endif /* TCL_NO_DEPRECATED */ @@ -1907,10 +1900,6 @@ Tcl_GetBooleanFromObj( *boolPtr = 1; return TCL_OK; } - if (objPtr->typePtr == &tclWideIntType) { - *boolPtr = (objPtr->internalRep.wideValue != 0); - return TCL_OK; - } } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0))); return TCL_ERROR; @@ -1960,10 +1949,6 @@ TclSetBooleanFromAny( goto badBoolean; } - if (objPtr->typePtr == &tclWideIntType) { - goto badBoolean; - } - if (objPtr->typePtr == &tclDoubleType) { goto badBoolean; } @@ -2281,7 +2266,7 @@ Tcl_GetDoubleFromObj( return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - *dblPtr = objPtr->internalRep.wideValue; + *dblPtr = (double) objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { @@ -2291,10 +2276,6 @@ Tcl_GetDoubleFromObj( *dblPtr = TclBignumToDouble(&big); return TCL_OK; } - if (objPtr->typePtr == &tclWideIntType) { - *dblPtr = (double) objPtr->internalRep.wideValue; - return TCL_OK; - } } while (SetDoubleFromAny(interp, objPtr) == TCL_OK); return TCL_ERROR; } @@ -2412,7 +2393,7 @@ Tcl_NewIntObj( { register Tcl_Obj *objPtr; - TclNewLongObj(objPtr, intValue); + TclNewWideObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2445,7 +2426,7 @@ Tcl_SetIntObj( Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); } - TclSetLongObj(objPtr, intValue); + TclSetWideObj(objPtr, intValue); } /* @@ -2610,7 +2591,7 @@ Tcl_NewLongObj( { register Tcl_Obj *objPtr; - TclNewLongObj(objPtr, longValue); + TclNewWideObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2711,7 +2692,7 @@ Tcl_SetLongObj( Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); } - TclSetLongObj(objPtr, longValue); + TclSetWideObj(objPtr, longValue); } /* @@ -2742,11 +2723,13 @@ Tcl_GetLongFromObj( register long *longPtr) /* Place to store resulting long. */ { do { +#if (LONG_MAX == LLONG_MAX) if (objPtr->typePtr == &tclIntType) { *longPtr = objPtr->internalRep.wideValue; return TCL_OK; } - if (objPtr->typePtr == &tclWideIntType) { +#else + if (objPtr->typePtr == &tclIntType) { /* * We return any integer in the range -ULONG_MAX to ULONG_MAX * converted to a long, ignoring overflow. The rule preserves @@ -2764,6 +2747,7 @@ Tcl_GetLongFromObj( } goto tooLarge; } +#endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2802,7 +2786,9 @@ Tcl_GetLongFromObj( return TCL_OK; } } +#if (LONG_MAX != LLONG_MAX) tooLarge: +#endif if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_Obj *msg = Tcl_NewStringObj(s, -1); @@ -2966,12 +2952,7 @@ Tcl_SetWideIntObj( Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } - if ((wideValue >= (Tcl_WideInt) LONG_MIN) - && (wideValue <= (Tcl_WideInt) LONG_MAX)) { - TclSetLongObj(objPtr, wideValue); - } else { - TclSetWideIntObj(objPtr, wideValue); - } + TclSetWideObj(objPtr, wideValue); } /* @@ -3003,12 +2984,8 @@ Tcl_GetWideIntFromObj( /* Place to store resulting long. */ { do { - if (objPtr->typePtr == &tclWideIntType) { - *wideIntPtr = objPtr->internalRep.wideValue; - return TCL_OK; - } if (objPtr->typePtr == &tclIntType) { - *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.wideValue; + *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { @@ -3303,10 +3280,6 @@ GetBignumFromObj( return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - TclInitBignumFromLong(bignumValue, objPtr->internalRep.wideValue); - return TCL_OK; - } - if (objPtr->typePtr == &tclWideIntType) { TclInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; @@ -3435,9 +3408,9 @@ Tcl_SetBignumObj( goto tooLargeForLong; } if (bignumValue->sign) { - TclSetLongObj(objPtr, -(long)value); + TclSetWideObj(objPtr, -(long)value); } else { - TclSetLongObj(objPtr, (long)value); + TclSetWideObj(objPtr, (long)value); } mp_clear(bignumValue); return; @@ -3461,9 +3434,9 @@ Tcl_SetBignumObj( goto tooLargeForWide; } if (bignumValue->sign) { - TclSetWideIntObj(objPtr, -(Tcl_WideInt)value); + TclSetWideObj(objPtr, -(Tcl_WideInt)value); } else { - TclSetWideIntObj(objPtr, (Tcl_WideInt)value); + TclSetWideObj(objPtr, (Tcl_WideInt)value); } mp_clear(bignumValue); return; @@ -3550,7 +3523,7 @@ TclGetNumberFromObj( *clientDataPtr = &objPtr->internalRep.doubleValue; return TCL_OK; } - if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclWideIntType) { + if (objPtr->typePtr == &tclIntType) { *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index c8bc7b5..9663c21 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1272,7 +1272,7 @@ TclParseNumber( (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef TCL_WIDE_INT_IS_LONG if (octalSignificandWide <= (MOST_BITS + signum)) { - objPtr->typePtr = &tclWideIntType; + objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.wideValue = - (Tcl_WideInt) octalSignificandWide; @@ -1319,7 +1319,7 @@ TclParseNumber( (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef TCL_WIDE_INT_IS_LONG if (significandWide <= MOST_BITS+signum) { - objPtr->typePtr = &tclWideIntType; + objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.wideValue = - (Tcl_WideInt) significandWide; diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 279e110..54854d0 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -819,7 +819,6 @@ Tcl_AfterObjCmd( */ if (objv[1]->typePtr == &tclIntType - || objv[1]->typePtr == &tclWideIntType || objv[1]->typePtr == &tclBignumType || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK)) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 198424f..61a84ce 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3768,9 +3768,7 @@ SetEndOffsetFromAny( TCL_PARSE_INTEGER_ONLY) != TCL_OK) { return TCL_ERROR; } - if ((objPtr->typePtr != &tclIntType) - && (objPtr->typePtr != &tclWideIntType) - ) { + if (objPtr->typePtr != &tclIntType) { goto badIndexFormat; } offset = objPtr->internalRep.wideValue; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 33eebd1..dc124f7 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -373,7 +373,7 @@ ConvertErrorToList( default: TclNewLiteralStringObj(objv[2], "UNKNOWN"); - TclNewLongObj(objv[3], code); + TclNewWideObj(objv[3], code); return Tcl_NewListObj(4, objv); } } -- cgit v0.12 From 1a0c2e24ebd161899980a2a962a854e143d4ae1d Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 3 Nov 2017 17:11:13 +0000 Subject: Bump to 9.0a0 --- README | 2 +- generic/tcl.h | 10 +++++----- library/init.tcl | 2 +- macosx/Tcl-Common.xcconfig | 2 +- tools/tcl.hpj.in | 4 ++-- unix/configure | 26 +++++++++++++------------- unix/configure.ac | 10 +++++----- unix/tcl.spec | 2 +- win/README | 4 ++-- win/configure | 8 ++++---- win/configure.ac | 8 ++++---- 11 files changed, 39 insertions(+), 39 deletions(-) diff --git a/README b/README index 322666a..2a3b597 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.7a2 source distribution. + This is the Tcl 9.0a0 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tcl from the URL above. diff --git a/generic/tcl.h b/generic/tcl.h index 07d841d..007effb 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -52,13 +52,13 @@ extern "C" { * tools/tcl.hpj.in (not patchlevel, for windows installer) */ -#define TCL_MAJOR_VERSION 8 -#define TCL_MINOR_VERSION 7 +#define TCL_MAJOR_VERSION 9 +#define TCL_MINOR_VERSION 0 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 2 +#define TCL_RELEASE_SERIAL 0 -#define TCL_VERSION "8.7" -#define TCL_PATCH_LEVEL "8.7a2" +#define TCL_VERSION "9.0" +#define TCL_PATCH_LEVEL "9.0a0" #if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) /* diff --git a/library/init.tcl b/library/init.tcl index 87d9f14..4ef78a5 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.7a2 +package require -exact Tcl 9.0a0 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig index 77402b7..13b5df5 100644 --- a/macosx/Tcl-Common.xcconfig +++ b/macosx/Tcl-Common.xcconfig @@ -34,4 +34,4 @@ TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H -VERSION = 8.7 +VERSION = 9.0 diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 08d411d..a3d1a49 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl87.cnt +CNT=tcl90.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl87.hlp +HLP=tcl90.hlp [FILES] tcl.rtf diff --git a/unix/configure b/unix/configure index 129c283..6b9cedf 100755 --- a/unix/configure +++ b/unix/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for tcl 8.7. +# Generated by GNU Autoconf 2.69 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. @@ -577,8 +577,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.7' -PACKAGE_STRING='tcl 8.7' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1319,7 +1319,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +\`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1380,7 +1380,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.7:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -1494,7 +1494,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.7 +tcl configure 9.0 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1970,7 +1970,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.7, which was +It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -2322,10 +2322,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -10966,7 +10966,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tcl $as_me 8.7, which was +This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -11023,7 +11023,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -tcl config.status 8.7 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/unix/configure.ac b/unix/configure.ac index e14d85e..bd7a0e4 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -AC_INIT([tcl],[8.7]) +AC_INIT([tcl],[9.0]) AC_PREREQ(2.69) dnl This is only used when included from macosx/configure.ac @@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index 265e4df..0858ee7 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.7a2 +Version: 9.0a0 Release: 2 License: BSD Group: Development/Languages diff --git a/win/README b/win/README index 972923c..c8fdad6 100644 --- a/win/README +++ b/win/README @@ -1,4 +1,4 @@ -Tcl 8.7 for Windows +Tcl 9.0 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.7 Source Distribution (plus any patches) + Tcl 9.0 Source Distribution (plus any patches) and diff --git a/win/configure b/win/configure index fdd3adb..9554f3a 100755 --- a/win/configure +++ b/win/configure @@ -2099,10 +2099,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.ac b/win/configure.ac index d03695c..5804754 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -11,10 +11,10 @@ AC_PREREQ(2.69) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From 6fff25ecbcc670141c504a6dd0555d01204f761e Mon Sep 17 00:00:00 2001 From: "f.bonnet" Date: Sun, 5 Nov 2017 16:41:11 +0000 Subject: Fixed stupid Tcl_DecrRefCount bug in TclCleanupChildren with normally terminated processes. --- generic/tclPipe.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclPipe.c b/generic/tclPipe.c index bc760b6..13f4539 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -313,9 +313,9 @@ TclCleanupChildren( Tcl_SetObjErrorCode(interp, error); Tcl_SetObjResult(interp, msg); } + Tcl_DecrRefCount(error); + Tcl_DecrRefCount(msg); } - Tcl_DecrRefCount(error); - Tcl_DecrRefCount(msg); } /* -- cgit v0.12 From 9b30058284ab5a87d78cb96dcd63b95a7ada2393 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 6 Nov 2017 01:33:57 +0000 Subject: Rewrite documentation in comments for brevity and clarity. --- generic/tclListObj.c | 593 +++++++++++++++++++++++++-------------------------- generic/tclObj.c | 31 +-- generic/tclUtil.c | 37 ++-- 3 files changed, 325 insertions(+), 336 deletions(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 11374cc..f94433b 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -55,20 +55,22 @@ const Tcl_ObjType tclListType = { * * NewListIntRep -- * - * Creates a list internal rep with space for objc elements. objc - * must be > 0. If objv!=NULL, initializes with the first objc values - * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. Flag value "p" indicates + * Creates a 'List' structure with space for 'objc' elements. 'objc' must + * be > 0. If 'objv' is not NULL, The list is initialized with first + * 'objc' values in that array. Otherwise the list is initialized to have + * 0 elements, with space to add 'objc' more. Flag value 'p' indicates * how to behave on failure. * - * Results: - * A new List struct with refCount 0 is returned. If some failure - * prevents this then if p=0, NULL is returned and otherwise the - * routine panics. + * Value * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * A new 'List' structure with refCount 0. If some failure + * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic' + * is called if it is not. + * + * Effect + * + * The refCount of each value in 'objv' is incremented as it is added + * to the list. * *---------------------------------------------------------------------- */ @@ -132,22 +134,10 @@ NewListIntRep( /* *---------------------------------------------------------------------- * - * AttemptNewList -- - * - * Creates a list internal rep with space for objc elements. objc - * must be > 0. If objv!=NULL, initializes with the first objc values - * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. - * - * Results: - * A new List struct with refCount 0 is returned. If some failure - * prevents this then NULL is returned, and an error message is left - * in the interp result, unless interp is NULL. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * AttemptNewList -- * + * Like NewListIntRep, but additionally sets an error message on failure. + * *---------------------------------------------------------------------- */ @@ -179,23 +169,20 @@ AttemptNewList( * * Tcl_NewListObj -- * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new list object from an - * (objc,objv) array: that is, each of the objc elements of the array - * referenced by objv is inserted as an element into a new Tcl object. + * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is + * defined, 'Tcl_DbNewListObj' is called instead. * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewListObj. + * Value * - * Results: - * A new list object is returned that is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The resulting new list object has ref count 0. + * A new list 'Tcl_Obj' to which is appended values from 'objv', or if + * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no + * elements. The string representation of the new 'Tcl_Obj' is set to + * NULL. The refCount of the list is 0. * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * Effect + * + * The refCount of each elements in 'objv' is incremented as it is added + * to the list. * *---------------------------------------------------------------------- */ @@ -246,28 +233,14 @@ Tcl_NewListObj( /* *---------------------------------------------------------------------- * - * Tcl_DbNewListObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same - * as the Tcl_NewListObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. - * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewListObj. - * - * Results: - * A new list object is returned that is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The new list object has ref count 0. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * Tcl_DbNewListObj -- + * + * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the + * file name and line number from its caller. This simplifies debugging + * since the [memory active] command will report the correct file + * name and line number when reporting objects that haven't been freed. + * + * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead. * *---------------------------------------------------------------------- */ @@ -328,19 +301,8 @@ Tcl_DbNewListObj( * * Tcl_SetListObj -- * - * Modify an object to be a list containing each of the objc elements of - * the object array referenced by objv. - * - * Results: - * None. - * - * Side effects: - * The object is made a list object and is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The ref counts of the elements in objv are incremented since the - * list now refers to them. The object's old string and internal - * representations are freed and its type is set NULL. + * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of + * creating a new one. * *---------------------------------------------------------------------- */ @@ -384,18 +346,20 @@ Tcl_SetListObj( * * TclListObjCopy -- * - * Makes a "pure list" copy of a list value. This provides for the C - * level a counterpart of the [lrange $list 0 end] command, while using - * internals details to be as efficient as possible. + * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This + * provides for the C level a counterpart of the [lrange $list 0 end] + * command, while using internals details to be as efficient as possible. + * + * Value * - * Results: - * Normally returns a pointer to a new Tcl_Obj, that contains the same - * list value as *listPtr does. The returned Tcl_Obj has a refCount of - * zero. If *listPtr does not hold a list, NULL is returned, and if - * interp is non-NULL, an error message is recorded there. + * The address of the new 'Tcl_Obj' which shares its internal + * representation with 'listPtr', and whose refCount is 0. If 'listPtr' + * is not actually a list, the value is NULL, and an error message is left + * in 'interp' if it is not NULL. * - * Side effects: - * None. + * Effect + * + * 'listPtr' is converted to a list if it isn't one already. * *---------------------------------------------------------------------- */ @@ -425,27 +389,30 @@ TclListObjCopy( * * Tcl_ListObjGetElements -- * - * This function returns an (objc,objv) array of the elements in a list - * object. + * Retreive the elements in a list 'Tcl_Obj'. + * + * Value + * + * TCL_OK + * + * A count of list elements is stored, 'objcPtr', And a pointer to the + * array of elements in the list is stored in 'objvPtr'. * - * Results: - * The return value is normally TCL_OK; in this case *objcPtr is set to - * the count of list elements and *objvPtr is set to a pointer to an - * array of (*objcPtr) pointers to each list element. If listPtr does not - * refer to a list object and the object can not be converted to one, - * TCL_ERROR is returned and an error message will be left in the - * interpreter's result if interp is not NULL. + * The elements accessible via 'objvPtr' should be treated as readonly + * and the refCount for each object is _not_ incremented; the caller + * must do that if it holds on to a reference. Furthermore, the + * pointer and length returned by this function may change as soon as + * any function is called on the list object. Be careful about + * retaining the pointer in a local data structure. * - * The objects referenced by the returned array should be treated as - * readonly and their ref counts are _not_ incremented; the caller must - * do that if it holds on to a reference. Furthermore, the pointer and - * length returned by this function may change as soon as any function is - * called on the list object; be careful about retaining the pointer in a - * local data structure. + * TCL_ERROR * - * Side effects: - * The possible conversion of the object referenced by listPtr - * to a list object. + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * 'listPtr' is converted to a list object if it isn't one already. * *---------------------------------------------------------------------- */ @@ -486,20 +453,27 @@ Tcl_ListObjGetElements( * * Tcl_ListObjAppendList -- * - * This function appends the elements in the list value referenced by - * elemListPtr to the list value referenced by listPtr. + * Appends the elements of elemListPtr to those of listPtr. + * + * Value + * + * TCL_OK + * + * Success. * - * Results: - * The return value is normally TCL_OK. If listPtr or elemListPtr do not - * refer to list values, TCL_ERROR is returned and an error message is - * left in the interpreter's result if interp is not NULL. + * TCL_ERROR * - * Side effects: - * The reference counts of the elements in elemListPtr are incremented - * since the list now refers to them. listPtr and elemListPtr are - * converted, if necessary, to list objects. Also, appending the new - * elements may cause listObj's array of element pointers to grow. - * listPtr's old string representation, if any, is invalidated. + * 'listPtr' or 'elemListPtr' are not valid lists. An error + * message is left in the interpreter's result if 'interp' is not NULL. + * + * Effect + * + * The reference count of each element of 'elemListPtr' as it is added to + * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType' + * if they are not already. Appending the new elements may cause the + * array of element pointers in 'listObj' to grow. If any objects are + * appended to 'listPtr'. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -538,24 +512,27 @@ Tcl_ListObjAppendList( * * Tcl_ListObjAppendElement -- * - * This function is a special purpose version of Tcl_ListObjAppendList: - * it appends a single object referenced by objPtr to the list object - * referenced by listPtr. If listPtr is not already a list object, an - * attempt will be made to convert it to one. - * - * Results: - * The return value is normally TCL_OK; in this case objPtr is added to - * the end of listPtr's list. If listPtr does not refer to a list object - * and the object can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. - * - * Side effects: - * The ref count of objPtr is incremented since the list now refers to - * it. listPtr will be converted, if necessary, to a list object. Also, - * appending the new element may cause listObj's array of element - * pointers to grow. listPtr's old string representation, if any, is - * invalidated. + * Like 'Tcl_ListObjAppendList', but Appends a single value to a list. + * + * Value + * + * TCL_OK + * + * 'objPtr' is appended to the elements of 'listPtr'. + * + * TCL_ERROR + * + * listPtr does not refer to a list object and the object can not be + * converted to one. An error message will be left in the + * interpreter's result if interp is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. + * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'. + * Appending the new element may cause the the array of element pointers + * in 'listObj' to grow. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -706,23 +683,27 @@ Tcl_ListObjAppendElement( * * Tcl_ListObjIndex -- * - * This function returns a pointer to the index'th object from the list - * referenced by listPtr. The first element has index 0. If index is - * negative or greater than or equal to the number of elements in the - * list, a NULL is returned. If listPtr is not a list object, an attempt - * will be made to convert it to a list. + * Retrieve a pointer to the element of 'listPtr' at 'index'. The index + * of the first element is 0. + * + * Value + * + * TCL_OK * - * Results: - * The return value is normally TCL_OK; in this case objPtrPtr is set to - * the Tcl_Obj pointer for the index'th list element or NULL if index is - * out of range. This object should be treated as readonly and its ref - * count is _not_ incremented; the caller must do that if it holds on to - * the reference. If listPtr does not refer to a list and can't be - * converted to one, TCL_ERROR is returned and an error message is left - * in the interpreter's result if interp is not NULL. + * A pointer to the element at 'index' is stored in 'objPtrPtr'. If + * 'index' is out of range, NULL is stored in 'objPtrPtr'. This + * object should be treated as readonly and its 'refCount' is _not_ + * incremented. The caller must do that if it holds on to the + * reference. + * + * TCL_ERROR * - * Side effects: - * listPtr will be converted, if necessary, to a list object. + * 'listPtr' is not a valid list. An an error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. * *---------------------------------------------------------------------- */ @@ -764,19 +745,20 @@ Tcl_ListObjIndex( * * Tcl_ListObjLength -- * - * This function returns the number of elements in a list object. If the - * object is not already a list object, an attempt will be made to - * convert it to one. + * Retrieve the number of elements in a list. + * + * Value + * + * TCL_OK + * + * A count of list elements is stored at the address provided by + * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is + * converted. * - * Results: - * The return value is normally TCL_OK; in this case *intPtr will be set - * to the integer count of list elements. If listPtr does not refer to a - * list object and the object can not be converted to one, TCL_ERROR is - * returned and an error message will be left in the interpreter's result - * if interp is not NULL. + * TCL_ERROR * - * Side effects: - * The possible conversion of the argument object to a list object. + * 'listPtr' is not a valid list. An error message will be left in + * the interpreter's result if 'interp' is not NULL. * *---------------------------------------------------------------------- */ @@ -812,35 +794,36 @@ Tcl_ListObjLength( * * Tcl_ListObjReplace -- * - * This function replaces zero or more elements of the list referenced by - * listPtr with the objects from an (objc,objv) array. The objc elements - * of the array referenced by objv replace the count elements in listPtr - * starting at first. - * - * If the argument first is zero or negative, it refers to the first - * element. If first is greater than or equal to the number of elements - * in the list, then no elements are deleted; the new elements are - * appended to the list. Count gives the number of elements to replace. - * If count is zero or negative then no elements are deleted; the new - * elements are simply inserted before first. - * - * The argument objv refers to an array of objc pointers to the new - * elements to be added to listPtr in place of those that were deleted. - * If objv is NULL, no new elements are added. If listPtr is not a list - * object, an attempt will be made to convert it to one. - * - * Results: - * The return value is normally TCL_OK. If listPtr does not refer to a - * list object and can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. - * - * Side effects: - * The ref counts of the objc elements in objv are incremented since the - * resulting list now refers to them. Similarly, the ref counts for - * replaced objects are decremented. listPtr is converted, if necessary, - * to a list object. listPtr's old string representation, if any, is - * freed. + * Replace values in a list. + * + * If 'first' is zero or negative, it refers to the first element. If + * 'first' outside the range of elements in the list, no elements are + * deleted. + * + * If 'count' is zero or negative no elements are deleted, and any new + * elements are inserted at the beginning of the list. + * + * Value + * + * TCL_OK + * + * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr' + * starting at 'first'. If 'objc' 0, no new elements are added. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not of type 'tclListType', it is converted if possible. + * + * The 'refCount' of each element appended to the list is incremented. + * Similarly, the 'refCount' for each replaced element is decremented. + * + * If 'listPtr' is modified, any previous string representation is + * invalidated. * *---------------------------------------------------------------------- */ @@ -1098,22 +1081,19 @@ Tcl_ListObjReplace( * * TclLindexList -- * - * This procedure handles the 'lindex' command when objc==3. + * Implements the 'lindex' command when objc==3. * - * Results: - * Returns a pointer to the object extracted, or NULL if an error - * occurred. The returned object already includes one reference count for - * the pointer returned. + * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures + * the argument format into required form while taking care to manage + * shimmering so as to tend to keep the most useful intreps + * and/or avoid the most expensive conversions. * - * Side effects: - * None. + * Value * - * Notes: - * This procedure is implemented entirely as a wrapper around - * TclLindexFlat. All it does is reconfigure the argument format into the - * form required by TclLindexFlat, while taking care to manage shimmering - * in such a way that we tend to keep the most useful intreps and/or - * avoid the most expensive conversions. + * A pointer to the specified element, with its 'refCount' incremented, or + * NULL if an error occurred. + * + * Notes * *---------------------------------------------------------------------- */ @@ -1185,25 +1165,20 @@ TclLindexList( /* *---------------------------------------------------------------------- * - * TclLindexFlat -- + * TclLindexFlat -- + * + * The core of the 'lindex' command, with all index + * arguments presented as a flat list. * - * This procedure is the core of the 'lindex' command, with all index - * arguments presented as a flat list. + * Value * - * Results: - * Returns a pointer to the object extracted, or NULL if an error - * occurred. The returned object already includes one reference count for - * the pointer returned. + * A pointer to the object extracted, with its 'refCount' incremented, or + * NULL if an error occurred. Thus, the calling code will usually do + * something like: * - * Side effects: - * None. + * Tcl_SetObjResult(interp, result); + * Tcl_DecrRefCount(result); * - * Notes: - * The reference count of the returned object includes one reference - * corresponding to the pointer returned. Thus, the calling code will - * usually do something like: - * Tcl_SetObjResult(interp, result); - * Tcl_DecrRefCount(result); * *---------------------------------------------------------------------- */ @@ -1279,23 +1254,16 @@ TclLindexFlat( * * TclLsetList -- * - * Core of the 'lset' command when objc == 4. Objv[2] may be either a + * The core of [lset] when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * - * Results: - * Returns the new value of the list variable, or NULL if there was an - * error. The returned object includes one reference count for the - * pointer returned. + * Implemented entirely as a wrapper around 'TclLindexFlat', as described + * for 'TclLindexList'. * - * Side effects: - * None. + * Value * - * Notes: - * This procedure is implemented entirely as a wrapper around - * TclLsetFlat. All it does is reconfigure the argument format into the - * form required by TclLsetFlat, while taking care to manage shimmering - * in such a way that we tend to keep the most useful intreps and/or - * avoid the most expensive conversions. + * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if + * there was an error. * *---------------------------------------------------------------------- */ @@ -1357,36 +1325,39 @@ TclLsetList( * * Core engine of the 'lset' command. * - * Results: - * Returns the new value of the list variable, or NULL if an error - * occurred. The returned object includes one reference count for the - * pointer returned. - * - * Side effects: - * On entry, the reference count of the variable value does not reflect - * any references held on the stack. The first action of this function is - * to determine whether the object is shared, and to duplicate it if it - * is. The reference count of the duplicate is incremented. At this - * point, the reference count will be 1 for either case, so that the - * object will appear to be unshared. - * - * If an error occurs, and the object has been duplicated, the reference - * count on the duplicate is decremented so that it is now 0: this - * dismisses any memory that was allocated by this function. - * - * If no error occurs, the reference count of the original object is - * incremented if the object has not been duplicated, and nothing is done - * to a reference count of the duplicate. Now the reference count of an - * unduplicated object is 2 (the returned pointer, plus the one stored in - * the variable). The reference count of a duplicate object is 1, - * reflecting that the returned pointer is the only active reference. The - * caller is expected to store the returned value back in the variable - * and decrement its reference count. (INST_STORE_* does exactly this.) - * - * Surgery is performed on the unshared list value to produce the result. - * TclLsetFlat maintains a linked list of Tcl_Obj's whose string + * Value + * + * The resulting list + * + * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not + * duplicated, its 'refCount' is incremented. The reference count of + * an unduplicated object is therefore 2 (one for the returned pointer + * and one for the variable that holds it). The reference count of a + * duplicate object is 1, reflecting that result is the only active + * reference. The caller is expected to store the result in the + * variable and decrement its reference count. (INST_STORE_* does + * exactly this.) + * + * NULL + * + * An error occurred. If 'listPtr' was duplicated, the reference + * count on the duplicate is decremented so that it is 0, causing any + * memory allocated by this function to be freed. + * + * + * Effect + * + * On entry, the reference count of 'listPtr' does not reflect any + * references held on the stack. The first action of this function is to + * determine whether 'listPtr' is shared and to create a duplicate + * unshared copy if it is. The reference count of the duplicate is + * incremented. At this point, the reference count is 1 in either case so + * that the object is considered unshared. + * + * The unshared list is altered directly to produce the result. + * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string * representations must be spoilt by threading via 'ptr2' of the - * two-pointer internal representation. On entry to TclLsetFlat, the + * two-pointer internal representation. On entry to 'TclLsetFlat', the * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any * Tcl_Obj that has been modified is set to NULL. * @@ -1601,26 +1572,38 @@ TclLsetFlat( * * TclListObjSetElement -- * - * Set a single element of a list to a specified value + * Set a single element of a list to a specified value. * - * Results: - * The return value is normally TCL_OK. If listPtr does not refer to a - * list object and cannot be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter result if interp is - * not NULL. Similarly, if index designates an element outside the range - * [0..listLength-1], where listLength is the count of elements in the - * list object designated by listPtr, TCL_ERROR is returned and an error - * message is left in the interpreter result. + * It is the caller's responsibility to invalidate the string + * representation of the 'listPtr'. * - * Side effects: - * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts - * to convert it to a list with a non-shared internal rep. Decrements the - * ref count of the object at the specified index within the list, - * replaces with the object designated by valuePtr, and increments the - * ref count of the replacement object. + * Value + * + * TCL_OK + * + * Success. + * + * TCL_ERROR + * + * 'listPtr' does not refer to a list object and cannot be converted + * to one. An error message will be left in the interpreter result if + * interp is not NULL. + * + * TCL_ERROR + * + * An index designates an element outside the range [0..listLength-1], + * where 'listLength' is the count of elements in the list object + * designated by 'listPtr'. An error message is left in the + * interpreter result. + * + * Effect + * + * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If + * 'listPtr' is not already of type 'tclListType', it is converted and the + * internal representation is unshared. The 'refCount' of the element at + * 'index' is decremented and replaced in the list with the 'valuePtr', + * whose 'refCount' in turn is incremented. * - * It is the caller's responsibility to invalidate the string - * representation of the object. * *---------------------------------------------------------------------- */ @@ -1738,16 +1721,14 @@ TclListObjSetElement( * * FreeListInternalRep -- * - * Deallocate the storage associated with a list object's internal - * representation. + * Deallocate the storage associated with the internal representation of a + * a list object. * - * Results: - * None. + * Effect * - * Side effects: - * Frees listPtr's List* internal representation and sets listPtr's - * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all - * element objects, which may free them. + * The storage for the internal 'List' pointer of 'listPtr' is freed, the + * 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount' + * of each element of the list is decremented. * *---------------------------------------------------------------------- */ @@ -1776,14 +1757,12 @@ FreeListInternalRep( * * DupListInternalRep -- * - * Initialize the internal representation of a list Tcl_Obj to share the + * Initialize the internal representation of a list 'Tcl_Obj' to share the * internal representation of an existing list object. * - * Results: - * None. + * Effect * - * Side effects: - * The reference count of the List internal rep is incremented. + * The 'refCount' of the List internal rep is incremented. * *---------------------------------------------------------------------- */ @@ -1803,16 +1782,20 @@ DupListInternalRep( * * SetListFromAny -- * - * Attempt to generate a list internal form for the Tcl object "objPtr". + * Convert any object to a list. + * + * Value * - * Results: - * The return value is TCL_OK or TCL_ERROR. If an error occurs during - * conversion, an error message is left in the interpreter's result - * unless "interp" is NULL. + * TCL_OK + * + * Success. The internal representation of 'objPtr' is set, and the type + * of 'objPtr' is 'tclListType'. + * + * TCL_ERROR + * + * An error occured during conversion. An error message is left in the + * interpreter's result if 'interp' is not NULL. * - * Side effects: - * If no error occurs, a list is stored as "objPtr"s internal - * representation. * *---------------------------------------------------------------------- */ @@ -1937,18 +1920,16 @@ SetListFromAny( * * UpdateStringOfList -- * - * Update the string representation for a list object. Note: This - * function does not invalidate an existing old string rep so storage - * will be lost if this has not already been done. + * Update the string representation for a list object. + * + * Any previously-exising string representation is not invalidated, so + * storage is lost if this has not been taken care of. * - * Results: - * None. + * Effect * - * Side effects: - * The object's string is set to a valid string that results from the - * list-to-string conversion. This string will be empty if the list has - * no elements. The list internal representation should not be NULL and - * we assume it is not NULL. + * The string representation of 'listPtr' is set to the resulting string. + * This string will be empty if the list has no elements. It is assumed + * that the list internal representation is not NULL. * *---------------------------------------------------------------------- */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 1a00011..fdbc89a 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2468,23 +2468,26 @@ Tcl_SetIntObj( * * Tcl_GetIntFromObj -- * - * Attempt to return an int from the Tcl object "objPtr". If the object - * is not already an int, an attempt will be made to convert it to one. + * Retrieve the integer value of 'objPtr'. * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. + * Value * - * Results: - * The return value is a standard Tcl object result. If an error occurs - * during conversion or if the long integer held by the object can not be - * represented by an int, an error message is left in the interpreter's - * result unless "interp" is NULL. + * TCL_OK * - * Side effects: - * If the object is not already an int, the conversion will free any old - * internal representation. + * Success. + * + * TCL_ERROR + * + * An error occurred during conversion or the integral value can not + * be represented as an integer (it might be too large). An error + * message is left in the interpreter's result if 'interp' is not + * NULL. + * + * Effect + * + * 'objPtr' is converted to an integer if necessary if it is not one + * already. The conversion frees any previously-existing internal + * representation. * *---------------------------------------------------------------------- */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 411eabb..bfa4b2d 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3479,22 +3479,27 @@ TclFormatInt( * * TclGetIntForIndex -- * - * This function returns an integer corresponding to the list index held - * in a Tcl object. The Tcl object's value is expected to be in the - * format integer([+-]integer)? or the format end([+-]integer)?. - * - * Results: - * The return value is normally TCL_OK, which means that the index was - * successfully stored into the location referenced by "indexPtr". If the - * Tcl object referenced by "objPtr" has the value "end", the value - * stored is "endValue". If "objPtr"s values is not of one of the - * expected formats, TCL_ERROR is returned and, if "interp" is non-NULL, - * an error message is left in the interpreter's result object. - * - * Side effects: - * The object referenced by "objPtr" might be converted to an integer, - * wide integer, or end-based-index object. - * + * Provides an integer corresponding to the list index held in a Tcl + * object. The string value 'objPtr' is expected have the format + * integer([+-]integer)? or end([+-]integer)?. + * + * Value + * TCL_OK + * + * The index is stored at the address given by by 'indexPtr'. If + * 'objPtr' has the value "end", the value stored is 'endValue'. + * + * TCL_ERROR + * + * The value of 'objPtr' does not have one of the expected formats. If + * 'interp' is non-NULL, an error message is left in the interpreter's + * result object. + * + * Effect + * + * The object referenced by 'objPtr' is converted, as needed, to an + * integer, wide integer, or end-based-index object. + * *---------------------------------------------------------------------- */ -- cgit v0.12 From 27e8f4db3d5d3fa5840fc71f3cf231238ff2863b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 6 Nov 2017 14:50:08 +0000 Subject: More tcl8 -> tcl9 renumbering, for example related to the installation of Tcl packages where tcl9 actually can find them. --- library/safe.tcl | 2 +- tools/README | 2 +- tools/checkLibraryDoc.tcl | 4 ++-- unix/Makefile.in | 14 +++++++------- win/Makefile.in | 14 +++++++------- win/README | 4 ++-- win/makefile.vc | 26 +++++++++++--------------- win/tcl.hpj.in | 4 ++-- 8 files changed, 33 insertions(+), 37 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index ea6391d..c48d002 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -113,7 +113,7 @@ proc ::safe::CheckInterp {slave} { # we had the bad idea to support for the sake of user simplicity in # create/init but which makes life hard in configure... # So this will be hopefully written and some integrated with opt1.0 -# (hopefully for tcl8.1 ?) +# (hopefully for tcl9.0 ?) proc ::safe::interpConfigure {args} { switch [llength $args] { 1 { diff --git a/tools/README b/tools/README index f4bf627..87a9af4 100644 --- a/tools/README +++ b/tools/README @@ -12,7 +12,7 @@ Generating HTML files. The tcl-tk-man-html.tcl script from Robert Critchlow generates a nice set of HTML with good cross references. Use it like - tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2 + tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0 This script is very picky about the organization of man pages, effectively acting as a style enforcer. diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index 6d147ac..a220ea8 100755 --- a/tools/checkLibraryDoc.tcl +++ b/tools/checkLibraryDoc.tcl @@ -3,7 +3,7 @@ # This script attempts to determine what APIs exist in the source base that # have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list -# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch]) +# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch]) # we create six lists: # 1) APIs in Source not in Docs. # 2) APIs in Docs not in Source. @@ -106,7 +106,7 @@ proc main {} { if {($len != 2) && ($len != 3)} { puts "usage: $argv0 pkgName pkgDir \[outFile\]" puts " pkgName == Tcl,Tk" - puts " pkgDir == /home/surles/cvs/tcl8.2" + puts " pkgDir == /home/surles/cvs/tcl9.0" exit 1 } diff --git a/unix/Makefile.in b/unix/Makefile.in index 032b5ac..4e2ddc8 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -829,7 +829,7 @@ install-libraries: libraries else true; \ fi; \ done; - @for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ + @for i in opt0.4 http1.0 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \ do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -849,21 +849,21 @@ install-libraries: libraries $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; @echo "Installing package http 2.8.12 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.12.tm; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/http-2.8.12.tm; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm; + @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/msgcat-1.6.1.tm; @echo "Installing package tcltest 2.4.1 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/tcltest-2.4.1.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm; + @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm; + @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform/shell-1.1.4.tm; @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"; @for i in $(TOP_DIR)/library/encoding/*.enc ; do \ @@ -2097,7 +2097,7 @@ alldist: dist #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # # Note that for platforms where this is important, it is more common to use a diff --git a/win/Makefile.in b/win/Makefile.in index a3275ba..e8b0ff6 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -630,7 +630,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ + @for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -658,20 +658,20 @@ install-libraries: libraries install-tzdata install-msgs $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; @echo "Installing package http 2.8.12 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.12.tm; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.8.12.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.6.1.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm; + @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform/shell-1.1.4.tm; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ @@ -858,7 +858,7 @@ genstubs: # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # diff --git a/win/README b/win/README index c8fdad6..022dc11 100644 --- a/win/README +++ b/win/README @@ -79,9 +79,9 @@ Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh87.exe, you must ensure that tcl87.dll is +Note that in order to run tclsh90.exe, you must ensure that tcl90.dll is on your path, in the system directory, or in the directory containing -tclsh87.exe. +tclsh90.exe. Note: Tcl no longer provides support for Win32s. diff --git a/win/makefile.vc b/win/makefile.vc index 2bff871..ceedc10 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1116,16 +1116,12 @@ install-binaries: install-libraries: tclConfig install-msgs install-tzdata @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform" @echo Installing header files @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @@ -1157,19 +1153,19 @@ install-libraries: tclConfig install-msgs install-tzdata "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm" + "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm" + "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\msgcat-$(PKG_MSGCAT_VER).tm" @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm" + "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm" + "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform-$(PKG_PLATFORM_VER).tm" @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm" + "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform\shell-$(PKG_SHELL_VER).tm" @echo Installing $(TCLDDELIBNAME) !if $(STATIC_BUILD) !if !$(TCL_USE_STATIC_PACKAGES) diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in index a94cea6..a3d1a49 100644 --- a/win/tcl.hpj.in +++ b/win/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl86.cnt +CNT=tcl90.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl86.hlp +HLP=tcl90.hlp [FILES] tcl.rtf -- cgit v0.12 From 48b529209c87473364215e8aef740e331f88415a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 Nov 2017 12:15:30 +0000 Subject: Somewhat simplified implementation of TIP #389, in which the "string length" if characters > U+FFFF is considered to be 2, not 1. --- doc/StringObj.3 | 2 +- doc/ToUpper.3 | 2 +- doc/Utf.3 | 2 +- generic/tcl.decls | 10 +++--- generic/tcl.h | 2 +- generic/tclCmdMZ.c | 18 ++++++++-- generic/tclDecls.h | 20 +++++------ generic/tclScan.c | 12 +++++-- generic/tclStringObj.c | 12 +++---- generic/tclUtf.c | 95 +++++++++++++++++++++++++++++++++++--------------- tests/string.test | 26 +++++++------- tests/utf.test | 4 +-- 12 files changed, 132 insertions(+), 73 deletions(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 7042cc8..8d9bb56 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -37,7 +37,7 @@ Tcl_UniChar * Tcl_UniChar * \fBTcl_GetUnicode\fR(\fIobjPtr\fR) .sp -Tcl_UniChar +int \fBTcl_GetUniChar\fR(\fIobjPtr, index\fR) .sp int diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index b933e9c..14766da 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -13,7 +13,7 @@ Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_ .nf \fB#include \fR .sp -Tcl_UniChar +int \fBTcl_UniCharToUpper\fR(\fIch\fR) .sp Tcl_UniChar diff --git a/doc/Utf.3 b/doc/Utf.3 index 378c806..5cd6b7df 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -63,7 +63,7 @@ const char * const char * \fBTcl_UtfPrev\fR(\fIsrc, start\fR) .sp -Tcl_UniChar +int \fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR) .sp const char * diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..e3ea9bc 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1148,16 +1148,16 @@ declare 319 { Tcl_QueuePosition position) } declare 320 { - Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index) + int Tcl_UniCharAtIndex(const char *src, int index) } declare 321 { - Tcl_UniChar Tcl_UniCharToLower(int ch) + int Tcl_UniCharToLower(int ch) } declare 322 { - Tcl_UniChar Tcl_UniCharToTitle(int ch) + int Tcl_UniCharToTitle(int ch) } declare 323 { - Tcl_UniChar Tcl_UniCharToUpper(int ch) + int Tcl_UniCharToUpper(int ch) } declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) @@ -1351,7 +1351,7 @@ declare 380 { int Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { - Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index) + int Tcl_GetUniChar(Tcl_Obj *objPtr, int index) } declare 382 { Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) diff --git a/generic/tcl.h b/generic/tcl.h index 07d841d..f874997 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2201,7 +2201,7 @@ typedef struct Tcl_EncodingType { */ #ifndef TCL_UTF_MAX -#define TCL_UTF_MAX 3 +#define TCL_UTF_MAX 4 #endif /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 2195aa1..b6a8fe9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -309,7 +309,7 @@ Tcl_RegexpObjCmd( eflags = 0; } else if (offset > stringLength) { eflags = TCL_REG_NOTBOL; - } else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') { + } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; @@ -1218,6 +1218,12 @@ Tcl_SplitObjCmd( for ( ; stringPtr < end; stringPtr += len) { len = TclUtfToUniChar(stringPtr, &ch); +#if TCL_UTF_MAX == 4 + if (!len) { + continue; + } +#endif + /* * Assume Tcl_UniChar is an integral type... */ @@ -1814,8 +1820,16 @@ StringIsCmd( } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { + int fullchar; length2 = TclUtfToUniChar(string1, &ch); - if (!chcomp(ch)) { + fullchar = ch; +#if TCL_UTF_MAX == 4 + if (!length2) { + length2 = TclUtfToUniChar(string1, &ch); + fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } +#endif + if (!chcomp(fullchar)) { result = 0; break; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..5f83636 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -959,13 +959,13 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); +EXTERN int Tcl_UniCharAtIndex(const char *src, int index); /* 321 */ -EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch); +EXTERN int Tcl_UniCharToLower(int ch); /* 322 */ -EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch); +EXTERN int Tcl_UniCharToTitle(int ch); /* 323 */ -EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); +EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ @@ -1117,7 +1117,7 @@ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, /* 380 */ EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index); +EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index); /* 382 */ EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ @@ -2186,10 +2186,10 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ - Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ - Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */ - Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ - Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ + int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ + int (*tcl_UniCharToLower) (int ch); /* 321 */ + int (*tcl_UniCharToTitle) (int ch); /* 322 */ + int (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ @@ -2247,7 +2247,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ - Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ diff --git a/generic/tclScan.c b/generic/tclScan.c index e1fcad4..7f71262 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -885,9 +885,17 @@ Tcl_ScanObjCmd( * Scan a single Unicode character. */ - string += TclUtfToUniChar(string, &sch); + offset = TclUtfToUniChar(string, &sch); + i = (int)sch; +#if TCL_UTF_MAX == 4 + if (!offset) { + offset = Tcl_UtfToUniChar(string, &sch); + i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); + } +#endif + string += offset; if (!(flags & SCAN_SUPPRESS)) { - objPtr = Tcl_NewIntObj((int)sch); + objPtr = Tcl_NewIntObj(i); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 3a35bcf..1ccd778 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -466,7 +466,7 @@ Tcl_GetCharLength( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ @@ -483,7 +483,7 @@ Tcl_GetUniChar( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); - return (Tcl_UniChar) bytes[index]; + return (int) bytes[index]; } /* @@ -507,7 +507,7 @@ Tcl_GetUniChar( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - return stringPtr->unicode[index]; + return (int) stringPtr->unicode[index]; } /* @@ -3462,7 +3462,6 @@ TclStringObjReverse( * Tcl_SetObjLength into growing the unicode rep buffer. */ - ch = 0; objPtr = Tcl_NewUnicodeObj(&ch, 1); Tcl_SetObjLength(objPtr, stringPtr->numChars); to = Tcl_GetUnicode(objPtr); @@ -3565,7 +3564,7 @@ ExtendUnicodeRepWithString( { String *stringPtr = GET_STRING(objPtr); int needed, numOrigChars = 0; - Tcl_UniChar *dst; + Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; @@ -3588,7 +3587,8 @@ ExtendUnicodeRepWithString( numAppendChars = 0; } for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { - bytes += TclUtfToUniChar(bytes, dst); + bytes += TclUtfToUniChar(bytes, &unichar); + *dst = unichar; } *dst = 0; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 25cc2d1..859fe78 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -699,7 +699,7 @@ Tcl_UtfPrev( *--------------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharAtIndex( register const char *src, /* The UTF-8 string to dereference. */ register int index) /* The position of the desired character. */ @@ -819,7 +819,8 @@ int Tcl_UtfToUpper( char *str) /* String to convert in place. */ { - Tcl_UniChar ch = 0, upChar; + Tcl_UniChar ch = 0; + int upChar; char *src, *dst; int bytes; @@ -830,7 +831,14 @@ Tcl_UtfToUpper( src = dst = str; while (*src) { bytes = TclUtfToUniChar(src, &ch); - upChar = Tcl_UniCharToUpper(ch); + upChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + upChar = Tcl_UniCharToUpper(upChar); /* * To keep badly formed Utf strings from getting inflated by the @@ -872,7 +880,8 @@ int Tcl_UtfToLower( char *str) /* String to convert in place. */ { - Tcl_UniChar ch = 0, lowChar; + Tcl_UniChar ch = 0; + int lowChar; char *src, *dst; int bytes; @@ -883,7 +892,14 @@ Tcl_UtfToLower( src = dst = str; while (*src) { bytes = TclUtfToUniChar(src, &ch); - lowChar = Tcl_UniCharToLower(ch); + lowChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + lowChar = Tcl_UniCharToLower(lowChar); /* * To keep badly formed Utf strings from getting inflated by the @@ -926,7 +942,8 @@ int Tcl_UtfToTitle( char *str) /* String to convert in place. */ { - Tcl_UniChar ch = 0, titleChar, lowChar; + Tcl_UniChar ch = 0; + int titleChar, lowChar; char *src, *dst; int bytes; @@ -939,7 +956,14 @@ Tcl_UtfToTitle( if (*src) { bytes = TclUtfToUniChar(src, &ch); - titleChar = Tcl_UniCharToTitle(ch); + titleChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + titleChar = Tcl_UniCharToTitle(titleChar); if (bytes < TclUtfCount(titleChar)) { memcpy(dst, src, (size_t) bytes); @@ -951,7 +975,14 @@ Tcl_UtfToTitle( } while (*src) { bytes = TclUtfToUniChar(src, &ch); - lowChar = Tcl_UniCharToLower(ch); + lowChar = ch; + if (!bytes) { + /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */ + bytes = TclUtfToUniChar(src, &ch); + /* Combine surrogates */ + lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } + lowChar = Tcl_UniCharToLower(lowChar); if (bytes < TclUtfCount(lowChar)) { memcpy(dst, src, (size_t) bytes); @@ -1159,16 +1190,18 @@ TclUtfCasecmp( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharToUpper( int ch) /* Unicode character to convert. */ { - int info = GetUniCharInfo(ch); + if (!UNICODE_OUT_OF_RANGE(ch)) { + int info = GetUniCharInfo(ch); - if (GetCaseType(info) & 0x04) { - ch -= GetDelta(info); + if (GetCaseType(info) & 0x04) { + ch -= GetDelta(info); + } } - return (Tcl_UniChar) ch; + return ch & 0x1FFFFF; } /* @@ -1187,16 +1220,18 @@ Tcl_UniCharToUpper( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharToLower( int ch) /* Unicode character to convert. */ { - int info = GetUniCharInfo(ch); + if (!UNICODE_OUT_OF_RANGE(ch)) { + int info = GetUniCharInfo(ch); - if (GetCaseType(info) & 0x02) { - ch += GetDelta(info); + if (GetCaseType(info) & 0x02) { + ch += GetDelta(info); + } } - return (Tcl_UniChar) ch; + return ch & 0x1FFFFF; } /* @@ -1215,23 +1250,25 @@ Tcl_UniCharToLower( *---------------------------------------------------------------------- */ -Tcl_UniChar +int Tcl_UniCharToTitle( int ch) /* Unicode character to convert. */ { - int info = GetUniCharInfo(ch); - int mode = GetCaseType(info); + if (!UNICODE_OUT_OF_RANGE(ch)) { + int info = GetUniCharInfo(ch); + int mode = GetCaseType(info); - if (mode & 0x1) { - /* - * Subtract or add one depending on the original case. - */ + if (mode & 0x1) { + /* + * Subtract or add one depending on the original case. + */ - ch += ((mode & 0x4) ? -1 : 1); - } else if (mode == 0x4) { - ch -= GetDelta(info); + ch += ((mode & 0x4) ? -1 : 1); + } else if (mode == 0x4) { + ch -= GetDelta(info); + } } - return (Tcl_UniChar) ch; + return ch & 0x1FFFFF; } /* diff --git a/tests/string.test b/tests/string.test index cb901b9..cebaf4c 100644 --- a/tests/string.test +++ b/tests/string.test @@ -1697,40 +1697,40 @@ test string-24.4 {string reverse command - unshared string} { string reverse $x$y } edcba test string-24.5 {string reverse command - shared unicode string} { - set x abcde\udead + set x abcde\ud0ad string reverse $x -} \udeadedcba +} \ud0adedcba test string-24.6 {string reverse command - unshared string} { set x abc - set y de\udead + set y de\ud0ad string reverse $x$y -} \udeadedcba +} \ud0adedcba test string-24.7 {string reverse command - simple case} { string reverse a } a test string-24.8 {string reverse command - simple case} { - string reverse \udead -} \udead + string reverse \ud0ad +} \ud0ad test string-24.9 {string reverse command - simple case} { string reverse {} } {} test string-24.10 {string reverse command - corner case} { - set x \ubeef\udead + set x \ubeef\ud0ad string reverse $x -} \udead\ubeef +} \ud0ad\ubeef test string-24.11 {string reverse command - corner case} { set x \ubeef - set y \udead + set y \ud0ad string reverse $x$y -} \udead\ubeef +} \ud0ad\ubeef test string-24.12 {string reverse command - corner case} { set x \ubeef - set y \udead + set y \ud0ad string is ascii [string reverse $x$y] } 0 test string-24.13 {string reverse command - pure Unicode string} { - string reverse [string range \ubeef\udead\ubeef\udead\ubeef\udead 1 5] -} \udead\ubeef\udead\ubeef\udead + string reverse [string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5] +} \ud0ad\ubeef\ud0ad\ubeef\ud0ad test string-24.14 {string reverse command - pure bytearray} { binary scan [string reverse [binary format H* 010203]] H* x set x diff --git a/tests/utf.test b/tests/utf.test index 422ab08..45f9c0c 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -68,10 +68,10 @@ test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestrin } {1} test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body { string length [testbytestring "\xF0\x90\x80\x80"] -} -result {1} +} -result {2} test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body { string length [testbytestring "\xF4\x8F\xBF\xBF"] -} -result {1} +} -result {2} test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring { string length [testbytestring "\xF0\x8F\xBF\xBF"] } {4} -- cgit v0.12 From 42764c99bec23aaae227ff1aba60c1ff9e7d9230 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 Nov 2017 16:16:52 +0000 Subject: More code simplifications, with still equal functionality. --- generic/tclExecute.c | 6 ++---- generic/tclObj.c | 33 +++------------------------------ generic/tclStrToD.c | 40 ++++++---------------------------------- 3 files changed, 11 insertions(+), 68 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 51f9bff..68056c6 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5776,7 +5776,7 @@ TEBCresume( { ClientData ptr1, ptr2; int type1, type2; - Tcl_WideInt w1, w2, wResult; + Tcl_WideInt w1, w2, wResult; case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { @@ -5787,9 +5787,7 @@ TEBCresume( /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ int i; - if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { - type1 = TCL_NUMBER_WIDE; - } else { + if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { type1 = TCL_NUMBER_LONG; } } else if (type1 == TCL_NUMBER_BIG) { diff --git a/generic/tclObj.c b/generic/tclObj.c index 04fdeaa..634f8db 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3393,38 +3393,12 @@ Tcl_SetBignumObj( Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if ((size_t) bignumValue->used - <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) { - unsigned long value = 0, numBytes = sizeof(long); - long scratch; + <= (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) { + Tcl_WideUInt value = 0, numBytes = sizeof(Tcl_WideUInt); + Tcl_WideUInt scratch; unsigned char *bytes = (unsigned char *) &scratch; if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) { - goto tooLargeForLong; - } - while (numBytes-- > 0) { - value = (value << CHAR_BIT) | *bytes++; - } - if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) { - goto tooLargeForLong; - } - if (bignumValue->sign) { - TclSetWideObj(objPtr, -(long)value); - } else { - TclSetWideObj(objPtr, (long)value); - } - mp_clear(bignumValue); - return; - } - tooLargeForLong: -#ifndef TCL_WIDE_INT_IS_LONG - if ((size_t) bignumValue->used - <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) { - Tcl_WideUInt value = 0; - unsigned long numBytes = sizeof(Tcl_WideInt); - Tcl_WideInt scratch; - unsigned char *bytes = (unsigned char *)&scratch; - - if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) { goto tooLargeForWide; } while (numBytes-- > 0) { @@ -3442,7 +3416,6 @@ Tcl_SetBignumObj( return; } tooLargeForWide: -#endif TclInvalidateStringRep(objPtr); TclFreeIntRep(objPtr); TclSetBignumIntRep(objPtr, bignumValue); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 9663c21..ac2ca68 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1268,21 +1268,7 @@ TclParseNumber( } } if (!octalSignificandOverflow) { - if (octalSignificandWide > - (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { -#ifndef TCL_WIDE_INT_IS_LONG - if (octalSignificandWide <= (MOST_BITS + signum)) { - objPtr->typePtr = &tclIntType; - if (signum) { - objPtr->internalRep.wideValue = - - (Tcl_WideInt) octalSignificandWide; - } else { - objPtr->internalRep.wideValue = - (Tcl_WideInt) octalSignificandWide; - } - break; - } -#endif + if (octalSignificandWide > (MOST_BITS + signum)) { TclInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); octalSignificandOverflow = 1; @@ -1290,10 +1276,10 @@ TclParseNumber( objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.wideValue = - - (long) octalSignificandWide; + - (Tcl_WideInt) octalSignificandWide; } else { objPtr->internalRep.wideValue = - (long) octalSignificandWide; + (Tcl_WideInt) octalSignificandWide; } } } @@ -1315,21 +1301,7 @@ TclParseNumber( } returnInteger: if (!significandOverflow) { - if (significandWide > - (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { -#ifndef TCL_WIDE_INT_IS_LONG - if (significandWide <= MOST_BITS+signum) { - objPtr->typePtr = &tclIntType; - if (signum) { - objPtr->internalRep.wideValue = - - (Tcl_WideInt) significandWide; - } else { - objPtr->internalRep.wideValue = - (Tcl_WideInt) significandWide; - } - break; - } -#endif + if (significandWide > MOST_BITS+signum) { TclInitBignumFromWideUInt(&significandBig, significandWide); significandOverflow = 1; @@ -1337,10 +1309,10 @@ TclParseNumber( objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.wideValue = - - (long) significandWide; + - (Tcl_WideInt) significandWide; } else { objPtr->internalRep.wideValue = - (long) significandWide; + (Tcl_WideInt) significandWide; } } } -- cgit v0.12 From 338e92cb28bb8cc4d6dac152cf24593323d293bb Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 7 Nov 2017 18:45:24 +0000 Subject: Updated the zipfs portion of the testsuite to tip430 standards --- tests/zipfs.test | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index adacbde..2aea3bf 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -17,9 +17,10 @@ if {"::tcltest" ni [namespace children]} { testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}] -test zipfs-1.1 {zipfs basics} -constraints zipfs -body { - load {} zipfs -} -result {} +# Removed in tip430 - zipfs is no longer a static package +#test zipfs-1.1 {zipfs basics} -constraints zipfs -body { +# load {} zipfs +#} -result {} test zipfs-1.2 {zipfs basics} -constraints zipfs -body { package require zipfs @@ -66,18 +67,18 @@ test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { set pwd [pwd] cd $tcl_library/encoding zipfs mkzip abc.zip . - zipfs mount abc.zip /abc - zipfs list -glob /abc/cp850.* + zipfs mount abc.zip zipfs:/abc + zipfs list -glob zipfs:/abc/cp850.* } -cleanup { cd $pwd -} -result {/abc/cp850.enc} +} -result {zipfs:/abc/cp850.enc} test zipfs-2.3 {zipfs unmount} -constraints zipfs -body { - zipfs info /abc/cp850.enc + zipfs info zipfs:/abc/cp850.enc } -result [list $tcl_library/encoding/abc.zip 1090 527 39434] test zipfs-2.4 {zipfs unmount} -constraints zipfs -body { - set f [open /abc/cp850.enc] + set f [open zipfs:/abc/cp850.enc] read $f } -result {# Encoding file: cp850, single-byte S -- cgit v0.12 From 399ff79e21dd4d6374ddc5d825a8a35912a3eaa0 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 7 Nov 2017 19:13:34 +0000 Subject: Adding a [file normalize] to zipfs tests that are looking for absolute filenames. On Linux symlinks can cause a discrepency in what the tests think they are looking for. --- tests/zipfs.test | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 2aea3bf..89d35ad 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -58,14 +58,15 @@ test zipfs-1.10 {zipfs basics} -constraints zipfs -returnCodes error -body { zipfs list a b c d e f } -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"} +set ntcl_library [file normalize $tcl_library] test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body { - zipfs mkzip abc.zip $tcl_library/xxxx + zipfs mkzip abc.zip $ntcl_library/xxxx } -result {empty archive} test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { set pwd [pwd] - cd $tcl_library/encoding + cd $ntcl_library/encoding zipfs mkzip abc.zip . zipfs mount abc.zip zipfs:/abc zipfs list -glob zipfs:/abc/cp850.* @@ -75,7 +76,7 @@ test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { test zipfs-2.3 {zipfs unmount} -constraints zipfs -body { zipfs info zipfs:/abc/cp850.enc -} -result [list $tcl_library/encoding/abc.zip 1090 527 39434] +} -result [list $ntcl_library/encoding/abc.zip 1090 527 39434] test zipfs-2.4 {zipfs unmount} -constraints zipfs -body { set f [open zipfs:/abc/cp850.enc] -- cgit v0.12 From 23440fcbd7900cac63198c161e871dd19ae36d10 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 7 Nov 2017 19:26:21 +0000 Subject: Removing patches for Androwish that are not needed for tip430 --- generic/tclIOUtil.c | 34 ---------------------------------- 1 file changed, 34 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bb6a7ca..2c389c6 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -190,8 +190,6 @@ const Tcl_Filesystem tclNativeFilesystem = { TclpObjChdir }; -MODULE_SCOPE Tcl_Filesystem zipfsFilesystem; - /* * Define the tail of the linked list. Note that for unconventional uses of * Tcl without a native filesystem, we may in the future wish to modify the @@ -1414,22 +1412,6 @@ TclFSNormalizeToUniquePath( Claim(); for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { - if (fsRecPtr->fsPtr == &zipfsFilesystem) { - ClientData clientData = NULL; - /* - * Allow mounted zipfs filesystem to overtake entire normalisation. - * This is needed on unix for mounts on symlinks right below root. - */ - - if (fsRecPtr->fsPtr->pathInFilesystemProc != NULL) { - if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, - &clientData)!=-1) { - TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); - break; - } - } - continue; - } if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; } @@ -1454,9 +1436,6 @@ TclFSNormalizeToUniquePath( if (fsRecPtr->fsPtr == &tclNativeFilesystem) { continue; } - if (fsRecPtr->fsPtr == &zipfsFilesystem) { - continue; - } if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, @@ -2939,19 +2918,6 @@ Tcl_FSChdir( } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); - - if ((fsPtr != NULL) && (fsPtr != &tclNativeFilesystem)) { - /* - * Watch out for tilde substitution. - * Only valid in native filesystem. - */ - char *name = Tcl_GetString(pathPtr); - - if ((name != NULL) && (*name == '~')) { - fsPtr = &tclNativeFilesystem; - } - } - if (fsPtr != NULL) { if (fsPtr->chdirProc != NULL) { /* -- cgit v0.12 From c2dfae075806fd3b5117755f85ba3e8a3a6c2170 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 7 Nov 2017 19:51:53 +0000 Subject: Removing kit building facilities. They aren't part of the tip430 spec --- library/practcl/pkgIndex.tcl | 11 - library/practcl/practcl.tcl | 4014 --------------------------------------- library/zvfstools/pkgIndex.tcl | 1 - library/zvfstools/zvfstools.tcl | 325 ---- pkgs/make.tcl | 165 -- pkgs/packages.tcl | 92 - 6 files changed, 4608 deletions(-) delete mode 100644 library/practcl/pkgIndex.tcl delete mode 100644 library/practcl/practcl.tcl delete mode 100644 library/zvfstools/pkgIndex.tcl delete mode 100644 library/zvfstools/zvfstools.tcl delete mode 100644 pkgs/make.tcl delete mode 100644 pkgs/packages.tcl diff --git a/library/practcl/pkgIndex.tcl b/library/practcl/pkgIndex.tcl deleted file mode 100644 index 1e378e8..0000000 --- a/library/practcl/pkgIndex.tcl +++ /dev/null @@ -1,11 +0,0 @@ -# Tcl package index file, version 1.1 -# This file is generated by the "pkg_mkIndex" command -# and sourced either when an application starts up or -# by a "package unknown" script. It invokes the -# "package ifneeded" command to set up package-related -# information so that packages will be loaded automatically -# in response to "package require" commands. When this -# script is sourced, the variable $dir must contain the -# full path name of this file's directory. - -package ifneeded practcl 0.5 [list source [file join $dir practcl.tcl]] diff --git a/library/practcl/practcl.tcl b/library/practcl/practcl.tcl deleted file mode 100644 index 77d1181..0000000 --- a/library/practcl/practcl.tcl +++ /dev/null @@ -1,4014 +0,0 @@ -### -# Practcl -# An object oriented templating system for stamping out Tcl API calls to C -### -puts [list LOADED practcl.tcl from [info script]] -package require TclOO -proc ::debug args { - #puts $args - ::practcl::cputs ::DEBUG_INFO $args -} - -### -# Drop in a static copy of Tcl -### -proc ::doexec args { - puts [list {*}$args] - exec {*}$args >&@ stdout -} - -proc ::dotclexec args { - puts [list [info nameofexecutable] {*}$args] - exec [info nameofexecutable] {*}$args >&@ stdout -} - -proc ::domake {path args} { - set PWD [pwd] - cd $path - puts [list *** $path ***] - puts [list make {*}$args] - exec make {*}$args >&@ stdout - cd $PWD -} - -proc ::domake.tcl {path args} { - set PWD [pwd] - cd $path - puts [list *** $path ***] - puts [list make.tcl {*}$args] - exec [info nameofexecutable] make.tcl {*}$args >&@ stdout - cd $PWD -} - -proc ::fossil {path args} { - set PWD [pwd] - cd $path - puts [list {*}$args] - exec fossil {*}$args >&@ stdout - cd $PWD -} - - -proc ::fossil_status {dir} { - if {[info exists ::fosdat($dir)]} { - return $::fosdat($dir) - } - set result { -tags experimental -version {} - } - set pwd [pwd] - cd $dir - set info [exec fossil status] - cd $pwd - foreach line [split $info \n] { - if {[lindex $line 0] eq "checkout:"} { - set hash [lindex $line end-3] - set maxdate [lrange $line end-2 end-1] - dict set result hash $hash - dict set result maxdate $maxdate - regsub -all {[^0-9]} $maxdate {} isodate - dict set result isodate $isodate - } - if {[lindex $line 0] eq "tags:"} { - set tags [lrange $line 1 end] - dict set result tags $tags - break - } - } - set ::fosdat($dir) $result - return $result -} -### -# Seek out Tcllib if it's available -### -set tcllib_path {} -foreach path {.. ../.. ../../..} { - foreach path [glob -nocomplain [file join [file normalize $path] tcllib* modules]] { - set tclib_path $path - lappend ::auto_path $path - break - } - if {$tcllib_path ne {}} break -} - - -### -# Build utility functions -### -namespace eval ::practcl {} - -proc ::practcl::os {} { - if {[info exists ::project(TEACUP_OS)] && $::project(TEACUP_OS) ni {"@TEACUP_OS@" {}}} { - return $::project(TEACUP_OS) - } - set info [::practcl::config.tcl $::project(builddir)] - if {[dict exists $info TEACUP_OS]} { - return [dict get $info TEACUP_OS] - } - return unknown -} - -### -# Detect local platform -### -proc ::practcl::config.tcl {path} { - dict set result buildpath $path - set result {} - if {[file exists [file join $path config.tcl]]} { - set fin [open [file join $path config.tcl] r] - set bufline {} - set rawcount 0 - set linecount 0 - while {[gets $fin thisline]>=0} { - incr rawcount - append bufline \n $thisline - if {![info complete $bufline]} continue - set line [string trimleft $bufline] - set bufline {} - if {[string index [string trimleft $line] 0] eq "#"} continue - incr linecount - set key [lindex $line 0] - set value [lindex $line 1] - dict set result $key $value - } - dict set result sandbox [file dirname [dict get $result srcdir]] - dict set result download [file join [dict get $result sandbox] download] - dict set result teapot [file join [dict get $result sandbox] teapot] - set result [::practcl::de_shell $result] - } - # If data is available from autoconf, defer to that - if {[dict exists $result TEACUP_OS] && [dict get $result TEACUP_OS] ni {"@TEACUP_OS@" {}}} { - return $result - } - # If autoconf hasn't run yet, assume we are not cross compiling - # and defer to local checks - dict set result TEACUP_PROFILE unknown - dict set result TEACUP_OS unknown - dict set result EXEEXT {} - if {$::tcl_platform(platform) eq "windows"} { - set system "windows" - set arch ix86 - dict set result TEACUP_PROFILE win32-ix86 - dict set result TEACUP_OS windows - dict set result EXEEXT .exe - } else { - set system [exec uname -s]-[exec uname -r] - set arch unknown - dict set result TEACUP_OS generic - } - dict set result TEA_PLATFORM $system - dict set result TEA_SYSTEM $system - switch -glob $system { - Linux* { - dict set result TEACUP_OS linux - set arch [exec uname -m] - dict set result TEACUP_PROFILE "linux-glibc2.3-$arch" - } - GNU* { - set arch [exec uname -m] - dict set result TEACUP_OS "gnu" - } - NetBSD-Debian { - set arch [exec uname -m] - dict set result TEACUP_OS "netbsd-debian" - } - OpenBSD-* { - set arch [exec arch -s] - dict set result TEACUP_OS "openbsd" - } - Darwin* { - set arch [exec uname -m] - dict set result TEACUP_OS "macosx" - if {$arch eq "x86_64"} { - dict set result TEACUP_PROFILE "macosx10.5-i386-x86_84" - } else { - dict set result TEACUP_PROFILE "macosx-universal" - } - } - OpenBSD* { - set arch [exec arch -s] - dict set result TEACUP_OS "openbsd" - } - } - if {$arch eq "unknown"} { - catch {set arch [exec uname -m]} - } - switch -glob $arch { - i*86 { - set arch "ix86" - } - amd64 { - set arch "x86_64" - } - } - dict set result TEACUP_ARCH $arch - if {[dict get $result TEACUP_PROFILE] eq "unknown"} { - dict set result TEACUP_PROFILE [dict get $result TEACUP_OS]-$arch - } - return $result -} - - -### -# Convert an MSYS path to a windows native path -### -if {$::tcl_platform(platform) eq "windows"} { -proc ::practcl::msys_to_tclpath msyspath { - return [exec sh -c "cd $msyspath ; pwd -W"] -} -} else { -proc ::practcl::msys_to_tclpath msyspath { - return [file normalize $msyspath] -} -} - -### -# Bits stolen from fileutil -### -proc ::practcl::cat fname { - set fname [open $fname r] - set data [read $fname] - close $fname - return $data -} - -proc ::practcl::file_lexnormalize {sp} { - set spx [file split $sp] - - # Resolution of embedded relative modifiers (., and ..). - - if { - ([lsearch -exact $spx . ] < 0) && - ([lsearch -exact $spx ..] < 0) - } { - # Quick path out if there are no relative modifiers - return $sp - } - - set absolute [expr {![string equal [file pathtype $sp] relative]}] - # A volumerelative path counts as absolute for our purposes. - - set sp $spx - set np {} - set noskip 1 - - while {[llength $sp]} { - set ele [lindex $sp 0] - set sp [lrange $sp 1 end] - set islast [expr {[llength $sp] == 0}] - - if {[string equal $ele ".."]} { - if { - ($absolute && ([llength $np] > 1)) || - (!$absolute && ([llength $np] >= 1)) - } { - # .. : Remove the previous element added to the - # new path, if there actually is enough to remove. - set np [lrange $np 0 end-1] - } - } elseif {[string equal $ele "."]} { - # Ignore .'s, they stay at the current location - continue - } else { - # A regular element. - lappend np $ele - } - } - if {[llength $np] > 0} { - return [eval [linsert $np 0 file join]] - # 8.5: return [file join {*}$np] - } - return {} -} - -proc ::practcl::file_relative {base dst} { - # Ensure that the link to directory 'dst' is properly done relative to - # the directory 'base'. - - if {![string equal [file pathtype $base] [file pathtype $dst]]} { - return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)" - } - - set base [file_lexnormalize [file join [pwd] $base]] - set dst [file_lexnormalize [file join [pwd] $dst]] - - set save $dst - set base [file split $base] - set dst [file split $dst] - - while {[string equal [lindex $dst 0] [lindex $base 0]]} { - set dst [lrange $dst 1 end] - set base [lrange $base 1 end] - if {![llength $dst]} {break} - } - - set dstlen [llength $dst] - set baselen [llength $base] - - if {($dstlen == 0) && ($baselen == 0)} { - # Cases: - # (a) base == dst - - set dst . - } else { - # Cases: - # (b) base is: base/sub = sub - # dst is: base = {} - - # (c) base is: base = {} - # dst is: base/sub = sub - - while {$baselen > 0} { - set dst [linsert $dst 0 ..] - incr baselen -1 - } - # 8.5: set dst [file join {*}$dst] - set dst [eval [linsert $dst 0 file join]] - } - - return $dst -} - -### -# Unpack the source of a fossil project into a designated location -### -proc ::practcl::fossil_sandbox {pkg args} { - if {[llength $args]==1} { - set info [lindex $args 0] - } else { - set info $args - } - set result $info - if {[dict exists $info srcroot]} { - set srcroot [dict get $info srcroot] - } elseif {[dict exists $info sandbox]} { - set srcroot [file join [dict get $info sandbox] $pkg] - } else { - set srcroot [file join $::CWD .. $pkg] - } - dict set result srcroot $srcroot - puts [list fossil_sandbox $pkg $srcroot] - if {[dict exists $info download]} { - ### - # Source is actually a zip archive - ### - set download [dict get $info download] - if {[file exists [file join $download $pkg.zip]]} { - if {![info exists $srcroot]} { - package require zipfile::decode - ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcroot - } - return - } - } - variable fossil_dbs - if {![::info exists fossil_dbs]} { - # Get a list of local fossil databases - set fossil_dbs [exec fossil all list] - } - set CWD [pwd] - if {![dict exists $info tag]} { - set tag trunk - } else { - set tag [dict get $info tag] - } - dict set result tag $tag - - try { - if {[file exists [file join $srcroot .fslckout]]} { - if {[dict exists $info update] && [dict get $info update]==1} { - catch { - puts "FOSSIL UPDATE" - cd $srcroot - doexec fossil update $tag - } - } - } elseif {[file exists [file join $srcroot _FOSSIL_]]} { - if {[dict exists $info update] && [dict get $info update]==1} { - catch { - puts "FOSSIL UPDATE" - cd $srcroot - doexec fossil update $tag - } - } - } else { - puts "OPEN AND UNPACK" - set fosdb {} - foreach line [split $fossil_dbs \n] { - set line [string trim $line] - if {[file rootname [file tail $line]] eq $pkg} { - set fosdb $line - break - } - } - if {$fosdb eq {}} { - file mkdir [file join $download fossil] - set fosdb [file join $download fossil $pkg.fos] - set cloned 0 - if {[dict exists $info localmirror]} { - set localmirror [dict get $info localmirror] - catch { - doexec fossil clone $localmirror/$pkg $fosdb - set cloned 1 - } - } - if {!$cloned && [dict exists $info fossil_url]} { - set localmirror [dict get $info fossil_url] - catch { - doexec fossil clone $localmirror/$pkg $fosdb - set cloned 1 - } - } - if {!$cloned} { - doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb - } - } - file mkdir $srcroot - cd $srcroot - puts "FOSSIL OPEN [pwd]" - doexec fossil open $fosdb $tag - } - } on error {result opts} { - puts [list ERR [dict get $opts -errorinfo]] - return {*}$opts - } finally { - cd $CWD - } - return $result -} - -### -# topic: e71f3f61c348d56292011eec83e95f0aacc1c618 -# description: Converts a XXX.sh file into a series of Tcl variables -### -proc ::practcl::read_sh_subst {line info} { - regsub -all {\x28} $line \x7B line - regsub -all {\x29} $line \x7D line - - #set line [string map $key [string trim $line]] - foreach {field value} $info { - catch {set $field $value} - } - if [catch {subst $line} result] { - return {} - } - set result [string trim $result] - return [string trim $result '] -} - -### -# topic: 03567140cca33c814664c7439570f669b9ab88e6 -### -proc ::practcl::read_sh_file {filename {localdat {}}} { - set fin [open $filename r] - set result {} - if {$localdat eq {}} { - set top 1 - set local [array get ::env] - dict set local EXE {} - } else { - set top 0 - set local $localdat - } - while {[gets $fin line] >= 0} { - set line [string trim $line] - if {[string index $line 0] eq "#"} continue - if {$line eq {}} continue - catch { - if {[string range $line 0 6] eq "export "} { - set eq [string first "=" $line] - set field [string trim [string range $line 6 [expr {$eq - 1}]]] - set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] - dict set result $field [read_sh_subst $value $local] - dict set local $field $value - } elseif {[string range $line 0 7] eq "include "} { - set subfile [read_sh_subst [string range $line 7 end] $local] - foreach {field value} [read_sh_file $subfile $local] { - dict set result $field $value - } - } else { - set eq [string first "=" $line] - if {$eq > 0} { - set field [read_sh_subst [string range $line 0 [expr {$eq - 1}]] $local] - set value [string trim [string range $line [expr {$eq+1}] end] '] - #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] - dict set local $field $value - dict set result $field $value - } - } - } err opts - if {[dict get $opts -code] != 0} { - #puts $opts - puts "Error reading line:\n$line\nerr: $err\n***" - return $err {*}$opts - } - } - return $result -} - -### -# A simpler form of read_sh_file tailored -# to pulling data from (tcl|tk)Config.sh -### -proc ::practcl::read_Config.sh filename { - set fin [open $filename r] - set result {} - set linecount 0 - while {[gets $fin line] >= 0} { - set line [string trim $line] - if {[string index $line 0] eq "#"} continue - if {$line eq {}} continue - catch { - set eq [string first "=" $line] - if {$eq > 0} { - set field [string range $line 0 [expr {$eq - 1}]] - set value [string trim [string range $line [expr {$eq+1}] end] '] - #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local] - dict set result $field $value - incr $linecount - } - } err opts - if {[dict get $opts -code] != 0} { - #puts $opts - puts "Error reading line:\n$line\nerr: $err\n***" - return $err {*}$opts - } - } - return $result -} - -### -# A simpler form of read_sh_file tailored -# to pulling data from a Makefile -### -proc ::practcl::read_Makefile filename { - set fin [open $filename r] - set result {} - while {[gets $fin line] >= 0} { - set line [string trim $line] - if {[string index $line 0] eq "#"} continue - if {$line eq {}} continue - catch { - set eq [string first "=" $line] - if {$eq > 0} { - set field [string trim [string range $line 0 [expr {$eq - 1}]]] - set value [string trim [string trim [string range $line [expr {$eq+1}] end] ']] - switch $field { - PKG_LIB_FILE { - dict set result libfile $value - } - srcdir { - if {$value eq "."} { - dict set result srcdir [file dirname $filename] - } else { - dict set result srcdir $value - } - } - PACKAGE_NAME { - dict set result name $value - } - PACKAGE_VERSION { - dict set result version $value - } - LIBS { - dict set result PRACTCL_LIBS $value - } - PKG_LIB_FILE { - dict set result libfile $value - } - } - } - } err opts - if {[dict get $opts -code] != 0} { - #puts $opts - puts "Error reading line:\n$line\nerr: $err\n***" - return $err {*}$opts - } - # the Compile field is about where most TEA files start getting silly - if {$field eq "compile"} { - break - } - } - return $result -} - -## Append arguments to a buffer -# The command works like puts in that each call will also insert -# a line feed. Unlike puts, blank links in the interstitial are -# suppressed -proc ::practcl::cputs {varname args} { - upvar 1 $varname buffer - if {[llength $args]==1 && [string length [string trim [lindex $args 0]]] == 0} { - - } - if {[info exist buffer]} { - if {[string index $buffer end] ne "\n"} { - append buffer \n - } - } else { - set buffer \n - } - # Trim leading \n's - append buffer [string trimleft [lindex $args 0] \n] {*}[lrange $args 1 end] -} - - -proc ::practcl::tcl_to_c {body} { - set result {} - foreach rawline [split $body \n] { - set line [string map [list \" \\\" \\ \\\\] $rawline] - cputs result "\n \"$line\\n\" \\" - } - return [string trimright $result \\] -} - - -proc ::practcl::_tagblock {text {style tcl} {note {}}} { - if {[string length [string trim $text]]==0} { - return {} - } - set output {} - switch $style { - tcl { - ::practcl::cputs output "# BEGIN $note" - } - c { - ::practcl::cputs output "/* BEGIN $note */" - } - default { - ::practcl::cputs output "# BEGIN $note" - } - } - ::practcl::cputs output $text - switch $style { - tcl { - ::practcl::cputs output "# END $note" - } - c { - ::practcl::cputs output "/* END $note */" - } - default { - ::practcl::cputs output "# END $note" - } - } - return $output -} - -proc ::practcl::_isdirectory name { - return [file isdirectory $name] -} - -### -# Return true if the pkgindex file contains -# any statement other than "package ifneeded" -# and/or if any package ifneeded loads a DLL -### -proc ::practcl::_pkgindex_directory {path} { - set buffer {} - set pkgidxfile [file join $path pkgIndex.tcl] - if {![file exists $pkgidxfile]} { - # No pkgIndex file, read the source - foreach file [glob -nocomplain $path/*.tm] { - set file [file normalize $file] - set fname [file rootname [file tail $file]] - ### - # We used to be able to ... Assume the package is correct in the filename - # No hunt for a "package provides" - ### - set package [lindex [split $fname -] 0] - set version [lindex [split $fname -] 1] - ### - # Read the file, and override assumptions as needed - ### - set fin [open $file r] - set dat [read $fin] - close $fin - # Look for a teapot style Package statement - foreach line [split $dat \n] { - set line [string trim $line] - if { [string range $line 0 9] != "# Package " } continue - set package [lindex $line 2] - set version [lindex $line 3] - break - } - # Look for a package provide statement - foreach line [split $dat \n] { - set line [string trim $line] - if { [string range $line 0 14] != "package provide" } continue - set package [lindex $line 2] - set version [lindex $line 3] - break - } - append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n - } - foreach file [glob -nocomplain $path/*.tcl] { - if { [file tail $file] == "version_info.tcl" } continue - set fin [open $file r] - set dat [read $fin] - close $fin - if {![regexp "package provide" $dat]} continue - set fname [file rootname [file tail $file]] - # Look for a package provide statement - foreach line [split $dat \n] { - set line [string trim $line] - if { [string range $line 0 14] != "package provide" } continue - set package [lindex $line 2] - set version [lindex $line 3] - if {[string index $package 0] in "\$ \["} continue - if {[string index $version 0] in "\$ \["} continue - append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n - break - } - } - return $buffer - } - set fin [open $pkgidxfile r] - set dat [read $fin] - close $fin - set thisline {} - foreach line [split $dat \n] { - append thisline $line \n - if {![info complete $thisline]} continue - set line [string trim $line] - if {[string length $line]==0} { - set thisline {} ; continue - } - if {[string index $line 0] eq "#"} { - set thisline {} ; continue - } - try { - # Ignore contditionals - if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} continue - if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} continue - if {![regexp "package.*ifneeded" $thisline]} { - # This package index contains arbitrary code - # source instead of trying to add it to the master - # package index - return {source [file join $dir pkgIndex.tcl]} - } - append buffer $thisline \n - } on error {err opts} { - puts *** - puts "GOOF: $pkgidxfile" - puts $line - puts $err - puts [dict get $opts -errorinfo] - puts *** - } finally { - set thisline {} - } - } - return $buffer -} - - -proc ::practcl::_pkgindex_path_subdir {path} { - set result {} - foreach subpath [glob -nocomplain [file join $path *]] { - if {[file isdirectory $subpath]} { - lappend result $subpath {*}[_pkgindex_path_subdir $subpath] - } - } - return $result -} -### -# Index all paths given as though they will end up in the same -# virtual file system -### -proc ::practcl::pkgindex_path args { - set stack {} - set buffer { -lappend ::PATHSTACK $dir - } - foreach base $args { - set base [file normalize $base] - set paths [::practcl::_pkgindex_path_subdir $base] - set i [string length $base] - # Build a list of all of the paths - foreach path $paths { - if {$path eq $base} continue - set path_indexed($path) 0 - } - set path_indexed($base) 1 - set path_indexed([file join $base boot tcl]) 1 - #set path_index([file join $base boot tk]) 1 - - foreach path $paths { - if {$path_indexed($path)} continue - set thisdir [file_relative $base $path] - #set thisdir [string range $path $i+1 end] - set idxbuf [::practcl::_pkgindex_directory $path] - if {[string length $idxbuf]} { - incr path_indexed($path) - append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n - append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n - } - } - } - append buffer { -set dir [lindex $::PATHSTACK end] -set ::PATHSTACK [lrange $::PATHSTACK 0 end-1] -} - return $buffer -} - -### -# topic: 64319f4600fb63c82b2258d908f9d066 -# description: Script to build the VFS file system -### -proc ::practcl::installDir {d1 d2} { - - puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]] - file delete -force -- $d2 - file mkdir $d2 - - foreach ftail [glob -directory $d1 -nocomplain -tails *] { - set f [file join $d1 $ftail] - if {[file isdirectory $f] && [string compare CVS $ftail]} { - installDir $f [file join $d2 $ftail] - } elseif {[file isfile $f]} { - file copy -force $f [file join $d2 $ftail] - if {$::tcl_platform(platform) eq {unix}} { - file attributes [file join $d2 $ftail] -permissions 0644 - } else { - file attributes [file join $d2 $ftail] -readonly 1 - } - } - } - - if {$::tcl_platform(platform) eq {unix}} { - file attributes $d2 -permissions 0755 - } else { - file attributes $d2 -readonly 1 - } -} - -proc ::practcl::copyDir {d1 d2} { - #puts [list $d1 -> $d2] - #file delete -force -- $d2 - file mkdir $d2 - - foreach ftail [glob -directory $d1 -nocomplain -tails *] { - set f [file join $d1 $ftail] - if {[file isdirectory $f] && [string compare CVS $ftail]} { - copyDir $f [file join $d2 $ftail] - } elseif {[file isfile $f]} { - file copy -force $f [file join $d2 $ftail] - } - } -} - -::oo::class create ::practcl::metaclass { - superclass ::oo::object - - method script script { - eval $script - } - - method source filename { - source $filename - } - - method initialize {} {} - - method define {submethod args} { - my variable define - switch $submethod { - dump { - return [array get define] - } - add { - set field [lindex $args 0] - if {![info exists define($field)]} { - set define($field) {} - } - foreach arg [lrange $args 1 end] { - if {$arg ni $define($field)} { - lappend define($field) $arg - } - } - return $define($field) - } - remove { - set field [lindex $args 0] - if {![info exists define($field)]} { - return - } - set rlist [lrange $args 1 end] - set olist $define($field) - set nlist {} - foreach arg $olist { - if {$arg in $rlist} continue - lappend nlist $arg - } - set define($field) $nlist - return $nlist - } - exists { - set field [lindex $args 0] - return [info exists define($field)] - } - getnull - - get - - cget { - set field [lindex $args 0] - if {[info exists define($field)]} { - return $define($field) - } - return [lindex $args 1] - } - set { - if {[llength $args]==1} { - set arglist [lindex $args 0] - } else { - set arglist $args - } - array set define $arglist - if {[dict exists $arglist class]} { - my select - } - } - default { - array $submethod define {*}$args - } - } - } - - method graft args { - my variable organs - if {[llength $args] == 1} { - error "Need two arguments" - } - set object {} - foreach {stub object} $args { - dict set organs $stub $object - oo::objdefine [self] forward <${stub}> $object - oo::objdefine [self] export <${stub}> - } - return $object - } - - method organ {{stub all}} { - my variable organs - if {![info exists organs]} { - return {} - } - if { $stub eq "all" } { - return $organs - } - if {[dict exists $organs $stub]} { - return [dict get $organs $stub] - } - } - - method link {command args} { - my variable links - switch $command { - object { - foreach obj $args { - foreach linktype [$obj linktype] { - my link add $linktype $obj - } - } - } - add { - ### - # Add a link to an object that was externally created - ### - if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"} - lassign $args linktype object - if {[info exists links($linktype)] && $object in $links($linktype)} { - return - } - lappend links($linktype) $object - } - remove { - set object [lindex $args 0] - if {[llength $args]==1} { - set ltype * - } else { - set ltype [lindex $args 1] - } - foreach {linktype elements} [array get links $ltype] { - if {$object in $elements} { - set nlist {} - foreach e $elements { - if { $object ne $e } { lappend nlist $e } - } - set links($linktype) $nlist - } - } - } - list { - if {[llength $args]==0} { - return [array get links] - } - if {[llength $args] != 1} { error "Usage: link list LINKTYPE"} - set linktype [lindex $args 0] - if {![info exists links($linktype)]} { - return {} - } - return $links($linktype) - } - dump { - return [array get links] - } - } - } - - method select {} { - my variable define - set class {} - if {[info exists define(class)]} { - if {[info command $define(class)] ne {}} { - set class $define(class) - } elseif {[info command ::practcl::$define(class)] ne {}} { - set class ::practcl::$define(class) - } else { - switch $define(class) { - default { - set class ::practcl::object - } - } - } - } - if {$class ne {}} { - ::oo::objdefine [self] class $class - } - if {[::info exists define(oodefine)]} { - ::oo::objdefine [self] $define(oodefine) - unset define(oodefine) - } - } -} - -proc ::practcl::trigger {args} { - foreach name $args { - if {[dict exists $::make_objects $name]} { - [dict get $::make_objects $name] triggers - } - } -} - -proc ::practcl::depends {args} { - foreach name $args { - if {[dict exists $::make_objects $name]} { - [dict get $::make_objects $name] check - } - } -} - -proc ::practcl::target {name info} { - set obj [::practcl::target_obj new $name $info] - dict set ::make_objects $name $obj - if {[dict exists $info aliases]} { - foreach item [dict get $info aliases] { - if {![dict exists $::make_objects $item]} { - dict set ::make_objects $item $obj - } - } - } - set ::make($name) 0 - set ::trigger($name) 0 - set filename [$obj define get filename] - if {$filename ne {}} { - set ::target($name) $filename - } -} - -### Batch Tasks - -namespace eval ::practcl::build {} - -## method DEFS -# This method populates 4 variables: -# name - The name of the package -# version - The version of the package -# defs - C flags passed to the compiler -# includedir - A list of paths to feed to the compiler for finding headers -# -proc ::practcl::build::DEFS {PROJECT DEFS namevar versionvar defsvar} { - upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs - set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]] - set NAME [string toupper $name] - set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] - if {$version eq {}} { - set version 0.1a - } - set defs {} - append defs " -DPACKAGE_NAME=\"${name}\" -DPACKAGE_VERSION=\"${version}\"" - append defs " -DPACKAGE_TARNAME=\"${name}\" -DPACKAGE_STRING=\"${name}\x5c\x20${version}\"" - set NAME [string toupper $name] - set idx 0 - set count 0 - while {$idx>=0} { - set ndx [string first " -D" $DEFS $idx+1] - set item [string range $DEFS $idx $ndx] - set item [string trim $item] - set item [string trimleft $item -D] - if {[string range $item 0 7] eq "PACKAGE_"} { - set idx $ndx - continue - } - set eqidx [string first = $item ] - if {$eqidx < 0} { - append defs { } $item - set idx $ndx - continue - } - - set field [string range $item 0 [expr {$eqidx-1}]] - set value [string range $item [expr {$eqidx+1}] end] - set emap {} - # On Windows we need to do some munging of escape characters - if {[practcl::os]=="windows"} { - lappend emap \x5c \x5c\x5c \x20 \x5c\x20 \x22 \x5c\x22 \x28 \x5c\x28 \x29 \x5c\x29 - if {[string is integer -strict $value]} { - append defs " -D${field}=$value" - } else { - append defs " -D${field}=[string map $emap $value]" - } - } else { - append defs " -D${field}=$value" - } - set idx $ndx - } - return $defs -} - -proc ::practcl::build::tclkit_main {PROJECT PKG_OBJS} { - ### - # Build static package list - ### - set statpkglist {} - dict set statpkglist Tk {autoload 0} - puts [list TCLKIT MAIN $PROJECT] - - foreach {ofile info} [${PROJECT} compile-products] { - puts [list * PROD $ofile $info] - if {![dict exists $info object]} continue - set cobj [dict get $info object] - foreach {pkg info} [$cobj static-packages] { - dict set statpkglist $pkg $info - } - } - foreach cobj [list {*}${PKG_OBJS} $PROJECT] { - puts [list * PROG $cobj] - foreach {pkg info} [$cobj static-packages] { - puts [list * PKG $pkg $info] - dict set statpkglist $pkg $info - } - } - - set result {} - $PROJECT include {} - $PROJECT include {"tclInt.h"} - $PROJECT include {"tclFileSystem.h"} - $PROJECT include {} - $PROJECT include {} - $PROJECT include {} - $PROJECT include {} - $PROJECT include {} - - $PROJECT code header { -#ifndef MODULE_SCOPE -# define MODULE_SCOPE extern -#endif - -/* -** Provide a dummy Tcl_InitStubs if we are using this as a static -** library. -*/ -#ifndef USE_TCL_STUBS -# undef Tcl_InitStubs -# define Tcl_InitStubs(a,b,c) TCL_VERSION -#endif -#define STATIC_BUILD 1 -#undef USE_TCL_STUBS - -/* Make sure the stubbed variants of those are never used. */ -#undef Tcl_ObjSetVar2 -#undef Tcl_NewStringObj -#undef Tk_Init -#undef Tk_MainEx -#undef Tk_SafeInit -} - - # Build an area of the file for #define directives and - # function declarations - set define {} - set mainhook [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] - set mainfunc [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit] - set mainscript [$PROJECT define get main.tcl main.tcl] - set vfsroot [$PROJECT define get vfsroot zipfs:/app] - set vfs_main "${vfsroot}/${mainscript}" - set vfs_tcl_library "${vfsroot}/boot/tcl" - set vfs_tk_library "${vfsroot}/boot/tk" - - set map {} - foreach var { - vfsroot mainhook mainfunc vfs_main vfs_tcl_library vfs_tk_library - } { - dict set map %${var}% [set $var] - } - set preinitscript { -set ::odie(boot_vfs) {%vfsroot%} -set ::SRCDIR {%vfsroot%} -if {[file exists {%vfs_tcl_library%}]} { - set ::tcl_library {%vfs_tcl_library%} - set ::auto_path {} -} -if {[file exists {%vfs_tk_library%}]} { - set ::tk_library {%vfs_tk_library%} -} -} ; # Preinitscript - - set zvfsboot { -/* - * %mainhook% -- - * Performs the argument munging for the shell - */ - } - ::practcl::cputs zvfsboot { - CONST char *archive; - Tcl_FindExecutable(*argv[0]); - archive=Tcl_GetNameOfExecutable(); -} - if {![$PROJECT define get CORE_ZIPFS 0]} { - ::practcl::cputs zvfsboot { - /* - ** We have to initialize the virtual filesystem before calling - ** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find - ** its startup script files. - */ - Tclzipfs_Init(NULL); -} - $PROJECT include {"tclZipfs.h"} - } - - ::practcl::cputs zvfsboot " if(!TclZipfsMount(NULL, archive, \"%vfsroot%\", NULL)) \x7B " - ::practcl::cputs zvfsboot { - Tcl_Obj *vfsinitscript; - vfsinitscript=Tcl_NewStringObj("%vfs_main%",-1); - Tcl_IncrRefCount(vfsinitscript); - if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { - /* Startup script should be set before calling Tcl_AppInit */ - Tcl_SetStartupScript(vfsinitscript,NULL); - } - } - ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c $preinitscript])\;" - ::practcl::cputs zvfsboot " \x7D else \x7B" - ::practcl::cputs zvfsboot " TclSetPreInitScript([::practcl::tcl_to_c { -foreach path { - ../tcl -} { - set p [file join $path library init.tcl] - if {[file exists [file join $path library init.tcl]]} { - set ::tcl_library [file normalize [file join $path library]] - break - } -} -foreach path { - ../tk -} { - if {[file exists [file join $path library tk.tcl]]} { - set ::tk_library [file normalize [file join $path library]] - break - } -} -}])\;" - - ::practcl::cputs zvfsboot " \x7D" - - ::practcl::cputs zvfsboot " return TCL_OK;" - - if {[$PROJECT define get os] eq "windows"} { - set header {int %mainhook%(int *argc, TCHAR ***argv)} - } else { - set header {int %mainhook%(int *argc, char ***argv)} - } - $PROJECT c_function [string map $map $header] [string map $map $zvfsboot] - - practcl::cputs appinit "int %mainfunc%(Tcl_Interp *interp) \x7B" - - # Build AppInit() - set appinit {} - practcl::cputs appinit { - if ((Tcl_Init)(interp) == TCL_ERROR) { - return TCL_ERROR; - } -} - set main_init_script {} - - foreach {statpkg info} $statpkglist { - set initfunc {} - if {[dict exists $info initfunc]} { - set initfunc [dict get $info initfunc] - } - if {$initfunc eq {}} { - set initfunc [string totitle ${statpkg}]_Init - } - # We employ a NULL to prevent the package system from thinking the - # package is actually loaded into the interpreter - $PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n" - set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]] - append main_init_script \n [list set ::kitpkg(${statpkg}) $script] - if {[dict get $info autoload]} { - ::practcl::cputs appinit " if(${initfunc}(interp)) return TCL_ERROR\;" - ::practcl::cputs appinit " Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;" - } else { - ::practcl::cputs appinit "\n Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;" - append main_init_script \n $script - } - } - append main_init_script \n { -if {[file exists [file join $::SRCDIR packages.tcl]]} { - #In a wrapped exe, we don't go out to the environment - set dir $::SRCDIR - source [file join $::SRCDIR packages.tcl] -} -# Specify a user-specific startup file to invoke if the application -# is run interactively. Typically the startup file is "~/.apprc" -# where "app" is the name of the application. If this line is deleted -# then no user-specific startup file will be run under any conditions. - } - append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] - practcl::cputs appinit " Tcl_Eval(interp,[::practcl::tcl_to_c $main_init_script]);" - practcl::cputs appinit { return TCL_OK;} - $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] -} - -proc ::practcl::build::compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} { - set EXTERN_OBJS {} - set OBJECTS {} - set result {} - set builddir [$PROJECT define get builddir] - file mkdir [file join $builddir objs] - set debug [$PROJECT define get debug 0] - if {$CPPCOMPILE eq {}} { - set CPPCOMPILE $COMPILE - } - set task [${PROJECT} compile-products] - ### - # Compile the C sources - ### - foreach {ofile info} $task { - dict set task $ofile done 0 - if {[dict exists $info external] && [dict get $info external]==1} { - dict set task $ofile external 1 - } else { - dict set task $ofile external 0 - } - if {[dict exists $info library]} { - dict set task $ofile done 1 - continue - } - # Products with no cfile aren't compiled - if {![dict exists $info cfile] || [set cfile [dict get $info cfile]] eq {}} { - dict set task $ofile done 1 - continue - } - set cfile [dict get $info cfile] - set ofilename [file join $builddir objs [file tail $ofile]] - if {$debug} { - set ofilename [file join $builddir objs [file rootname [file tail $ofile]].debug.o] - } - dict set task $ofile filename $ofilename - if {[file exists $ofilename] && [file mtime $ofilename]>[file mtime $cfile]} { - lappend result $ofilename - dict set task $ofile done 1 - continue - } - if {![dict exist $info command]} { - if {[file extension $cfile] in {.c++ .cpp}} { - set cmd $CPPCOMPILE - } else { - set cmd $COMPILE - } - if {[dict exists $info extra]} { - append cmd " [dict get $info extra]" - } - append cmd " -c $cfile" - append cmd " -o $ofilename" - dict set task $ofile command $cmd - } - } - set completed 0 - while {$completed==0} { - set completed 1 - foreach {ofile info} $task { - set waiting {} - if {[dict exists $info done] && [dict get $info done]} continue - if {[dict exists $info depend]} { - foreach file [dict get $info depend] { - if {[dict exists $task $file command] && [dict exists $task $file done] && [dict get $task $file done] != 1} { - set waiting $file - break - } - } - } - if {$waiting ne {}} { - set completed 0 - puts "$ofile waiting for $waiting" - continue - } - if {[dict exists $info command]} { - set cmd [dict get $info command] - puts "$cmd" - exec {*}$cmd >&@ stdout - } - lappend result [dict get $info filename] - dict set task $ofile done 1 - } - } - return $result -} - -proc ::practcl::de_shell {data} { - set values {} - foreach flag {DEFS TCL_DEFS TK_DEFS} { - if {[dict exists $data $flag]} { - set value {} - foreach item [dict get $data $flag] { - append value " " [string map {{ } {\ }} $item] - } - dict set values $flag $value - } - } - set map {} - lappend map {${PKG_OBJECTS}} %LIBRARY_OBJECTS% - lappend map {$(PKG_OBJECTS)} %LIBRARY_OBJECTS% - lappend map {${PKG_STUB_OBJECTS}} %LIBRARY_STUB_OBJECTS% - lappend map {$(PKG_STUB_OBJECTS)} %LIBRARY_STUB_OBJECTS% - - lappend map %LIBRARY_NAME% [dict get $data name] - lappend map %LIBRARY_VERSION% [dict get $data version] - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} [dict get $data version]] - if {[dict exists $data libprefix]} { - lappend map %LIBRARY_PREFIX% [dict get $data libprefix] - } else { - lappend map %LIBRARY_PREFIX% [dict get $data prefix] - } - foreach flag [dict keys $data] { - if {$flag in {TCL_DEFS TK_DEFS DEFS}} continue - - dict set map "%${flag}%" [dict get $data $flag] - dict set map "\$\{${flag}\}" [dict get $data $flag] - dict set map "\$\(${flag}\)" [dict get $data $flag] - dict set values $flag [dict get $data $flag] - #dict set map "\$\{${flag}\}" $proj($flag) - } - set changed 1 - while {$changed} { - set changed 0 - foreach {field value} $values { - if {$field in {TCL_DEFS TK_DEFS DEFS}} continue - dict with values {} - set newval [string map $map $value] - if {$newval eq $value} continue - set changed 1 - dict set values $field $newval - } - } - return $values -} - -proc ::practcl::build::Makefile {path PROJECT} { - array set proj [$PROJECT define dump] - set path $proj(builddir) - cd $path - set includedir . - #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] - foreach include [$PROJECT generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - set INCLUDES "-I[join $includedir " -I"]" - set NAME [string toupper $proj(name)] - set result {} - set products {} - set libraries {} - set thisline {} - ::practcl::cputs result "${NAME}_DEFS = $proj(DEFS)\n" - ::practcl::cputs result "${NAME}_INCLUDES = -I\"[join $includedir "\" -I\""]\"\n" - ::practcl::cputs result "${NAME}_COMPILE = \$(CC) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" - ::practcl::cputs result "${NAME}_CPPCOMPILE = \$(CXX) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)" - - foreach {ofile info} [$PROJECT compile-products] { - dict set products $ofile $info - if {[dict exists $info library]} { -lappend libraries $ofile -continue - } - if {[dict exists $info depend]} { - ::practcl::cputs result "\n${ofile}: [dict get $info depend]" - } else { - ::practcl::cputs result "\n${ofile}:" - } - set cfile [dict get $info cfile] - if {[file extension $cfile] in {.c++ .cpp}} { - set cmd "\t\$\(${NAME}_CPPCOMPILE\)" - } else { - set cmd "\t\$\(${NAME}_COMPILE\)" - } - if {[dict exists $info extra]} { - append cmd " [dict get $info extra]" - } - append cmd " -c [dict get $info cfile] -o \$@\n\t" - ::practcl::cputs result $cmd - } - - set map {} - lappend map %LIBRARY_NAME% $proj(name) - lappend map %LIBRARY_VERSION% $proj(version) - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] - lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix] - - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - set outfile [$PROJECT define get libfile] - } else { - set outfile [$PROJECT shared_library] - } - $PROJECT define set shared_library $outfile - ::practcl::cputs result " -${NAME}_SHLIB = $outfile -${NAME}_OBJS = [dict keys $products] -" - - #lappend map %OUTFILE% {\[$]@} - lappend map %OUTFILE% $outfile - lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)" - ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]" - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]" - } - ::practcl::cputs result {} - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - #set outfile [$PROJECT static_library] - set outfile $proj(name).a - } else { - set outfile [$PROJECT define get libfile] - } - $PROJECT define set static_library $outfile - dict set map %OUTFILE% $outfile - ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" - ::practcl::cputs result {} - return $result -} - -### -# Produce a dynamic library -### -proc ::practcl::build::library {outfile PROJECT} { - array set proj [$PROJECT define dump] - set path $proj(builddir) - cd $path - set includedir . - #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] - if {[$PROJECT define get tk 0]} { - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]] - lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]] - lappend includedir [::practcl::file_relative $path [file normalize $proj(TK_BIN_DIR)]] - } - foreach include [$PROJECT generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - ::practcl::build::DEFS $PROJECT $proj(DEFS) name version defs - set NAME [string toupper $name] - set debug [$PROJECT define get debug 0] - set os [$PROJECT define get os] - - set INCLUDES "-I[join $includedir " -I"]" - if {$debug} { - set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ -$proj(CFLAGS_WARNING) $INCLUDES $defs" - - if {[info exists proc(CXX)]} { - set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS_DEBUG) -ggdb \ - $proj(DEFS) $proj(CFLAGS_WARNING)" - } else { - set COMPILECPP $COMPILE - } - } else { - set COMPILE "$proj(CC) $proj(CFLAGS) $defs $INCLUDES " - - if {[info exists proc(CXX)]} { - set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS) $proj(DEFS)" - } else { - set COMPILECPP $COMPILE - } - } - - set products [compile-sources $PROJECT $COMPILE $COMPILECPP] - - set map {} - lappend map %LIBRARY_NAME% $proj(name) - lappend map %LIBRARY_VERSION% $proj(version) - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] - lappend map %OUTFILE% $outfile - lappend map %LIBRARY_OBJECTS% $products - lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)" - - if {[string is true [$PROJECT define get SHARED_BUILD 1]]} { - set cmd [$PROJECT define get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT define get PRACTCL_LIBS]" - set cmd [string map $map $cmd] - puts $cmd - exec {*}$cmd >&@ stdout - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] - puts $cmd - exec {*}$cmd >&@ stdout - } - } else { - set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] - puts $cmd - exec {*}$cmd >&@ stdout - } -} - -### -# Produce a static executable -### -proc ::practcl::build::static-tclsh {outfile PROJECT} { - puts " BUILDING STATIC TCLSH " - set TCLOBJ [$PROJECT project TCLCORE] - set TKOBJ [$PROJECT project TKCORE] - set ODIEOBJ [$PROJECT project odie] - - set PKG_OBJS {} - foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { - lappend PKG_OBJS $item - } - } - array set TCL [$TCLOBJ config.sh] - array set TK [$TKOBJ config.sh] - set path [file dirname $outfile] - cd $path - ### - # For a static Tcl shell, we need to build all local sources - # with the same DEFS flags as the tcl core was compiled with. - # The DEFS produced by a TEA extension aren't intended to operate - # with the internals of a staticly linked Tcl - ### - ::practcl::build::DEFS $PROJECT $TCL(defs) name version defs - - set debug [$PROJECT define get debug 0] - set NAME [string toupper $name] - set result {} - set libraries {} - set thisline {} - set OBJECTS {} - set EXTERN_OBJS {} - foreach obj $PKG_OBJS { - $obj compile - set config($obj) [$obj config.sh] - } - set os [$PROJECT define get os] - set TCLSRCDIR [$TCLOBJ define get srcroot] - set TKSRCDIR [$TKOBJ define get srcroot] - - set includedir . - foreach include [$TCLOBJ generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]] - foreach include [$PROJECT generate-include-directory] { - set cpath [::practcl::file_relative $path [file normalize $include]] - if {$cpath ni $includedir} { - lappend includedir $cpath - } - } - - set INCLUDES "-I[join $includedir " -I"]" - if {$debug} { - set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) -ggdb \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } else { - set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } - append COMPILE " " $defs - lappend OBJECTS {*}[compile-sources $PROJECT $COMPILE $COMPILE] - - if {[${PROJECT} define get platform] eq "windows"} { - set RSOBJ [file join $path build tclkit.res.o] - set RCSRC [${PROJECT} define get kit_resource_file] - if {$RCSRC eq {} || ![file exists $RCSRC]} { - set RCSRC [file join $TKSRCDIR win rc wish.rc] - } - set cmd [list windres -o $RSOBJ -DSTATIC_BUILD] - set TCLSRC [file normalize $TCLSRCDIR] - set TKSRC [file normalize $TKSRCDIR] - - lappend cmd --include [::practcl::file_relative $path [file join $TCLSRC generic]] \ - --include [::practcl::file_relative $path [file join $TKSRC generic]] \ - --include [::practcl::file_relative $path [file join $TKSRC win]] \ - --include [::practcl::file_relative $path [file join $TKSRC win rc]] - foreach item [${PROJECT} define get resource_include] { - lappend cmd --include [::practcl::file_relative $path [file normalize $item]] - } - lappend cmd $RCSRC - doexec {*}$cmd - - lappend OBJECTS $RSOBJ - set LDFLAGS_CONSOLE {-mconsole -pipe -static-libgcc} - set LDFLAGS_WINDOW {-mwindows -pipe -static-libgcc} - } else { - set LDFLAGS_CONSOLE {} - set LDFLAGS_WINDOW {} - } - puts "***" - if {$debug} { - set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } else { - set cmd "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \ -$TCL(cflags_warning) $TCL(extra_cflags) $INCLUDES" - } - append cmd " $OBJECTS" - append cmd " $EXTERN_OBJS " - # On OSX it is impossibly to generate a completely static - # executable - if {[$PROJECT define get TEACUP_OS] ne "macosx"} { - append cmd " -static " - } - parray TCL - if {$debug} { - if {$os eq "windows"} { - append cmd " -L${TCL(src_dir)}/win -ltcl86g" - append cmd " -L${TK(src_dir)}/win -ltk86g" - } else { - append cmd " -L${TCL(src_dir)}/unix -ltcl86g" - append cmd " -L${TK(src_dir)}/unix -ltk86g" - } - } else { - append cmd " $TCL(build_lib_spec) $TK(build_lib_spec)" - } - foreach obj $PKG_OBJS { - append cmd " [$obj linker-products $config($obj)]" - } - append cmd " $TCL(libs) $TK(libs)" - foreach obj $PKG_OBJS { - append cmd " [$obj linker-external $config($obj)]" - } - if {$debug} { - if {$os eq "windows"} { - append cmd " -L${TCL(src_dir)}/win ${TCL(stub_lib_flag)}" - append cmd " -L${TK(src_dir)}/win ${TK(stub_lib_flag)}" - } else { - append cmd " -L${TCL(src_dir)}/unix ${TCL(stub_lib_flag)}" - append cmd " -L${TK(src_dir)}/unix ${TK(stub_lib_flag)}" - } - } else { - append cmd " $TCL(build_stub_lib_spec)" - append cmd " $TK(build_stub_lib_spec)" - } - append cmd " -o $outfile $LDFLAGS_CONSOLE" - puts "LINK: $cmd" - exec {*}$cmd >&@ stdout -} - -::oo::class create ::practcl::target_obj { - superclass ::practcl::metaclass - - constructor {name info} { - my variable define triggered domake - set triggered 0 - set domake 0 - set define(name) $name - set data [uplevel 2 [list subst $info]] - array set define $data - my select - my initialize - } - - method do {} { - my variable domake - return $domake - } - - method check {} { - my variable needs_make domake - if {$domake} { - return 1 - } - if {[info exists needs_make]} { - return $needs_make - } - set needs_make 0 - foreach item [my define get depends] { - if {![dict exists $::make_objects $item]} continue - set depobj [dict get $::make_objects $item] - if {$depobj eq [self]} { - puts "WARNING [self] depends on itself" - continue - } - if {[$depobj check]} { - set needs_make 1 - } - } - if {!$needs_make} { - set filename [my define get filename] - if {$filename ne {} && ![file exists $filename]} { - set needs_make 1 - } - } - return $needs_make - } - - method triggers {} { - my variable triggered domake define - if {$triggered} { - return $domake - } - set triggered 1 - foreach item [my define get depends] { - puts [list $item [dict exists $::make_objects $item]] - if {![dict exists $::make_objects $item]} continue - set depobj [dict get $::make_objects $item] - if {$depobj eq [self]} { - puts "WARNING [self] triggers itself" - continue - } else { - set r [$depobj check] - puts [list $depobj check $r] - if {$r} { - puts [list $depobj TRIGGER] - $depobj triggers - } - } - } - if {[info exists ::make($define(name))] && $::make($define(name))} { - return - } - set ::make($define(name)) 1 - ::practcl::trigger {*}[my define get triggers] - } -} - - -### -# Define the metaclass -### -::oo::class create ::practcl::object { - superclass ::practcl::metaclass - - constructor {parent args} { - my variable links define - set organs [$parent child organs] - my graft {*}$organs - array set define $organs - array set define [$parent child define] - array set links {} - if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my InitializeSourceFile [lindex $args 0] - } elseif {[llength $args] == 1} { - set data [uplevel 1 [list subst [lindex $args 0]]] - array set define $data - my select - my initialize - } else { - array set define [uplevel 1 [list subst $args]] - my select - my initialize - } - } - - - method include_dir args { - my define add include_dir {*}$args - } - - method include_directory args { - my define add include_dir {*}$args - } - - method Collate_Source CWD {} - - - method child {method} { - return {} - } - - method InitializeSourceFile filename { - my define set filename $filename - set class {} - switch [file extension $filename] { - .tcl { - set class ::practcl::dynamic - } - .h { - set class ::practcl::cheader - } - .c { - set class ::practcl::csource - } - .ini { - switch [file tail $filename] { - module.ini { - set class ::practcl::module - } - library.ini { - set class ::practcl::subproject - } - } - } - .so - - .dll - - .dylib - - .a { - set class ::practcl::clibrary - } - } - if {$class ne {}} { - oo::objdefine [self] class $class - my initialize - } - } - - method add args { - my variable links - set object [::practcl::object new [self] {*}$args] - foreach linktype [$object linktype] { - lappend links($linktype) $object - } - return $object - } - - method go {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable links - foreach {linktype objs} [array get links] { - foreach obj $objs { - $obj go - } - } - debug [list /[self] [self method] [self class]] - } - - method code {section body} { - my variable code - ::practcl::cputs code($section) $body - } - - method Ofile filename { - set lpath [my define get localpath] - if {$lpath eq {}} { - set lpath [my define get name] - } - return ${lpath}_[file rootname [file tail $filename]].o - } - - method compile-products {} { - set filename [my define get filename] - set result {} - if {$filename ne {}} { - if {[my define exists ofile]} { - set ofile [my define get ofile] - } else { - set ofile [my Ofile $filename] - my define set ofile $ofile - } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] - } - foreach item [my link list subordinate] { - lappend result {*}[$item compile-products] - } - return $result - } - - method generate-include-directory {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result [my define get include_dir] - foreach obj [my link list product] { - foreach path [$obj generate-include-directory] { - lappend result $path - } - } - return $result - } - - method generate-debug {{spaces {}}} { - set result {} - ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" - foreach item [my link list subordinate] { - practcl::cputs result [$item generate-debug "$spaces "] - } - return $result - } - - # Empty template methods - method generate-cheader {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct cstruct methods tcltype tclprocs - set result {} - if {[info exists code(header)]} { - ::practcl::cputs result $code(header) - } - foreach obj [my link list product] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cheader */" - ::practcl::cputs result [$obj generate-cheader] - ::practcl::cputs result "/* END [$obj define get filename] generate-cheader */" - } - debug [list cfunct [info exists cfunct]] - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - if {[dict get $info public]} continue - ::practcl::cputs result "[dict get $info header]\;" - } - } - debug [list tclprocs [info exists tclprocs]] - if {[info exists tclprocs]} { - foreach {name info} $tclprocs { - if {[dict exists $info header]} { - ::practcl::cputs result "[dict get $info header]\;" - } - } - } - debug [list methods [info exists methods] [my define get cclass]] - - if {[info exists methods]} { - set thisclass [my define get cclass] - foreach {name info} $methods { - if {[dict exists $info header]} { - ::practcl::cputs result "[dict get $info header]\;" - } - } - # Add the initializer wrapper for the class - ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;" - } - return $result - } - - method generate-public-define {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code - set result {} - if {[info exists code(public-define)]} { - ::practcl::cputs result $code(public-define) - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-define] - } - return $result - } - - method generate-public-macro {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code - set result {} - if {[info exists code(public-macro)]} { - ::practcl::cputs result $code(public-macro) - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-macro] - } - return $result - } - - method generate-public-typedef {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cstruct - set result {} - if {[info exists code(public-typedef)]} { - ::practcl::cputs result $code(public-typedef) - } - if {[info exists cstruct]} { - # Add defintion for native c data structures - foreach {name info} $cstruct { - ::practcl::cputs result "typedef struct $name ${name}\;" - if {[dict exists $info aliases]} { - foreach n [dict get $info aliases] { - ::practcl::cputs result "typedef struct $name ${n}\;" - } - } - } - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-typedef] - } - return $result - } - - method generate-public-structure {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cstruct - set result {} - if {[info exists code(public-structure)]} { - ::practcl::cputs result $code(public-structure) - } - if {[info exists cstruct]} { - foreach {name info} $cstruct { - if {[dict exists $info comment]} { - ::practcl::cputs result [dict get $info comment] - } - ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" - } - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-structure] - } - return $result - } - method generate-public-headers {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code tcltype - set result {} - if {[info exists code(public-header)]} { - ::practcl::cputs result $code(public-header) - } - if {[info exists tcltype]} { - foreach {type info} $tcltype { - if {![dict exists $info cname]} { - set cname [string tolower ${type}]_tclobjtype - dict set tcltype $type cname $cname - } else { - set cname [dict get $info cname] - } - ::practcl::cputs result "extern const Tcl_ObjType $cname\;" - } - } - if {[info exists code(public)]} { - ::practcl::cputs result $code(public) - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-headers] - } - return $result - } - - method generate-stub-function {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct tcltype - set result {} - foreach mod [my link list product] { - foreach {funct def} [$mod generate-stub-function] { - dict set result $funct $def - } - } - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - if {![dict get $info export]} continue - dict set result $funcname [dict get $info header] - } - } - return $result - } - - method generate-public-function {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct tcltype - set result {} - - if {[my define get initfunc] ne {}} { - ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" - } - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - if {![dict get $info public]} continue - ::practcl::cputs result "[dict get $info header]\;" - } - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-public-function] - } - return $result - } - - method generate-public-includes {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set includes {} - foreach item [my define get public-include] { - if {$item ni $includes} { - lappend includes $item - } - } - foreach mod [my link list product] { - foreach item [$mod generate-public-includes] { - if {$item ni $includes} { - lappend includes $item - } - } - } - return $includes - } - method generate-public-verbatim {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set includes {} - foreach item [my define get public-verbatim] { - if {$item ni $includes} { - lappend includes $item - } - } - foreach mod [my link list subordinate] { - foreach item [$mod generate-public-verbatim] { - if {$item ni $includes} { - lappend includes $item - } - } - } - return $includes - } - ### - # This methods generates the contents of an amalgamated .h file - # which describes the public API of this module - ### - method generate-h {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - set includes [my generate-public-includes] - foreach inc $includes { - if {[string index $inc 0] ni {< \"}} { - ::practcl::cputs result "#include \"$inc\"" - } else { - ::practcl::cputs result "#include $inc" - } - } - foreach file [my generate-public-verbatim] { - ::practcl::cputs result "/* BEGIN $file */" - ::practcl::cputs result [::practcl::cat $file] - ::practcl::cputs result "/* END $file */" - } - foreach method { - generate-public-define - generate-public-macro - generate-public-typedef - generate-public-structure - generate-public-headers - generate-public-function - } { - ::practcl::cputs result "/* BEGIN SECTION $method */" - ::practcl::cputs result [my $method] - ::practcl::cputs result "/* END SECTION $method */" - } - return $result - } - - ### - # This methods generates the contents of an amalgamated .c file - # which implements the loader for a batch of tools - ### - method generate-c {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result { -/* This file was generated by practcl */ - } - set includes {} - lappend headers - if {[my define get tk 0]} { - lappend headers - } - lappend headers {*}[my define get include] - if {[my define get output_h] ne {}} { - lappend headers "\"[my define get output_h]\"" - } - foreach mod [my link list product] { - # Signal modules to formulate final implementation - $mod go - } - foreach mod [my link list dynamic] { - foreach inc [$mod define get include] { - if {$inc ni $headers} { - lappend headers $inc - } - } - } - foreach inc $headers { - if {[string index $inc 0] ni {< \"}} { - ::practcl::cputs result "#include \"$inc\"" - } else { - ::practcl::cputs result "#include $inc" - } - } - foreach {method} { - generate-cheader - generate-cstruct - generate-constant - generate-cfunct - generate-cmethod - } { - ::practcl::cputs result "/* BEGIN $method [my define get filename] */" - ::practcl::cputs result [my $method] - ::practcl::cputs result "/* END $method [my define get filename] */" - } - debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] - return $result - } - - - method generate-loader {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - if {[my define get initfunc] eq {}} return - ::practcl::cputs result " -extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" - ::practcl::cputs result { - /* Initialise the stubs tables. */ - #ifdef USE_TCL_STUBS - if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR; - if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR; -} - if {[my define get tk 0]} { - ::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;} - } - ::practcl::cputs result { #endif} - set TCLINIT [my generate-tcl] - ::practcl::cputs result " if(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR ;" - foreach item [my link list product] { - if {[$item define get output_c] ne {}} { - ::practcl::cputs result [$item generate-cinit-external] - } else { - ::practcl::cputs result [$item generate-cinit] - } - } - if {[my define exists pkg_name]} { - ::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" - } - ::practcl::cputs result " return TCL_OK\;\n\}\n" - return $result - } - - ### - # This methods generates any Tcl script file - # which is required to pre-initialize the C library - ### - method generate-tcl {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - my variable code - if {[info exists code(tcl)]} { - ::practcl::cputs result $code(tcl) - } - set result [::practcl::_tagblock $result tcl [my define get filename]] - foreach mod [my link list product] { - ::practcl::cputs result [$mod generate-tcl] - } - return $result - } - - method static-packages {} { - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] - if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] - if {$pkg_name ne {}} { - dict set result $pkg_name initfunc $initfunc - dict set result $pkg_name version [my define get version [my define get pkg_vers]] - dict set result $pkg_name autoload [my define get autoload 0] - } - } - foreach item [my link list subordinate] { - foreach {pkg info} [$item static-packages] { - dict set result $pkg $info - } - } - return $result - } - - method target {method args} { - switch $method { - is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] } - } - } - -} - -::oo::class create ::practcl::product { - superclass ::practcl::object - - method linktype {} { - return {subordinate product} - } - - method include header { - my define add include $header - } - - method cstructure {name definition {argdat {}}} { - my variable cstruct - dict set cstruct $name body $definition - foreach {f v} $argdat { - dict set cstruct $name $f $v - } - } - - method generate-cinit {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code - set result {} - if {[info exists code(cinit)]} { - ::practcl::cputs result $code(cinit) - } - if {[my define get initfunc] ne {}} { - ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach obj [my link list product] { - ::practcl::cputs result [$obj generate-cinit] - } - return $result - } -} - -### -# Dynamic blocks do not generate their own .c files, -# instead the contribute to the amalgamation -# of the main library file -### -::oo::class create ::practcl::dynamic { - superclass ::practcl::product - - # Retrieve any additional source files required - - method compile-products {} { - set filename [my define get output_c] - set result {} - if {$filename ne {}} { - if {[my define exists ofile]} { - set ofile [my define get ofile] - } else { - set ofile [my Ofile $filename] - my define set ofile $ofile - } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] - } else { - set filename [my define get cfile] - if {$filename ne {}} { - if {[my define exists ofile]} { - set ofile [my define get ofile] - } else { - set ofile [my Ofile $filename] - my define set ofile $ofile - } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] - } - } - foreach item [my link list subordinate] { - lappend result {*}[$item compile-products] - } - return $result - } - - method implement path { - my go - my Collate_Source $path - if {[my define get output_c] eq {}} return - set filename [file join $path [my define get output_c]] - my define set cfile $filename - set fout [open $filename w] - puts $fout [my generate-c] - puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" - puts $fout [my generate-cinit] - if {[my define get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" - } - puts $fout " return TCL_OK\;" - puts $fout "\x7D" - close $fout - } - - method initialize {} { - set filename [my define get filename] - if {$filename eq {}} { - return - } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] - } - if {[my define get localpath] eq {}} { - my define set localpath [my define get localpath]_[my define get name] - } - ::source $filename - } - - method linktype {} { - return {subordinate product dynamic} - } - - ### - # Populate const static data structures - ### - method generate-cstruct {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cstruct methods tcltype - set result {} - if {[info exists code(struct)]} { - ::practcl::cputs result $code(struct) - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result [$obj generate-cstruct] - } - return $result - } - - method generate-constant {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - my variable code cstruct methods tcltype - if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" - ::practcl::cputs result $code(constant) - } - if {[info exists cstruct]} { - foreach {name info} $cstruct { - set map {} - lappend map @NAME@ $name - lappend map @MACRO@ GET[string toupper $name] - - if {[dict exists $info deleteproc]} { - lappend map @DELETEPROC@ [dict get $info deleteproc] - } else { - lappend map @DELETEPROC@ NULL - } - if {[dict exists $info cloneproc]} { - lappend map @CLONEPROC@ [dict get $info cloneproc] - } else { - lappend map @CLONEPROC@ NULL - } - ::practcl::cputs result [string map $map { -const static Tcl_ObjectMetadataType @NAME@DataType = { - TCL_OO_METADATA_VERSION_CURRENT, - "@NAME@", - @DELETEPROC@, - @CLONEPROC@ -}; -#define @MACRO@(OBJCONTEXT) (@NAME@ *) Tcl_ObjectGetMetadata(OBJCONTEXT,&@NAME@DataType) -}] - } - } - if {[info exists tcltype]} { - foreach {type info} $tcltype { - dict with info {} - ::practcl::cputs result "const Tcl_ObjType $cname = \{\n .freeIntRepProc = &${freeproc},\n .dupIntRepProc = &${dupproc},\n .updateStringProc = &${updatestringproc},\n .setFromAnyProc = &${setfromanyproc}\n\}\;" - } - } - - if {[info exists methods]} { - set mtypes {} - foreach {name info} $methods { - set callproc [dict get $info callproc] - set methodtype [dict get $info methodtype] - if {$methodtype in $mtypes} continue - lappend mtypes $methodtype - ### - # Build the data struct for this method - ### - ::practcl::cputs result "const static Tcl_MethodType $methodtype = \{" - ::practcl::cputs result " .version = TCL_OO_METADATA_VERSION_CURRENT,\n .name = \"$name\",\n .callProc = $callproc," - if {[dict exists $info deleteproc]} { - set deleteproc [dict get $info deleteproc] - } else { - set deleteproc NULL - } - if {$deleteproc ni { {} NULL }} { - ::practcl::cputs result " .deleteProc = $deleteproc," - } else { - ::practcl::cputs result " .deleteProc = NULL," - } - if {[dict exists $info cloneproc]} { - set cloneproc [dict get $info cloneproc] - } else { - set cloneproc NULL - } - if {$cloneproc ni { {} NULL }} { - ::practcl::cputs result " .cloneProc = $cloneproc\n\}\;" - } else { - ::practcl::cputs result " .cloneProc = NULL\n\}\;" - } - dict set methods $name methodtype $methodtype - } - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result [$obj generate-constant] - } - return $result - } - - ### - # Generate code that provides subroutines called by - # Tcl API methods - ### - method generate-cfunct {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code cfunct - set result {} - if {[info exists code(funct)]} { - ::practcl::cputs result $code(funct) - } - if {[info exists cfunct]} { - foreach {funcname info} $cfunct { - ::practcl::cputs result "[dict get $info header]\{[dict get $info body]\}\;" - } - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { - continue - } - ::practcl::cputs result [$obj generate-cfunct] - } - return $result - } - - ### - # Generate code that provides implements Tcl API - # calls - ### - method generate-cmethod {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - my variable code methods tclprocs - set result {} - if {[info exists code(method)]} { - ::practcl::cputs result $code(method) - } - - if {[info exists tclprocs]} { - foreach {name info} $tclprocs { - if {![dict exists $info body]} continue - set callproc [dict get $info callproc] - set header [dict get $info header] - set body [dict get $info body] - ::practcl::cputs result "${header} \{${body}\}" - } - } - - - if {[info exists methods]} { - set thisclass [my define get cclass] - foreach {name info} $methods { - if {![dict exists $info body]} continue - set callproc [dict get $info callproc] - set header [dict get $info header] - set body [dict get $info body] - ::practcl::cputs result "${header} \{${body}\}" - } - # Build the OO_Init function - ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{" - ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my define get class]] { - /* - ** Build the "@TCLCLASS@" class - */ - Tcl_Obj* nameObj; /* Name of a class or method being looked up */ - Tcl_Object curClassObject; /* Tcl_Object representing the current class */ - Tcl_Class curClass; /* Tcl_Class representing the current class */ - - /* - * Find the "@TCLCLASS@" class, and attach an 'init' method to it. - */ - - nameObj = Tcl_NewStringObj("@TCLCLASS@", -1); - Tcl_IncrRefCount(nameObj); - if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) { - Tcl_DecrRefCount(nameObj); - return TCL_ERROR; - } - Tcl_DecrRefCount(nameObj); - curClass = Tcl_GetObjectAsClass(curClassObject); -}] - if {[dict exists $methods constructor]} { - set mtype [dict get $methods constructor methodtype] - ::practcl::cputs result [string map [list @MTYPE@ $mtype] { - /* Attach the constructor to the class */ - Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &@MTYPE@, NULL)); - }] - } - foreach {name info} $methods { - dict with info {} - if {$name in {constructor destructor}} continue - ::practcl::cputs result [string map [list @NAME@ $name @MTYPE@ $methodtype] { - nameObj=Tcl_NewStringObj("@NAME@",-1); - Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); - Tcl_DecrRefCount(nameObj); -}] - if {[dict exists $info aliases]} { - foreach alias [dict get $info aliases] { - if {[dict exists $methods $alias]} continue - ::practcl::cputs result [string map [list @NAME@ $alias @MTYPE@ $methodtype] { - nameObj=Tcl_NewStringObj("@NAME@",-1); - Tcl_NewMethod(interp, curClass, nameObj, 1, &@MTYPE@, (ClientData) NULL); - Tcl_DecrRefCount(nameObj); -}] - } - } - } - ::practcl::cputs result " return TCL_OK\;\n\}\n" - } - foreach obj [my link list dynamic] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue - ::practcl::cputs result [$obj generate-cmethod] - } - return $result - } - - method generate-cinit-external {} { - if {[my define get initfunc] eq {}} { - return "/* [my define get filename] declared not initfunc */" - } - return " if([my define get initfunc](interp)) return TCL_ERROR\;" - } - - ### - # Generate code that runs when the package/module is - # initialized into the interpreter - ### - method generate-cinit {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result {} - my variable code methods tclprocs - if {[info exists code(nspace)]} { - ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" - foreach nspace $code(nspace) { - ::practcl::cputs result [string map [list @NSPACE@ $nspace] { - modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); - if(!modPtr) { - modPtr = Tcl_CreateNamespace(interp, "@NSPACE@", NULL, NULL); - } -}] - } - ::practcl::cputs result " \}" - } - if {[info exists code(tclinit)]} { - ::practcl::cputs result $code(tclinit) - } - if {[info exists code(cinit)]} { - ::practcl::cputs result $code(cinit) - } - if {[info exists code(initfuncts)]} { - foreach func $code(initfuncts) { - ::practcl::cputs result " if (${func}(interp) != TCL_OK) return TCL_ERROR\;" - } - } - if {[info exists tclprocs]} { - foreach {name info} $tclprocs { - set map [list @NAME@ $name @CALLPROC@ [dict get $info callproc]] - ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] - if {[dict exists $info aliases]} { - foreach alias [dict get $info aliases] { - set map [list @NAME@ $alias @CALLPROC@ [dict get $info callproc]] - ::practcl::cputs result [string map $map { Tcl_CreateObjCommand(interp,"@NAME@",(Tcl_ObjCmdProc *)@CALLPROC@,NULL,NULL);}] - } - } - } - } - - if {[info exists code(nspace)]} { - ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" - foreach nspace $code(nspace) { - ::practcl::cputs result [string map [list @NSPACE@ $nspace] { - modPtr=Tcl_FindNamespace(interp,"@NSPACE@",NULL,TCL_NAMESPACE_ONLY); - Tcl_CreateEnsemble(interp, modPtr->fullName, modPtr, TCL_ENSEMBLE_PREFIX); - Tcl_Export(interp, modPtr, "[a-z]*", 1); -}] - } - ::practcl::cputs result " \}" - } - set result [::practcl::_tagblock $result c [my define get filename]] - foreach obj [my link list product] { - # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { - ::practcl::cputs result [$obj generate-cinit-external] - } else { - ::practcl::cputs result [$obj generate-cinit] - } - } - return $result - } - - method c_header body { - my variable code - ::practcl::cputs code(header) $body - } - - method c_code body { - my variable code - ::practcl::cputs code(funct) $body - } - method c_function {header body} { - my variable code cfunct - foreach regexp { - {(.*) ([a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} - {(.*) (\x2a[a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)} - } { - if {[regexp $regexp $header all keywords funcname arglist]} { - dict set cfunct $funcname header $header - dict set cfunct $funcname body $body - dict set cfunct $funcname keywords $keywords - dict set cfunct $funcname arglist $arglist - dict set cfunct $funcname public [expr {"static" ni $keywords}] - dict set cfunct $funcname export [expr {"STUB_EXPORT" in $keywords}] - - return - } - } - ::practcl::cputs code(header) "$header\;" - # Could not parse that block as a function - # append it verbatim to our c_implementation - ::practcl::cputs code(funct) "$header [list $body]" - } - - - method cmethod {name body {arginfo {}}} { - my variable methods code - foreach {f v} $arginfo { - dict set methods $name $f $v - } - dict set methods $name body "Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */ -$body" - } - - method c_tclproc_nspace nspace { - my variable code - if {![info exists code(nspace)]} { - set code(nspace) {} - } - if {$nspace ni $code(nspace)} { - lappend code(nspace) $nspace - } - } - - method c_tclproc_raw {name body {arginfo {}}} { - my variable tclprocs code - - foreach {f v} $arginfo { - dict set tclprocs $name $f $v - } - dict set tclprocs $name body $body - } - - method go {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - next - my variable methods code cstruct tclprocs - if {[info exists methods]} { - debug [self] methods [my define get cclass] - set thisclass [my define get cclass] - foreach {name info} $methods { - # Provide a callproc - if {![dict exists $info callproc]} { - set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]] - dict set methods $name callproc $callproc - } else { - set callproc [dict get $info callproc] - } - if {[dict exists $info body] && ![dict exists $info header]} { - dict set methods $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)" - } - if {![dict exists $info methodtype]} { - set methodtype [string map {{ } _ : _} MethodType_${thisclass}_${name}] - dict set methods $name methodtype $methodtype - } - } - if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { - lappend code(initfuncts) "${thisclass}_OO_Init" - } - } - set thisnspace [my define get nspace] - - if {[info exists tclprocs]} { - debug [self] tclprocs [dict keys $tclprocs] - foreach {name info} $tclprocs { - if {![dict exists $info callproc]} { - set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} Tclcmd_${thisnspace}_${name}]] - dict set tclprocs $name callproc $callproc - } else { - set callproc [dict get $info callproc] - } - if {[dict exists $info body] && ![dict exists $info header]} { - dict set tclprocs $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv\[\])" - } - } - } - debug [list /[self] [self method] [self class]] - } - - # Once an object marks itself as some - # flavor of dynamic, stop trying to morph - # it into something else - method select {} {} - - - method tcltype {name argdat} { - my variable tcltype - foreach {f v} $argdat { - dict set tcltype $name $f $v - } - if {![dict exists tcltype $name cname]} { - dict set tcltype $name cname [string tolower $name]_tclobjtype - } - lappend map @NAME@ $name - set info [dict get $tcltype $name] - foreach {f v} $info { - lappend map @[string toupper $f]@ $v - } - foreach {func fpat template} { - freeproc {@Name@Obj_freeIntRepProc} {void @FNAME@(Tcl_Obj *objPtr)} - dupproc {@Name@Obj_dupIntRepProc} {void @FNAME@(Tcl_Obj *srcPtr,Tcl_Obj *dupPtr)} - updatestringproc {@Name@Obj_updateStringRepProc} {void @FNAME@(Tcl_Obj *objPtr)} - setfromanyproc {@Name@Obj_setFromAnyProc} {int @FNAME@(Tcl_Interp *interp,Tcl_Obj *objPtr)} - } { - if {![dict exists $info $func]} { - error "$name does not define $func" - } - set body [dict get $info $func] - # We were given a function name to call - if {[llength $body] eq 1} continue - set fname [string map [list @Name@ [string totitle $name]] $fpat] - my c_function [string map [list @FNAME@ $fname] $template] [string map $map $body] - dict set tcltype $name $func $fname - } - } -} - -::oo::class create ::practcl::cheader { - superclass ::practcl::product - - method compile-products {} {} - method generate-cinit {} {} -} - -::oo::class create ::practcl::csource { - superclass ::practcl::product -} - -::oo::class create ::practcl::clibrary { - superclass ::practcl::product - - method linker-products {configdict} { - return [my define get filename] - } - -} - -### -# In the end, all C code must be loaded into a module -# This will either be a dynamically loaded library implementing -# a tcl extension, or a compiled in segment of a custom shell/app -### -::oo::class create ::practcl::module { - superclass ::practcl::dynamic - - method child which { - switch $which { - organs { - return [list project [my define get project] module [self]] - } - } - } - - method initialize {} { - set filename [my define get filename] - if {$filename eq {}} { - return - } - if {[my define get name] eq {}} { - my define set name [file tail [file dirname $filename]] - } - if {[my define get localpath] eq {}} { - my define set localpath [my define get name]_[my define get name] - } - debug [self] SOURCE $filename - my source $filename - } - - method implement path { - my go - my Collate_Source $path - foreach item [my link list dynamic] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - foreach item [my link list module] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set filename [my define get output_c] - if {$filename eq {}} { - debug [list /[self] [self method] [self class]] - return - } - set cout [open [file join $path [file rootname $filename].c] w] - puts $cout [subst {/* -** This file is generated by the [info script] script -** any changes will be overwritten the next time it is run -*/}] - puts $cout [my generate-c] - puts $cout [my generate-loader] - close $cout - debug [list /[self] [self method] [self class]] - } - - method linktype {} { - return {subordinate product dynamic module} - } -} - -::oo::class create ::practcl::autoconf { - - ### - # find or fake a key/value list describing this project - ### - method config.sh {} { - my variable conf_result - if {[info exists conf_result]} { - return $conf_result - } - set result {} - set name [my define get name] - set PWD $::CWD - set builddir [my define get builddir] - my unpack - set srcroot [my define get srcroot] - if {![file exists $builddir]} { - my Configure - } - set filename [file join $builddir config.tcl] - # Project uses the practcl template. Use the leavings from autoconf - if {[file exists $filename]} { - set dat [::practcl::config.tcl $builddir] - foreach {item value} [lsort -stride 2 -dictionary $dat] { - dict set result $item $value - } - set conf_result $result - return $result - } - set filename [file join $builddir ${name}Config.sh] - if {[file exists $filename]} { - set l [expr {[string length $name]+1}] - foreach {field dat} [::practcl::read_Config.sh $filename] { - set field [string tolower $field] - if {[string match ${name}_* $field]} { - set field [string range $field $l end] - } - dict set result $field $dat - } - set conf_result $result - return $result - } - ### - # Oh man... we have to guess - ### - set filename [file join $builddir Makefile] - if {![file exists $filename]} { - error "Could not locate any configuration data in $srcroot" - } - foreach {field dat} [::practcl::read_Makefile $filename] { - dict set result $field $dat - } - set conf_result $result - cd $PWD - return $result - } -} - - -::oo::class create ::practcl::project { - superclass ::practcl::module ::practcl::autoconf - - constructor args { - my variable define - if {[llength $args] == 1} { - if {[catch {uplevel 1 [list subst [lindex $args 0]]} contents]} { - set contents [lindex $args 0] - } - } else { - if {[catch {uplevel 1 [list subst $args]} contents]} { - set contents $args - } - } - array set define $contents - my select - my initialize - } - - - method add_project {pkg info {oodefine {}}} { - set os [my define get os] - if {$os eq {}} { - set os [::practcl::os] - my define set os $os - } - set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] - if {[dict exists $info os] && ($os ni [dict get $info os])} return - # Select which tag to use here. - # For production builds: tag-release - if {[::info exists ::env(FOSSIL_MIRROR)]} { - dict set info localmirror $::env(FOSSIL_MIRROR) - } - set profile [my define get profile release]: - if {[dict exists $info profile $profile]} { - dict set info tag [dict get $info profile $profile] - } - set obj [namespace current]::PROJECT.$pkg - if {[info command $obj] eq {}} { - set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]] - } - my link object $obj - oo::objdefine $obj $oodefine - $obj define set masterpath $::CWD - $obj go - return $obj - } - - method child which { - switch $which { - organs { - # A library can be a project, it can be a module. Any - # subordinate modules will indicate their existance - return [list project [self] module [self]] - } - } - } - - method linktype {} { - return project - } - - # Exercise the methods of a sub-object - method project {pkg args} { - set obj [namespace current]::PROJECT.$pkg - if {[llength $args]==0} { - return $obj - } - tailcall ${obj} {*}$args - } -} - -::oo::class create ::practcl::library { - superclass ::practcl::project - - method compile-products {} { - set result {} - foreach item [my link list subordinate] { - lappend result {*}[$item compile-products] - } - set filename [my define get output_c] - if {$filename ne {}} { - set ofile [file rootname [file tail $filename]]_main.o - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] - } - return $result - } - - method generate-tcl-loader {} { - set result {} - set PKGINIT [my define get pkginit] - set PKG_NAME [my define get name [my define get pkg_name]] - set PKG_VERSION [my define get pkg_vers [my define get version]] - if {[string is true [my define get SHARED_BUILD 0]]} { - set LIBFILE [my define get libfile] - ::practcl::cputs result [string map \ - [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { -# Shared Library Style -load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ -package provide @PKG_NAME@ @PKG_VERSION@ -}] - } else { - ::practcl::cputs result [string map \ - [list @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { -# Tclkit Style -load {} @PKGINIT@ -package provide @PKG_NAME@ @PKG_VERSION@ -}] - } - return $result - } - - method go {} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set name [my define getnull name] - if {$name eq {}} { - set name generic - my define name generic - } - if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { - my define set tk 0 - } - set output_c [my define getnull output_c] - if {$output_c eq {}} { - set output_c [file rootname $name].c - my define set output_c $output_c - } - set output_h [my define getnull output_h] - if {$output_h eq {}} { - set output_h [file rootname $output_c].h - my define set output_h $output_h - } - set output_tcl [my define getnull output_tcl] - #if {$output_tcl eq {}} { - # set output_tcl [file rootname $output_c].tcl - # my define set output_tcl $output_tcl - #} - #set output_mk [my define getnull output_mk] - #if {$output_mk eq {}} { - # set output_mk [file rootname $output_c].mk - # my define set output_mk $output_mk - #} - set initfunc [my define getnull initfunc] - if {$initfunc eq {}} { - set initfunc [string totitle $name]_Init - my define set initfunc $initfunc - } - set output_decls [my define getnull output_decls] - if {$output_decls eq {}} { - set output_decls [file rootname $output_c].decls - my define set output_decls $output_decls - } - my variable links - foreach {linktype objs} [array get links] { - foreach obj $objs { - $obj go - } - } - debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] - } - - method implement path { - my go - my Collate_Source $path - foreach item [my link list dynamic] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - foreach item [my link list module] { - if {[catch {$item implement $path} err]} { - puts "Skipped $item: $err" - } - } - set cout [open [file join $path [my define get output_c]] w] - puts $cout [subst {/* -** This file is generated by the [info script] script -** any changes will be overwritten the next time it is run -*/}] - puts $cout [my generate-c] - puts $cout [my generate-loader] - close $cout - - set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H - set hout [open [file join $path [my define get output_h]] w] - puts $hout [subst {/* -** This file is generated by the [info script] script -** any changes will be overwritten the next time it is run -*/}] - puts $hout "#ifndef ${macro}" - puts $hout "#define ${macro}" - puts $hout [my generate-h] - puts $hout "#endif" - close $hout - - set output_tcl [my define get output_tcl] - if {$output_tcl ne {}} { - set tclout [open [file join $path [my define get output_tcl]] w] - puts $tclout "### -# This file is generated by the [info script] script -# any changes will be overwritten the next time it is run -###" - puts $tclout [my generate-tcl] - puts $tclout [my generate-tcl-loader] - close $tclout - } - } - - method generate-decls {pkgname path} { - debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set outfile [file join $path/$pkgname.decls] - - ### - # Build the decls file - ### - set fout [open $outfile w] - puts $fout [subst {### - # $outfile - # - # This file was generated by [info script] - ### - - library $pkgname - interface $pkgname - }] - - ### - # Generate list of functions - ### - set stubfuncts [my generate-stub-function] - set thisline {} - set functcount 0 - foreach {func header} $stubfuncts { - puts $fout [list declare [incr functcount] $header] - } - puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"] - puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] - - close $fout - - ### - # Build [package]Decls.h - ### - set hout [open [file join $path ${pkgname}Decls.h] w] - - close $hout - - set cout [open [file join $path ${pkgname}StubInit.c] w] -puts $cout [string map [list %pkgname% $pkgname %PkgName% [string totitle $pkgname]] { -#ifndef USE_TCL_STUBS -#define USE_TCL_STUBS -#endif -#undef USE_TCL_STUB_PROCS - -#include "tcl.h" -#include "%pkgname%.h" - - /* - ** Ensure that Tdom_InitStubs is built as an exported symbol. The other stub - ** functions should be built as non-exported symbols. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -%PkgName%Stubs *%pkgname%StubsPtr; - - /* - **---------------------------------------------------------------------- - ** - ** %PkgName%_InitStubs -- - ** - ** Checks that the correct version of %PkgName% is loaded and that it - ** supports stubs. It then initialises the stub table pointers. - ** - ** Results: - ** The actual version of %PkgName% that satisfies the request, or - ** NULL to indicate that an error occurred. - ** - ** Side effects: - ** Sets the stub table pointers. - ** - **---------------------------------------------------------------------- - */ - -char * -%PkgName%_InitStubs (Tcl_Interp *interp, char *version, int exact) -{ - char *actualVersion; - actualVersion = Tcl_PkgRequireEx(interp, "%pkgname%", version, exact,(ClientData *) &%pkgname%StubsPtr); - if (!actualVersion) { - return NULL; - } - if (!%pkgname%StubsPtr) { - Tcl_SetResult(interp,"This implementation of %PkgName% does not support stubs",TCL_STATIC); - return NULL; - } - return actualVersion; -} -}] - close $cout - } - - # Backward compadible call - method generate-make path { - ::practcl::build::Makefile $path [self] - } - - method install-headers {} { - set result {} - return $result - } - - method linktype {} { - return library - } - - # Create a "package ifneeded" - # Args are a list of aliases for which this package will answer to - method package-ifneeded {args} { - set result {} - set name [my define get pkg_name [my define get name]] - set version [my define get pkg_vers [my define get version]] - if {$version eq {}} { - set version 0.1a - } - set output_tcl [my define get output_tcl] - if {$output_tcl ne {}} { - set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[string is true -strict [my define get SHARED_BUILD]]} { - set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" - } else { - # Provide a null passthrough - set script [list package provide $name $version] - } - set result "package ifneeded [list $name] [list $version] $script" - foreach alias $args { - set script "package require $name $version \; package provide $alias $version" - append result \n\n [list package ifneeded $alias $version $script] - } - return $result - } - - - method shared_library {} { - set name [string tolower [my define get name [my define get pkg_name]]] - set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] - set map {} - lappend map %LIBRARY_NAME% $name - lappend map %LIBRARY_VERSION% $version - lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] - lappend map %LIBRARY_PREFIX% [my define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] - return $outfile - } -} - -::oo::class create ::practcl::tclkit { - superclass ::practcl::library - - method Collate_Source CWD { - my define set SHARED_BUILD 0 - set name [my define get name] - - if {![my define exists TCL_LOCAL_APPINIT]} { - my define set TCL_LOCAL_APPINIT Tclkit_AppInit - } - if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook - } - - set PROJECT [self] - set os [$PROJECT define get os] - set TCLOBJ [$PROJECT project TCLCORE] - set TKOBJ [$PROJECT project TKCORE] - set ODIEOBJ [$PROJECT project odie] - - set TCLSRCDIR [$TCLOBJ define get srcroot] - set TKSRCDIR [$TKOBJ define get srcroot] - set PKG_OBJS {} - foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { - lappend PKG_OBJS $item - } - } - # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK - if {$os eq "windows"} { - set PLATFORM_SRC_DIR win - my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 - my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 - my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] - } else { - set PLATFORM_SRC_DIR unix - my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]] - } - - ### - # Pre 8.7, Tcl doesn't include a Zipfs implementation - # in the core. Grab the one from odielib - ### - set zipfs [file join $TCLSRCDIR generic tclZipfs.c] - if {[file exists $zipfs]} { - my define set CORE_ZIPFS 1 - } else { - ### - # Add local static Zlib implementation - ### - set cdir [file join $TCLSRCDIR compat zlib] - foreach file { - adler32.c compress.c crc32.c - deflate.c infback.c inffast.c - inflate.c inftrees.c trees.c - uncompr.c zutil.c - } { - my add [file join $cdir $file] - } - # The Odie project maintains a mirror of the version - # released with the Tcl core - my define set CORE_ZIPFS 0 - my add_project odie { - tag trunk - class subproject - vfsinstall 0 - } - my project odie unpack - set ODIESRCROOT [my project odie define get srcroot] - set cdir [file join $ODIESRCROOT compat zipfs] - my define add include_dir $cdir - set zipfs [file join $cdir zvfs.c] - my add class csource filename $zipfs initfunc Tclzipfs_Init pkg_name zipfs pkg_vers 1.0 autoload 1 - } - - - my define add include_dir [file join $TKSRCDIR generic] - my define add include_dir [file join $TKSRCDIR $PLATFORM_SRC_DIR] - my define add include_dir [file join $TKSRCDIR bitmaps] - my define add include_dir [file join $TKSRCDIR xlib] - my define add include_dir [file join $TCLSRCDIR generic] - my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] - my define add include_dir [file join $TCLSRCDIR compat zlib] - # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK - ::practcl::build::tclkit_main $PROJECT $PKG_OBJS - } - - ## Wrap an executable - # - method wrap {PWD exename vfspath args} { - cd $PWD - if {![file exists $vfspath]} { - file mkdir $vfspath - } - foreach item [my link list core.library] { - set name [$item define get name] - set libsrcroot [$item define get srcroot] - if {[file exists [file join $libsrcroot library]]} { - ::practcl::copyDir [file join $libsrcroot library] [file join $vfspath boot $name] - } - } - if {[my define get installdir] ne {}} { - ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] - } - foreach arg $args { - ::practcl::copyDir $arg $vfspath - } - - set fout [open [file join $vfspath packages.tcl] w] - puts $fout { - set ::PKGIDXFILE [info script] - set dir [file dirname $::PKGIDXFILE] - } - #set BASEVFS [my define get BASEVFS] - set EXEEXT [my define get EXEEXT] - - set tclkit_bare [my define get tclkit_bare] - - set buffer [::practcl::pkgindex_path $vfspath] - puts $fout $buffer - puts $fout { - # Advertise statically linked packages - foreach {pkg script} [array get ::kitpkg] { - eval $script - } - } - close $fout - package require zipfile::mkzip - ::zipfile::mkzip::mkzip ${exename}${EXEEXT} -runtime $tclkit_bare -directory $vfspath - if { [my define get platform] ne "windows" } { - file attributes ${exename}${EXEEXT} -permissions a+x - } - } -} - -### -# Meta repository -# The default is an inert source code block -### -oo::class create ::practcl::subproject { - superclass ::practcl::object - - method compile {} {} - - method go {} { - set platform [my define get platform] - my define get USEMSVC [my define get USEMSVC] - set name [my define get name] - if {![my define exists srcroot]} { - my define set srcroot [file join [my define get sandbox] $name] - } - set srcroot [my define get srcroot] - my define set localsrcdir $srcroot - my define add include_dir [file join $srcroot generic] - my sources - } - - # Install project into the local build system - method install-local {} { - my unpack - } - - # Install project into the virtual file system - method install-vfs {} {} - - method linktype {} { - return {subordinate package} - } - - method linker-products {configdict} {} - - method linker-external {configdict} { - if {[dict exists $configdict PRACTCL_LIBS]} { - return [dict get $configdict PRACTCL_LIBS] - } - } - - method sources {} {} - - method unpack {} { - set name [my define get name] - puts [list $name [self] UNPACK] - my define set [::practcl::fossil_sandbox $name [my define dump]] - } - - method update {} { - set name [my define get name] - my define set [::practcl::fossil_sandbox $name [dict merge [my define dump] {update 1}]] - } -} - -### -# A project which the kit compiles and integrates -# the source for itself -### -oo::class create ::practcl::subproject.source { - superclass ::practcl::subproject ::practcl::library - - method linktype {} { - return {subordinate package source} - } - -} - -# a copy from the teapot -oo::class create ::practcl::subproject.teapot { - superclass ::practcl::subproject - - method install-local {} { - my install-vfs - } - - method install-vfs {} { - set pkg [my define get pkg_name [my define get name]] - set download [my define get download] - my unpack - set DEST [my define get installdir] - set prefix [string trimleft [my define get prefix] /] - # Get tcllib from our destination - set dir [file join $DEST $prefix lib tcllib] - source [file join $DEST $prefix lib tcllib pkgIndex.tcl] - package require zipfile::decode - ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] - } -} - -oo::class create ::practcl::subproject.sak { - superclass ::practcl::subproject - - method install-local {} { - my install-vfs - } - - method install-vfs {} { - ### - # Handle teapot installs - ### - set pkg [my define get pkg_name [my define get name]] - my unpack - set DEST [my define get installdir] - set prefix [string trimleft [my define get prefix] /] - set srcroot [my define get srcroot] - ::dotclexec [file join $srcroot installer.tcl] \ - -pkg-path [file join $DEST $prefix lib $pkg] \ - -no-examples -no-html -no-nroff \ - -no-wait -no-gui -no-apps - } -} - -### -# A binary package -### -oo::class create ::practcl::subproject.binary { - superclass ::practcl::subproject ::practcl::autoconf - - - method compile-products {} {} - - method ConfigureOpts {} { - set opts {} - set builddir [my define get builddir] - if {[my define get broken_destroot 0]} { - set PREFIX [my define get prefix_broken_destdir] - } else { - set PREFIX [my define get prefix] - } - if {[my define get HOST] != [my define get TARGET]} { - lappend opts --host=[my define get TARGET] - } - if {[my define exists tclsrcdir]} { - set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir]]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tclsrcdir] .. generic]]] - lappend opts --with-tcl=$TCLSRCDIR --with-tclinclude=$TCLGENERIC - } - if {[my define exists tksrcdir]} { - set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir]]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my define get tksrcdir] .. generic]]] - lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC - } - lappend opts {*}[my define get config_opts] - lappend opts --prefix=$PREFIX - #--exec_prefix=$PREFIX - #if {$::tcl_platform(platform) eq "windows"} { - # lappend opts --disable-64bit - #} - if {[my define get static 1]} { - lappend opts --disable-shared --disable-stubs - # - } else { - lappend opts --enable-shared - } - return $opts - } - - method go {} { - next - my define set builddir [my BuildDir [my define get masterpath]] - } - - method linker-products {configdict} { - if {![my define get static 0]} { - return {} - } - set srcdir [my define get builddir] - if {[dict exists $configdict libfile]} { - return " [file join $srcdir [dict get $configdict libfile]]" - } - } - - method static-packages {} { - if {![my define get static 0]} { - return {} - } - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] - if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] - if {$pkg_name ne {}} { - dict set result $pkg_name initfunc $initfunc - set version [my define get version] - if {$version eq {}} { - set info [my config.sh] - set version [dict get $info version] - set pl {} - if {[dict exists $info patch_level]} { - set pl [dict get $info patch_level] - append version $pl - } - my define set version $version - } - dict set result $pkg_name version $version - dict set result $pkg_name autoload [my define get autoload 0] - } - } - foreach item [my link list subordinate] { - foreach {pkg info} [$item static-packages] { - dict set result $pkg $info - } - } - return $result - } - - method BuildDir {PWD} { - set name [my define get name] - return [my define get builddir [file join $PWD pkg.$name]] - } - - method compile {} { - set name [my define get name] - set PWD $::CWD - cd $PWD - my go - set srcroot [file normalize [my define get srcroot]] - my Collate_Source $PWD - - ### - # Build a starter VFS for both Tcl and wish - ### - set srcroot [my define get srcroot] - if {[my define get static 1]} { - puts "BUILDING Static $name $srcroot" - } else { - puts "BUILDING Dynamic $name $srcroot" - } - if {[my define get USEMSVC 0]} { - cd $srcroot - doexec nmake -f makefile.vc INSTALLDIR=[my define get installdir] release - } else { - cd $::CWD - set builddir [file normalize [my define get builddir]] - file mkdir $builddir - if {![file exists [file join $builddir Makefile]]} { - my Configure - } - if {[file exists [file join $builddir make.tcl]]} { - domake.tcl $builddir library - } else { - domake $builddir all - } - } - cd $PWD - } - - - method Configure {} { - cd $::CWD - my unpack - my TeaConfig - set builddir [file normalize [my define get builddir]] - file mkdir $builddir - set srcroot [file normalize [my define get srcroot]] - if {[my define get USEMSVC 0]} { - return - } - set opts [my ConfigureOpts] - puts [list [self] CONFIGURE] - puts [list PWD [pwd]] - puts [list LOCALSRC $srcroot] - puts [list BUILDDIR $builddir] - puts [list CONFIGURE {*}$opts] - cd $builddir - exec sh [file join $srcroot configure] {*}$opts >& [file join $builddir practcl.log] - cd $::CWD - } - - method install-vfs {} { - set PWD [pwd] - set PKGROOT [my define get installdir] - set PREFIX [my define get prefix] - - ### - # Handle teapot installs - ### - set pkg [my define get pkg_name [my define get name]] - if {[my define get teapot] ne {}} { - set TEAPOT [my define get teapot] - set found 0 - foreach ver [my define get pkg_vers [my define get version]] { - set teapath [file join $TEAPOT $pkg$ver] - if {[file exists $teapath]} { - set dest [file join $PKGROOT [string trimleft $PREFIX /] lib [file tail $teapath]] - ::practcl::copyDir $teapath $dest - return - } - } - } - my compile - if {[my define get USEMSVC 0]} { - set srcroot [my define get srcroot] - cd $srcroot - puts "[self] VFS INSTALL $PKGROOT" - doexec nmake -f makefile.vc INSTALLDIR=$PKGROOT install - } else { - set builddir [my define get builddir] - if {[file exists [file join $builddir make.tcl]]} { - # Practcl builds can inject right to where we need them - puts "[self] VFS INSTALL $PKGROOT (Practcl)" - domake.tcl $builddir install-package $PKGROOT - } elseif {[my define get broken_destroot 0] == 0} { - # Most modern TEA projects understand DESTROOT in the makefile - puts "[self] VFS INSTALL $PKGROOT (TEA)" - domake $builddir install DESTDIR=$PKGROOT - } else { - # But some require us to do an install into a fictitious filesystem - # and then extract the gooey parts within. - # (*cough*) TkImg - set PREFIX [my define get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my define get prefix_broken_destdir]] - file delete -force $BROKENROOT - file mkdir $BROKENROOT - domake $builddir $install - ::practcl::copyDir $BROKENROOT [file join $PKGROOT [string trimleft $PREFIX /]] - file delete -force $BROKENROOT - } - } - cd $PWD - } - - method TeaConfig {} { - set srcroot [file normalize [my define get srcroot]] - set copytea 0 - if {![file exists [file join $srcroot tclconfig]]} { - set copytea 1 - } else { - if {![file exists [file join $srcroot tclconfig practcl.tcl]] || ![file exists [file join $srcroot tclconfig config.tcl.in]]} { - set copytea 1 - } - } - # ensure we have tclconfig with all of the trimming - if {$copytea} { - set tclconfiginfo [::practcl::fossil_sandbox tclconfig [list sandbox [my define get sandbox]]] - ::practcl::copyDir [dict get $tclconfiginfo srcroot] [file join $srcroot tclconfig] - if {$::tcl_platform(platform) ne "windows"} { - set pwd [pwd] - cd $srcroot - # On windows there's no practical way to execute - # autoconf. We'll have to trust that configure - # us up to date - foreach template {configure.ac configure.in} { - set input [file join $srcroot $template] - if {[file exists $input]} { - puts "autoconf -f $input > [file join $srcroot configure]" - exec autoconf -f $input > [file join $srcroot configure] - } - } - cd $pwd - } - } - } -} - -oo::class create ::practcl::subproject.core { - superclass ::practcl::subproject.binary - - # On the windows platform MinGW must build - # from the platform directory in the source repo - method BuildDir {PWD} { - return [my define get localsrcdir] - } - - method Configure {} { - if {[my define get USEMSVC 0]} { - return - } - set opts [my ConfigureOpts] - puts [list PWD [pwd]] - puts [list [self] CONFIGURE] - set builddir [file normalize [my define get builddir]] - set localsrcdir [file normalize [my define get localsrcdir]] - puts [list LOCALSRC $localsrcdir] - puts [list BUILDDIR $builddir] - puts [list CONFIGURE {*}$opts] - cd $localsrcdir - exec sh [file join $localsrcdir configure] {*}$opts >& [file join $builddir practcl.log] - } - - method ConfigureOpts {} { - set opts {} - set builddir [file normalize [my define get builddir]] - set PREFIX [my define get prefix] - if {[my define get HOST] != [my define get TARGET]} { - lappend opts --host=[my define get TARGET] - } - lappend opts {*}[my define get config_opts] - lappend opts --prefix=$PREFIX - #--exec_prefix=$PREFIX - lappend opts --disable-shared - return $opts - } - - method go {} { - set name [my define get name] - set platform [my define get platform] - if {![my define exists srcroot]} { - my define set srcroot [file join [my define get sandbox] $name] - } - set srcroot [my define get srcroot] - my define add include_dir [file join $srcroot generic] - switch $platform { - windows { - my define set localsrcdir [file join $srcroot win] - my define add include_dir [file join $srcroot win] - } - default { - my define set localsrcdir [file join $srcroot unix] - my define add include_dir [file join $srcroot $name unix] - } - } - my define set builddir [my BuildDir [my define get masterpath]] - } - - method linktype {} { - return {subordinate core.library} - } -} - -package provide practcl 0.5 diff --git a/library/zvfstools/pkgIndex.tcl b/library/zvfstools/pkgIndex.tcl deleted file mode 100644 index 824d5b3..0000000 --- a/library/zvfstools/pkgIndex.tcl +++ /dev/null @@ -1 +0,0 @@ -package ifneeded zvfstools 0.1 [list source [file join $dir zvfstools.tcl]] diff --git a/library/zvfstools/zvfstools.tcl b/library/zvfstools/zvfstools.tcl deleted file mode 100644 index 274d5a1..0000000 --- a/library/zvfstools/zvfstools.tcl +++ /dev/null @@ -1,325 +0,0 @@ -# -*- tcl -*- -# ### ### ### ######### ######### ######### -## Copyright (c) 2008-2009 ActiveState Software Inc. -## Andreas Kupries -## Copyright (C) 2009 Pat Thoyts -## Copyright (C) 2014 Sean Woods -## -## BSD License -## -# Package providing commands for: -# * the generation of a zip archive, -# * building a zip archive from a file system -# * building a file system from a zip archive - -package require Tcl 8.6 -# Cop -# -# Create ZIP archives in Tcl. -# -# Create a zipkit using mkzip filename.zkit -zipkit -directory xyz.vfs -# or a zipfile using mkzip filename.zip -directory dirname -exclude "*~" -# - -namespace eval ::zvfs {} - -proc ::zvfs::setbinary chan { - fconfigure $chan \ - -encoding binary \ - -translation binary \ - -eofchar {} - -} - -# zip::timet_to_dos -# -# Convert a unix timestamp into a DOS timestamp for ZIP times. -# -# DOS timestamps are 32 bits split into bit regions as follows: -# 24 16 8 0 -# +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ -# |Y|Y|Y|Y|Y|Y|Y|m| |m|m|m|d|d|d|d|d| |h|h|h|h|h|m|m|m| |m|m|m|s|s|s|s|s| -# +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ -# -proc ::zvfs::timet_to_dos {time_t} { - set s [clock format $time_t -format {%Y %m %e %k %M %S}] - scan $s {%d %d %d %d %d %d} year month day hour min sec - expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) - | ($hour << 11) | ($min << 5) | ($sec >> 1)} -} - -# zip::pop -- -# -# Pop an element from a list -# -proc ::zvfs::pop {varname {nth 0}} { - upvar $varname args - set r [lindex $args $nth] - set args [lreplace $args $nth $nth] - return $r -} - -# zip::walk -- -# -# Walk a directory tree rooted at 'path'. The excludes list can be -# a set of glob expressions to match against files and to avoid. -# The match arg is internal. -# eg: walk library {CVS/* *~ .#*} to exclude CVS and emacs cruft. -# -proc ::zvfs::walk {base {excludes ""} {match *} {path {}}} { - set result {} - set imatch [file join $path $match] - set files [glob -nocomplain -tails -types f -directory $base $imatch] - foreach file $files { - set excluded 0 - foreach glob $excludes { - if {[string match $glob $file]} { - set excluded 1 - break - } - } - if {!$excluded} {lappend result $file} - } - foreach dir [glob -nocomplain -tails -types d -directory $base $imatch] { - lappend result $dir - set subdir [walk $base $excludes $match $dir] - if {[llength $subdir]>0} { - set result [concat $result [list $dir] $subdir] - } - } - return $result -} - -# zvfs::add_file_to_archive -- -# -# Add a single file to a zip archive. The zipchan channel should -# already be open and binary. You may provide a comment for the -# file The return value is the central directory record that -# will need to be used when finalizing the zip archive. -# -# FIX ME: should handle the current offset for non-seekable channels -# -proc ::zvfs::add_file_to_archive {zipchan base path {comment ""}} { - set fullpath [file join $base $path] - set mtime [timet_to_dos [file mtime $fullpath]] - if {[file isdirectory $fullpath]} { - append path / - } - set utfpath [encoding convertto utf-8 $path] - set utfcomment [encoding convertto utf-8 $comment] - set flags [expr {(1<<11)}] ;# utf-8 comment and path - set method 0 ;# store 0, deflate 8 - set attr 0 ;# text or binary (default binary) - set version 20 ;# minumum version req'd to extract - set extra "" - set crc 0 - set size 0 - set csize 0 - set data "" - set seekable [expr {[tell $zipchan] != -1}] - if {[file isdirectory $fullpath]} { - set attrex 0x41ff0010 ;# 0o040777 (drwxrwxrwx) - } elseif {[file executable $fullpath]} { - set attrex 0x81ff0080 ;# 0o100777 (-rwxrwxrwx) - } else { - set attrex 0x81b60020 ;# 0o100666 (-rw-rw-rw-) - if {[file extension $fullpath] in {".tcl" ".txt" ".c"}} { - set attr 1 ;# text - } - } - - if {[file isfile $fullpath]} { - set size [file size $fullpath] - if {!$seekable} {set flags [expr {$flags | (1 << 3)}]} - } - - set offset [tell $zipchan] - set local [binary format a4sssiiiiss PK\03\04 \ - $version $flags $method $mtime $crc $csize $size \ - [string length $utfpath] [string length $extra]] - append local $utfpath $extra - puts -nonewline $zipchan $local - - if {[file isfile $fullpath]} { - # If the file is under 2MB then zip in one chunk, otherwize we use - # streaming to avoid requiring excess memory. This helps to prevent - # storing re-compressed data that may be larger than the source when - # handling PNG or JPEG or nested ZIP files. - if {$size < 0x00200000} { - set fin [::open $fullpath rb] - setbinary $fin - set data [::read $fin] - set crc [::zlib crc32 $data] - set cdata [::zlib deflate $data] - if {[string length $cdata] < $size} { - set method 8 - set data $cdata - } - close $fin - set csize [string length $data] - puts -nonewline $zipchan $data - } else { - set method 8 - set fin [::open $fullpath rb] - setbinary $fin - set zlib [::zlib stream deflate] - while {![eof $fin]} { - set data [read $fin 4096] - set crc [zlib crc32 $data $crc] - $zlib put $data - if {[string length [set zdata [$zlib get]]]} { - incr csize [string length $zdata] - puts -nonewline $zipchan $zdata - } - } - close $fin - $zlib finalize - set zdata [$zlib get] - incr csize [string length $zdata] - puts -nonewline $zipchan $zdata - $zlib close - } - - if {$seekable} { - # update the header if the output is seekable - set local [binary format a4sssiiii PK\03\04 \ - $version $flags $method $mtime $crc $csize $size] - set current [tell $zipchan] - seek $zipchan $offset - puts -nonewline $zipchan $local - seek $zipchan $current - } else { - # Write a data descriptor record - set ddesc [binary format a4iii PK\7\8 $crc $csize $size] - puts -nonewline $zipchan $ddesc - } - } - - set hdr [binary format a4ssssiiiisssssii PK\01\02 0x0317 \ - $version $flags $method $mtime $crc $csize $size \ - [string length $utfpath] [string length $extra]\ - [string length $utfcomment] 0 $attr $attrex $offset] - append hdr $utfpath $extra $utfcomment - return $hdr -} - -# zvfs::mkzip -- -# -# Create a zip archive in 'filename'. If a file already exists it will be -# overwritten by a new file. If '-directory' is used, the new zip archive -# will be rooted in the provided directory. -# -runtime can be used to specify a prefix file. For instance, -# zip myzip -runtime unzipsfx.exe -directory subdir -# will create a self-extracting zip archive from the subdir/ folder. -# The -comment parameter specifies an optional comment for the archive. -# -# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt -# -proc ::zvfs::mkzip {filename args} { - array set opts { - -zipkit 0 -runtime "" -comment "" -directory "" - -exclude {CVS/* */CVS/* *~ ".#*" "*/.#*"} - } - - while {[string match -* [set option [lindex $args 0]]]} { - switch -exact -- $option { - -zipkit { set opts(-zipkit) 1 } - -comment { set opts(-comment) [encoding convertto utf-8 [pop args 1]] } - -runtime { set opts(-runtime) [pop args 1] } - -directory {set opts(-directory) [file normalize [pop args 1]] } - -exclude {set opts(-exclude) [pop args 1] } - -- { pop args ; break } - default { - break - } - } - pop args - } - - set zf [::open $filename wb] - setbinary $zf - if {$opts(-runtime) ne ""} { - set rt [::open $opts(-runtime) rb] - setbinary $rt - fcopy $rt $zf - close $rt - } elseif {$opts(-zipkit)} { - set zkd {#!/usr/bin/env tclsh -# This is a zip-based Tcl Module -if {![package vsatisfies [package provide zvfs] 1.0]} { - package require vfs::zip - vfs::zip::Mount [info script] [info script] -} else { - zvfs::mount [info script] [info script] -} -# Load any CLIP file present -if {[file exists [file join [info script] pkgIndex.tcl]] } { - set dir [info script] - source [file join [info script] pkgIndex.tcl] -} -# Run any main.tcl present -if {[file exists [file join [info script] main.tcl]] } { - source [file join [info script] main.tcl] -} - } - append zkd \x1A - puts -nonewline $zf $zkd - } - - set count 0 - set cd "" - - if {$opts(-directory) ne ""} { - set paths [walk $opts(-directory) $opts(-exclude)] - } else { - set paths [glob -nocomplain {*}$args] - } - foreach path $paths { - append cd [add_file_to_archive $zf $opts(-directory) $path] - incr count - } - set cdoffset [tell $zf] - set endrec [binary format a4ssssiis PK\05\06 0 0 \ - $count $count [string length $cd] $cdoffset\ - [string length $opts(-comment)]] - append endrec $opts(-comment) - puts -nonewline $zf $cd - puts -nonewline $zf $endrec - close $zf - - return -} - -### -# Decode routines -### -proc ::zvfs::copy_file {zipbase destbase file} { - set l [string length $zipbase] - set relname [string trimleft [string range $file $l end] /] - if {[file isdirectory $file]} { - foreach sfile [glob -nocomplain $file/*] { - file mkdir [file join $destbase $relname] - copy_file $zipbase $destbase $sfile - } - return - } - file copy -force $file [file join $destbase $relname] -} - -# ### ### ### ######### ######### ######### -## Convenience command, decode and copy to dir -## This routine relies on zvfs::mount, so we only load -## it when the zvfs package is present -## -proc ::zvfs::unzip {in out} { - package require zvfs 1.0 - set root /ziptmp#[incr ::zvfs::count] - zvfs::mount $in $root - set out [file normalize $out] - foreach file [glob $root/*] { - copy_file $root $out $file - } - zvfs::unmount $in - return -} -package provide zvfstools 0.1 diff --git a/pkgs/make.tcl b/pkgs/make.tcl deleted file mode 100644 index 94a4050..0000000 --- a/pkgs/make.tcl +++ /dev/null @@ -1,165 +0,0 @@ -### -# This file contains instructions for how to build the Odielib library -# It will produce the following files in whatever directory it was called from: -# -# * odielibc.mk - A Makefile snippet needed to compile the odielib sources -# * odielibc.c - A C file which acts as the loader for odielibc -# * logicset.c/h - A c -# * (several .c and .h files) - C sources that are generated on the fly by automation -### -# Ad a "just in case" version or practcl we ship locally - -set ::CWD [pwd] -set ::project(builddir) $::CWD -set ::project(srcdir) [file dirname [file dirname [file normalize [info script]]]] -set ::project(sandbox) [file dirname $::project(srcdir)] -set ::project(download) [file join $::project(sandbox) download] -set ::project(teapot) [file join $::project(sandbox) teapot] -source [file join $::CWD .. library practcl practcl.tcl] -array set ::project [::practcl::config.tcl $CWD] - -set SRCPATH $::project(srcdir) -set SANDBOX $::project(sandbox) -file mkdir $CWD/build - -::practcl::target implement { - triggers {} -} -::practcl::target tcltk { - depends deps - triggers {script-packages script-pkgindex} -} -::practcl::target basekit { - depends {deps tcltk} - triggers {} - filename [file join $CWD tclkit_bare$::project(EXEEXT)] -} -::practcl::target packages { - depends {deps tcltk} -} -::practcl::target distclean {} -::practcl::target example { - depends basekit -} - -switch [lindex $argv 0] { - autoconf - - pre - - deps { - ::practcl::trigger implement - } - os { - puts "OS: [practcl::os]" - parray ::project - exit 0 - } - wrap { - ::practcl::depends basekit - } - all { - # Auto detect missing bits - foreach {item obj} $::make_objects { - if {[$obj check]} { - $obj trigger - } - } - } - package { - ::practcl::trigger packages - } - default { - ::practcl::trigger {*}$argv - } -} - -parray make - -set ::CWD [pwd] -::practcl::tclkit create BASEKIT {} -BASEKIT define set name tclkit -BASEKIT define set pkg_name tclkit -BASEKIT define set pkg_version 8.7.0a -BASEKIT define set localpath tclkit -BASEKIT define set profile devel -BASEKIT source [file join $::CWD packages.tcl] - -if {$make(distclean)} { - # Clean all source code back to it's pristine state from fossil - foreach item [BASEKIT link list package] { - $item go - set projdir [$item define get localsrcdir] - if {$projdir ne {} && [file exists $projdir]} { - fossil $projdir clean -force - } - } -} - -file mkdir [file join $CWD build] - -if {$make(tcltk)} { - ### - # Download our required packages - ### - set tcl_config_opts {} - set tk_config_opts {} - switch [::practcl::os] { - windows { - #lappend tcl_config_opts --disable-stubs - } - linux { - lappend tk_config_opts --enable-xft=no --enable-xss=no - } - macosx { - lappend tcl_config_opts --enable-corefoundation=yes --enable-framework=no - lappend tk_config_opts --enable-aqua=yes - } - } - lappend tcl_config_opts --with-tzdata --prefix [BASEKIT define get prefix] - BASEKIT project TCLCORE define set config_opts $tcl_config_opts - BASEKIT project TCLCORE go - set _TclSrcDir [BASEKIT project TCLCORE define get localsrcdir] - BASEKIT define set tclsrcdir $_TclSrcDir - lappend tk_config_opts --with-tcl=$_TclSrcDir - BASEKIT project TKCORE define set config_opts $tk_config_opts - BASEKIT project TCLCORE compile - BASEKIT project TKCORE compile -} - -if {$make(basekit)} { - BASEKIT implement $CWD - ::practcl::build::static-tclsh $target(basekit) BASEKIT -} - -if {[lindex $argv 0] eq "package"} { - #set result {} - foreach item [lrange $argv 1 end] { - set obj [BASEKIT project $item] - puts [list build $item [$obj define get static] [info object class $obj]] - if {[string is true [$obj define get static]]} { - $obj compile - } - if {[string is true [$obj define get vfsinstall]]} { - $obj install-vfs - } - } - #puts "RESULT: $result" -} elseif {$make(packages)} { - foreach item [BASEKIT link list package] { - if {[string is true [$item define get static]]} { - $item compile - } - if {[string is true [$item define get vfsinstall]]} { - $item install-vfs - } - } -} - - -if {$make(example)} { - file mkdir [file join $CWD example.vfs] - BASEKIT wrap $CWD example example.vfs -} - -if {[lindex $argv 0] eq "wrap"} { - BASEKIT wrap $CWD {*}[lrange $argv 1 end] -} diff --git a/pkgs/packages.tcl b/pkgs/packages.tcl deleted file mode 100644 index 2a84971..0000000 --- a/pkgs/packages.tcl +++ /dev/null @@ -1,92 +0,0 @@ -### -# This script implements a basic TclTkit with statically linked -# Tk, sqlite, threads, udp, and mmtk (which includes canvas3d and tkhtml) -### - -set CWD [pwd] - -my define set [array get ::project] -set os [::practcl::os] -my define set os $os -puts [list BASEKIT SANDBOX $::project(sandbox)] -my define set platform $::project(TEA_PLATFORM) -my define set prefix /zvfs -my define set sandbox [file normalize $::project(sandbox)] -my define set installdir [file join $::project(sandbox) pkg] -my define set teapot [file join $::project(sandbox) teapot] -my define set USEMSVC [info exists env(VisualStudioVersion)] -my define set prefix_broken_destdir [file join $::project(sandbox) tmp] -my define set HOST $os -my define set TARGET $os -my define set tclkit_bare [file join $CWD tclkit_bare$::project(EXEEXT)] - -my define set name tclkit -my define set output_c tclkit.c -my define set libs {} - -my add_project TCLCORE { - class subproject.core - name tcl - tag release - static 1 -} -my project TCLCORE define set srcdir [file dirname $::project(sandbox)] - -my add_project TKCORE { - class subproject.core - name tk - tag release - static 1 - autoload 0 - pkg_name Tk - initfunc Tk_Init -} - -my add_project tclconfig { - profile { - release: 3dfb97da548fae506374ac0015352ac0921d0cc9 - devel: practcl - } - class subproject - preload 1 - vfsinstall 0 -} - -my add_project thread { - profile { - release: 2a36d0a6c31569bfb3562e3d58e9e8204f447a7e - devel: practcl - } - class subproject.binary - pkg_name Thread - autoload 1 - initfunc Thread_Init - static 1 -} - -my add_project sqlite { - profile { - release: 40ffdfb26af3e7443b2912e1039c06bf9ed75846 - devel: practcl - } - class subproject.binary - pkg_name sqlite3 - autoload 1 - initfunc Sqlite3_Init - static 1 - vfsinstall 0 -} - -my add_project udp { - profile { - release: 7c396e1a767db57b07b48daa8e0cfc0ea622bbe9 - devel: practcl - } - class subproject.binary - static 1 - autoload 1 - initfunc Udp_Init - pkg_name udp - vfsinstall 0 -} - -- cgit v0.12 From 2c1224dce7ce2f827991e0abf968d2ccdb31f32b Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 7 Nov 2017 20:54:02 +0000 Subject: TclOO object allocation: Set classPtr to NULL if it wasn't otherwise set. --- generic/tclOO.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 51731d3..e48158c 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -538,7 +538,8 @@ KillFoundation( * AllocObject -- * * Allocate an object of basic type. Does not splice the object into its - * class's instance list. + * class's instance list. The caller must set the classPtr on the object, + * either to a class or to NULL. * * ---------------------------------------------------------------------- */ @@ -1701,6 +1702,8 @@ Tcl_NewObjectInstance( AllocClass(interp, oPtr); oPtr->selfCls = classPtr; TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); + } else { + oPtr->classPtr = NULL; } /* -- cgit v0.12 From a982dd11fa97fd5c0f45076a0662f40a80f43503 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 8 Nov 2017 00:39:17 +0000 Subject: Modify TclCreateProc to handle arbitrary argument names, not just ASCII. --- generic/tclExecute.c | 4 +-- generic/tclInt.h | 2 +- generic/tclProc.c | 96 +++++++++++++++++++++++----------------------------- 3 files changed, 45 insertions(+), 57 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d43ddfd..3eba833 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1333,12 +1333,12 @@ TclStackAlloc( int numBytes) { Interp *iPtr = (Interp *) interp; - int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); + int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { return (void *) ckalloc(numBytes); } - + numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); return (void *) StackAllocWords(interp, numWords); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 29956ec..33a0236 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4445,7 +4445,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); /* *---------------------------------------------------------------- - * Macro used by the Tcl core to increment a namespace's export export epoch + * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE void TclInvalidateNsCmdLookup(Namespace *nsPtr); diff --git a/generic/tclProc.c b/generic/tclProc.c index 96bdcf3..8fc6dcb 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -393,13 +393,13 @@ TclCreateProc( Proc **procPtrPtr) /* Returns: pointer to proc data. */ { Interp *iPtr = (Interp *) interp; - const char **argArray = NULL; register Proc *procPtr; - int i, length, result, numArgs; - const char *args, *bytes, *p; + int i, result, numArgs, plen; + const char *bytes, *argname, *argnamei; + char argnamelast; register CompiledLocal *localPtr = NULL; - Tcl_Obj *defPtr; + Tcl_Obj *defPtr, *errorObj, **argArray; int precompiled = 0; if (bodyPtr->typePtr == &tclProcBodyType) { @@ -436,6 +436,7 @@ TclCreateProc( */ if (Tcl_IsShared(bodyPtr)) { + int length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = TclGetStringFromObj(bodyPtr, &length); @@ -473,12 +474,9 @@ TclCreateProc( * argument specifier. If the body is precompiled, processing is limited * to checking that the parsed argument is consistent with the one stored * in the Proc. - * - * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS. */ - args = TclGetStringFromObj(argsPtr, &length); - result = Tcl_SplitList(interp, args, &numArgs, &argArray); + result = Tcl_ListObjGetElements(interp , argsPtr ,&numArgs ,&argArray); if (result != TCL_OK) { goto procError; } @@ -502,28 +500,28 @@ TclCreateProc( for (i = 0; i < numArgs; i++) { int fieldCount, nameLength; size_t valueLength; - const char **fieldValues; + Tcl_Obj **fieldValues; /* * Now divide the specifier up into name and default. */ - result = Tcl_SplitList(interp, argArray[i], &fieldCount, + result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount, &fieldValues); if (result != TCL_OK) { goto procError; } if (fieldCount > 2) { - ckfree(fieldValues); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "too many fields in argument specifier \"%s\"", - argArray[i])); + errorObj = Tcl_NewStringObj( + "too many fields in argument specifier \"", -1); + Tcl_AppendObjToObj(errorObj, argArray[i]); + Tcl_AppendToObj(errorObj, "\"", -1); + Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } - if ((fieldCount == 0) || (*fieldValues[0] == 0)) { - ckfree(fieldValues); + if ((fieldCount == 0) || (fieldValues[0]->length == 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", @@ -531,9 +529,10 @@ TclCreateProc( goto procError; } - nameLength = strlen(fieldValues[0]); + nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length); if (fieldCount == 2) { - valueLength = strlen(fieldValues[1]); + valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]), + fieldValues[1]->length); } else { valueLength = 0; } @@ -542,33 +541,29 @@ TclCreateProc( * Check that the formal parameter name is a scalar. */ - p = fieldValues[0]; - while (*p != '\0') { - if (*p == '(') { - const char *q = p; - do { - q++; - } while (*q != '\0'); - q--; - if (*q == ')') { /* We have an array element. */ + argname = Tcl_GetStringFromObj(fieldValues[0], &plen); + argnamei = argname; + argnamelast = argname[plen-1]; + while (plen--) { + if (argnamei[0] == '(') { + if (argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", - fieldValues[0])); - ckfree(fieldValues); + Tcl_GetString(fieldValues[0]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } - } else if ((*p == ':') && (*(p+1) == ':')) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "formal parameter \"%s\" is not a simple name", - fieldValues[0])); - ckfree(fieldValues); + } else if ((argnamei[0] == ':') && (argnamei[1] == ':')) { + errorObj = Tcl_NewStringObj("formal parameter \"", -1); + Tcl_AppendObjToObj(errorObj, fieldValues[0]); + Tcl_AppendToObj(errorObj, "\" is not a simple name", -1); + Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } - p++; + argnamei = Tcl_UtfNext(argnamei); } if (precompiled) { @@ -584,7 +579,7 @@ TclCreateProc( */ if ((localPtr->nameLength != nameLength) - || (strcmp(localPtr->name, fieldValues[0])) + || (Tcl_UtfNcmp(localPtr->name, argname, nameLength)) || (localPtr->frameIndex != i) || !(localPtr->flags & VAR_ARGUMENT) || (localPtr->defValuePtr == NULL && fieldCount == 2) @@ -592,7 +587,6 @@ TclCreateProc( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter %d is " "inconsistent with precompiled body", procName, i)); - ckfree(fieldValues); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); goto procError; @@ -607,12 +601,13 @@ TclCreateProc( size_t tmpLength = localPtr->defValuePtr->length; if ((valueLength != tmpLength) || - strncmp(fieldValues[1], tmpPtr, tmpLength)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "procedure \"%s\": formal parameter \"%s\" has " - "default value inconsistent with precompiled body", - procName, fieldValues[0])); - ckfree(fieldValues); + Tcl_UtfNcmp(Tcl_GetString(fieldValues[1]), tmpPtr, tmpLength)) { + errorObj = Tcl_ObjPrintf( + "procedure \"%s\": formal parameter \"" ,procName); + Tcl_AppendObjToObj(errorObj, fieldValues[0]); + Tcl_AppendToObj(errorObj, "\" has " + "default value inconsistent with precompiled body", -1); + Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); goto procError; @@ -632,7 +627,7 @@ TclCreateProc( * local variables for the argument. */ - localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1); + localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -640,19 +635,18 @@ TclCreateProc( procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; - localPtr->nameLength = nameLength; + localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length); localPtr->frameIndex = i; localPtr->flags = VAR_ARGUMENT; localPtr->resolveInfo = NULL; if (fieldCount == 2) { - localPtr->defValuePtr = - Tcl_NewStringObj(fieldValues[1], valueLength); + localPtr->defValuePtr = fieldValues[1]; Tcl_IncrRefCount(localPtr->defValuePtr); } else { localPtr->defValuePtr = NULL; } - memcpy(localPtr->name, fieldValues[0], nameLength + 1); + memcpy(localPtr->name, argname, fieldValues[0]->length + 1); if ((i == numArgs - 1) && (localPtr->nameLength == 4) && (localPtr->name[0] == 'a') @@ -660,12 +654,9 @@ TclCreateProc( localPtr->flags |= VAR_IS_ARGS; } } - - ckfree(fieldValues); } *procPtrPtr = procPtr; - ckfree(argArray); return TCL_OK; procError: @@ -686,9 +677,6 @@ TclCreateProc( } ckfree(procPtr); } - if (argArray != NULL) { - ckfree(argArray); - } return TCL_ERROR; } -- cgit v0.12 From b2722c42b1a43b10ba1047b6be28d5b4663732b8 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 8 Nov 2017 09:41:00 +0000 Subject: Pairing down the tip#430 branch to only include files and utilities called out by the tip. Eliminated the header files tclZipfs.h and zcrypt.h. The only public calls for tclZipfs.h are now in the stubs table and the contents of zcrypt.h are already part of the minizip implementation that Tcl keeps around in the compat/zlib/contrib/minizip directory. tclBootVFS.h hasn't been used by the implementation in a while. Alos eliminated the mkzip.tcl facility from tools/. The C based mkzip is much faster and more reliable --- doc/zipfs.3 | 21 +----- generic/tclBootVfs.h | 24 ------- generic/tclZipfs.c | 6 +- generic/tclZipfs.h | 48 ------------- generic/zcrypt.h | 131 ---------------------------------- tools/mkVfs.tcl | 198 +++++++++++++++++++++++++-------------------------- tools/mkzip.tcl | 5 -- unix/Makefile.in | 4 +- win/Makefile.in | 6 +- win/makefile.vc | 4 +- 10 files changed, 113 insertions(+), 334 deletions(-) delete mode 100644 generic/tclBootVfs.h delete mode 100644 generic/tclZipfs.h delete mode 100644 generic/zcrypt.h delete mode 100644 tools/mkzip.tcl diff --git a/doc/zipfs.3 b/doc/zipfs.3 index 6846f58..a3b3da8 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -1,24 +1,18 @@ '\" '\" Copyright (c) 2015 Jan Nijtmans '\" Copyright (c) 2015 Christian Werner +'\" Copyright (c) 2017 Sean Woods '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" +'\" .TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tclzipfs_Init, Tclzipfs_SafeInit, Tclzipfs_Mount, Tclzipfs_Unmount \- handle ZIP files as VFS +Tclzipfs_Mount, Tclzipfs_Unmount \- handle ZIP files as VFS .SH SYNOPSIS .nf -\fB#include \fR -.sp -int -\fBTclzipfs_Init\fR(\fIinterp\fR) -.sp -int -\fBTclzipfs_SafeInit\fR(\fIinterp\fR) .sp int \fBTclzipfs_Mount\fR(\fIinterp, zipname, mntpt, passwd\fR) @@ -38,15 +32,6 @@ Name of a mount point. An (optional) password. .BE .SH DESCRIPTION -\fBTclzipfs_Init()\fR performs one-time initialization of the file system -and registers it process wide. Additionally, a package named \fIzipfs\fR -is provided and supplemental Tcl commands are created in the given -interpreter \fIinterp\fR. -.PP -\fBTclzipfs_SafeInit()\fR is the version of \fBTclzipfs_Init()\fR for -safe interpreters. It exposes only uncritical supplemental Tcl commands -in the given interpreter \fIinterp\fR. -.PP \fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR. Errors during that process are reported in the interpreter \fIinterp\fR. diff --git a/generic/tclBootVfs.h b/generic/tclBootVfs.h deleted file mode 100644 index 1cb7c23..0000000 --- a/generic/tclBootVfs.h +++ /dev/null @@ -1,24 +0,0 @@ -#include -#include "tclInt.h" -#include "tclFileSystem.h" - -#ifndef MODULE_SCOPE -# define MODULE_SCOPE extern -#endif - -#define TCLVFSBOOT_INIT "main.tcl" -#define TCLVFSBOOT_MOUNT "/zvfs" - -/* Make sure the stubbed variants of those are never used. */ -#undef Tcl_ObjSetVar2 -#undef Tcl_NewStringObj -#undef Tk_Init -#undef Tk_MainEx -#undef Tk_SafeInit - -MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *); -MODULE_SCOPE int Zvfs_Init(Tcl_Interp *); -MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *); -MODULE_SCOPE int Tclkit_Packages_Init(Tcl_Interp *); - - diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 9d74890..fe4553e 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4,7 +4,7 @@ * Implementation of the ZIP filesystem used in TIP 430 * Adapted from the implentation for AndroWish. * - * Coptright (c) 2016 Sean Woods + * Coptright (c) 2016-2017 Sean Woods * Copyright (c) 2013-2015 Christian Werner * * See the file "license.terms" for information on usage and redistribution of @@ -26,7 +26,7 @@ #ifdef HAVE_ZLIB #include "zlib.h" -#include "zcrypt.h" +#include "crypt.h" #define ZIPFS_VOLUME "zipfs:/" #define ZIPFS_VOLUME_LEN 7 @@ -235,7 +235,7 @@ static const char pwrot[16] = { * Table to compute CRC32. */ -static const unsigned int crc32tab[256] = { +static const unsigned long crc32tab[256] = { 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h deleted file mode 100644 index f7da3bd..0000000 --- a/generic/tclZipfs.h +++ /dev/null @@ -1,48 +0,0 @@ -/* - * tclZipfs.h -- - * - * This header file describes the interface of the ZIPFS filesystem - * - * Copyright (c) 2013-2015 Christian Werner - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#ifndef _ZIPFS_H -#define _ZIPFS_H - -#include "tcl.h" - -#ifdef __cplusplus -extern "C" { -#endif - -#ifndef ZIPFSAPI -# define ZIPFSAPI extern -#endif - -#ifdef BUILD_tcl -# undef ZIPFSAPI -# define ZIPFSAPI DLLEXPORT -#endif - -ZIPFSAPI int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, - const char *mntpt, const char *passwd); -ZIPFSAPI int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname); -ZIPFSAPI int TclZipfs_Init(Tcl_Interp *interp); -ZIPFSAPI int TclZipfs_SafeInit(Tcl_Interp *interp); - -#ifdef __cplusplus -} -#endif - -#endif /* _ZIPFS_H */ - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/generic/zcrypt.h b/generic/zcrypt.h deleted file mode 100644 index eb9865b..0000000 --- a/generic/zcrypt.h +++ /dev/null @@ -1,131 +0,0 @@ -/* crypt.h -- base code for crypt/uncrypt ZIPfile - - - Version 1.01e, February 12th, 2005 - - Copyright (C) 1998-2005 Gilles Vollant - - This code is a modified version of crypting code in Infozip distribution - - The encryption/decryption parts of this source code (as opposed to the - non-echoing password parts) were originally written in Europe. The - whole source package can be freely distributed, including from the USA. - (Prior to January 2000, re-export from the US was a violation of US law.) - - This encryption code is a direct transcription of the algorithm from - Roger Schlafly, described by Phil Katz in the file appnote.txt. This - file (appnote.txt) is distributed with the PKZIP program (even in the - version without encryption capabilities). - - If you don't need crypting in your application, just define symbols - NOCRYPT and NOUNCRYPT. - - This code support the "Traditional PKWARE Encryption". - - The new AES encryption added on Zip format by Winzip (see the page - http://www.winzip.com/aes_info.htm ) and PKWare PKZip 5.x Strong - Encryption is not supported. -*/ - -#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8)) - -/*********************************************************************** - * Return the next byte in the pseudo-random sequence - */ -static int decrypt_byte(unsigned long* pkeys, const unsigned int* pcrc_32_tab) -{ - unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an - * unpredictable manner on 16-bit systems; not a problem - * with any known compiler so far, though */ - - temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2; - return (int)(((temp * (temp ^ 1)) >> 8) & 0xff); -} - -/*********************************************************************** - * Update the encryption keys with the next byte of plain text - */ -static int update_keys(unsigned long* pkeys,const unsigned int* pcrc_32_tab,int c) -{ - (*(pkeys+0)) = CRC32((*(pkeys+0)), c); - (*(pkeys+1)) += (*(pkeys+0)) & 0xff; - (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; - { - register int keyshift = (int)((*(pkeys+1)) >> 24); - (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); - } - return c; -} - - -/*********************************************************************** - * Initialize the encryption keys and the random header according to - * the given password. - */ -static void init_keys(const char* passwd,unsigned long* pkeys,const unsigned int* pcrc_32_tab) -{ - *(pkeys+0) = 305419896L; - *(pkeys+1) = 591751049L; - *(pkeys+2) = 878082192L; - while (*passwd != '\0') { - update_keys(pkeys,pcrc_32_tab,(int)*passwd); - passwd++; - } -} - -#define zdecode(pkeys,pcrc_32_tab,c) \ - (update_keys(pkeys,pcrc_32_tab,c ^= decrypt_byte(pkeys,pcrc_32_tab))) - -#define zencode(pkeys,pcrc_32_tab,c,t) \ - (t=decrypt_byte(pkeys,pcrc_32_tab), update_keys(pkeys,pcrc_32_tab,c), t^(c)) - -#ifdef INCLUDECRYPTINGCODE_IFCRYPTALLOWED - -#define RAND_HEAD_LEN 12 - /* "last resort" source for second part of crypt seed pattern */ -# ifndef ZCR_SEED2 -# define ZCR_SEED2 3141592654UL /* use PI as default pattern */ -# endif - -static int crypthead(const char* passwd, /* password string */ - unsigned char* buf, /* where to write header */ - int bufSize, - unsigned long* pkeys, - const unsigned int* pcrc_32_tab, - unsigned long crcForCrypting) -{ - int n; /* index in random header */ - int t; /* temporary */ - int c; /* random byte */ - unsigned char header[RAND_HEAD_LEN-2]; /* random header */ - static unsigned calls = 0; /* ensure different random header each time */ - - if (bufSize> 7) & 0xff; - header[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, c, t); - } - /* Encrypt random header (last two bytes is high word of crc) */ - init_keys(passwd, pkeys, pcrc_32_tab); - for (n = 0; n < RAND_HEAD_LEN-2; n++) - { - buf[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, header[n], t); - } - buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 16) & 0xff, t); - buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 24) & 0xff, t); - return n; -} - -#endif diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl index e670775..cbfb81e 100644 --- a/tools/mkVfs.tcl +++ b/tools/mkVfs.tcl @@ -1,99 +1,99 @@ -proc cat fname { - set fname [open $fname r] - set data [read $fname] - close $fname - return $data -} - -proc pkgIndexDir {root fout d1} { - - puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \ - [file tail $d1]] - set idx [string length $root] - foreach ftail [glob -directory $d1 -nocomplain -tails *] { - set f [file join $d1 $ftail] - if {[file isdirectory $f] && [string compare CVS $ftail]} { - pkgIndexDir $root $fout $f - } elseif {[file tail $f] eq "pkgIndex.tcl"} { - puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]" - puts $fout [cat $f] - } - } -} - -### -# Script to build the VFS file system -### -proc copyDir {d1 d2} { - - puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ - [file tail $d2]] - - file delete -force -- $d2 - file mkdir $d2 - - foreach ftail [glob -directory $d1 -nocomplain -tails *] { - set f [file join $d1 $ftail] - if {[file isdirectory $f] && [string compare CVS $ftail]} { - copyDir $f [file join $d2 $ftail] - } elseif {[file isfile $f]} { - file copy -force $f [file join $d2 $ftail] - if {$::tcl_platform(platform) eq {unix}} { - file attributes [file join $d2 $ftail] -permissions 0644 - } else { - file attributes [file join $d2 $ftail] -readonly 1 - } - } - } - - if {$::tcl_platform(platform) eq {unix}} { - file attributes $d2 -permissions 0755 - } else { - file attributes $d2 -readonly 1 - } -} - -if {[llength $argv] < 3} { - puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" - exit 1 -} -set TCL_SCRIPT_DIR [lindex $argv 0] -set TCLSRC_ROOT [lindex $argv 1] -set PLATFORM [lindex $argv 2] -set TKDLL [lindex $argv 3] -set TKVER [lindex $argv 4] - -puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" -copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} - -if {$PLATFORM == "windows"} { - set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] - puts "DDE DLL $ddedll" - if {$ddedll != {}} { - file copy $ddedll ${TCL_SCRIPT_DIR}/dde - } - set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] - puts "REG DLL $ddedll" - if {$regdll != {}} { - file copy $regdll ${TCL_SCRIPT_DIR}/reg - } -} else { - # Remove the dde and reg package paths - file delete -force ${TCL_SCRIPT_DIR}/dde - file delete -force ${TCL_SCRIPT_DIR}/reg -} - -# For the following packages, cat their pkgIndex files to tclIndex -file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0 -set fout [open ${TCL_SCRIPT_DIR}/tclIndex a] -puts $fout {# -# MANIFEST OF INCLUDED PACKAGES -# -set VFSROOT $dir -} -if {$TKDLL ne {} && [file exists $TKDLL]} { - file copy $TKDLL ${TCL_SCRIPT_DIR} - puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"] -} -pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} -close $fout +proc cat fname { + set fname [open $fname r] + set data [read $fname] + close $fname + return $data +} + +proc pkgIndexDir {root fout d1} { + + puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \ + [file tail $d1]] + set idx [string length $root] + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + pkgIndexDir $root $fout $f + } elseif {[file tail $f] eq "pkgIndex.tcl"} { + puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]" + puts $fout [cat $f] + } + } +} + +### +# Script to build the VFS file system +### +proc copyDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ + [file tail $d2]] + + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +if {[llength $argv] < 3} { + puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" + exit 1 +} +set TCL_SCRIPT_DIR [lindex $argv 0] +set TCLSRC_ROOT [lindex $argv 1] +set PLATFORM [lindex $argv 2] +set TKDLL [lindex $argv 3] +set TKVER [lindex $argv 4] + +puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" +copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} + +if {$PLATFORM == "windows"} { + set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] + puts "DDE DLL $ddedll" + if {$ddedll != {}} { + file copy $ddedll ${TCL_SCRIPT_DIR}/dde + } + set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] + puts "REG DLL $ddedll" + if {$regdll != {}} { + file copy $regdll ${TCL_SCRIPT_DIR}/reg + } +} else { + # Remove the dde and reg package paths + file delete -force ${TCL_SCRIPT_DIR}/dde + file delete -force ${TCL_SCRIPT_DIR}/reg +} + +# For the following packages, cat their pkgIndex files to tclIndex +file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0 +set fout [open ${TCL_SCRIPT_DIR}/tclIndex a] +puts $fout {# +# MANIFEST OF INCLUDED PACKAGES +# +set VFSROOT $dir +} +if {$TKDLL ne {} && [file exists $TKDLL]} { + file copy $TKDLL ${TCL_SCRIPT_DIR} + puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"] +} +pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} +close $fout diff --git a/tools/mkzip.tcl b/tools/mkzip.tcl deleted file mode 100644 index ba10908..0000000 --- a/tools/mkzip.tcl +++ /dev/null @@ -1,5 +0,0 @@ -### -# Wrapper to allow access to Tcl's zvfs::mkzip command from Makefiles -### -source [file join [file dirname [file normalize [info script]]] .. library zvfstools zvfstools.tcl] -zvfs::mkzip {*}$argv diff --git a/unix/Makefile.in b/unix/Makefile.in index ee3ed75..5f4e125 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -373,7 +373,6 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclInt.h \ $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ - $(GENERIC_DIR)/tclZipfs.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h \ $(GENERIC_DIR)/tclOO.h \ @@ -962,7 +961,6 @@ install-headers: @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclPlatDecls.h \ - $(GENERIC_DIR)/tclZipfs.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h ; \ do \ @@ -1333,7 +1331,7 @@ tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c - $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c diff --git a/win/Makefile.in b/win/Makefile.in index 8d5aa5a..1a88cc8 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -502,6 +502,11 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +# TIP #430, ZipFS Support +tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c + + # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -642,7 +647,6 @@ install-libraries: libraries install-tzdata install-msgs @echo "Installing header files"; @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ - "$(GENERIC_DIR)/tclZipfs.h" \ "$(GENERIC_DIR)/tclPlatDecls.h" \ "$(GENERIC_DIR)/tclTomMath.h" \ "$(GENERIC_DIR)/tclTomMathDecls.h"; \ diff --git a/win/makefile.vc b/win/makefile.vc index 19e1e2d..c8713fe 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -959,8 +959,9 @@ $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? +### TIP #430 ZipFS Support $(TMP_DIR)\zipfs.obj: $(GENERICDIR)\zipfs.c - $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -DBUILD_tcl -Fo$@ $? $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \ @@ -1135,7 +1136,6 @@ install-libraries: tclConfig install-msgs install-tzdata @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tclZipfs.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" -- cgit v0.12 From cf4d5a8cfe114d1b687b43c361a25182eba9597c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Nov 2017 11:50:55 +0000 Subject: TIP #485 implementation: "Remove Deprecated API". Based on Tcl 8.7 (core-8-branch). --- generic/tcl.decls | 16 ++--- generic/tclBasic.c | 2 +- generic/tclCmdAH.c | 2 +- generic/tclDecls.h | 40 +++++++----- generic/tclIOCmd.c | 6 +- generic/tclInt.h | 2 +- generic/tclStubInit.c | 8 +++ generic/tclTest.c | 163 ------------------------------------------------ tests/case.test | 94 ---------------------------- tests/compExpr-old.test | 22 ------- tests/compExpr.test | 12 ---- tests/expr-old.test | 17 ----- tests/expr.test | 39 ------------ 13 files changed, 46 insertions(+), 377 deletions(-) delete mode 100644 tests/case.test diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..f7ffd29 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -285,7 +285,7 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -declare 77 { +declare 77 {deprecated {Use Tcl_UtfBackslash}} { char Tcl_Backslash(const char *src, int *readPtr) } declare 78 { @@ -352,7 +352,7 @@ declare 93 { declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -declare 95 { +declare 95 {deprecated {}} { void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData) @@ -470,7 +470,7 @@ declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } # This is obsolete, use Tcl_FSEvalFile -declare 130 { +declare 130 {deprecated {Use Tcl_FSEvalFile}} { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } declare 131 { @@ -1214,10 +1214,10 @@ declare 339 { declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -declare 341 { +declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void) } -declare 342 { +declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { void Tcl_SetDefaultEncodingDir(const char *path) } declare 343 { @@ -1266,7 +1266,7 @@ declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -declare 357 { +declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) } @@ -1548,12 +1548,12 @@ declare 434 { } # TIP#15 (math function introspection) dkf -declare 435 { +declare 435 {deprecated {}} { int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr) } -declare 436 { +declare 436 {deprecated {}} { Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e6022ac..c334fb8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -203,7 +203,7 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 807a1ac..49c8c56 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -164,7 +164,7 @@ Tcl_BreakObjCmd( * *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* ARGSUSED */ int Tcl_CaseObjCmd( diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..c521845 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -263,7 +263,8 @@ EXTERN int Tcl_AsyncReady(void); /* 76 */ EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); /* 77 */ -EXTERN char Tcl_Backslash(const char *src, int *readPtr); +TCL_DEPRECATED("Use Tcl_UtfBackslash") +char Tcl_Backslash(const char *src, int *readPtr); /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, @@ -322,7 +323,8 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); /* 95 */ -EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp, +TCL_DEPRECATED("") +void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); @@ -418,7 +420,8 @@ EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err); /* 129 */ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); /* 130 */ -EXTERN int Tcl_EvalFile(Tcl_Interp *interp, +TCL_DEPRECATED("Use Tcl_FSEvalFile") +int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); /* 131 */ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -1010,9 +1013,11 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); /* 341 */ -EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); +TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") +CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); /* 342 */ -EXTERN void Tcl_SetDefaultEncodingDir(const char *path); +TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") +void Tcl_SetDefaultEncodingDir(const char *path); /* 343 */ EXTERN void Tcl_AlertNotifier(ClientData clientData); /* 344 */ @@ -1047,7 +1052,8 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 357 */ -EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, +TCL_DEPRECATED("Use Tcl_EvalTokensStandard") +Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 358 */ EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); @@ -1268,13 +1274,15 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 435 */ -EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp, +TCL_DEPRECATED("") +int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 436 */ -EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, +TCL_DEPRECATED("") +Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern); /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -1935,7 +1943,7 @@ typedef struct TclStubs { void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ + TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ @@ -1953,7 +1961,7 @@ typedef struct TclStubs { void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ - void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ + TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */ Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */ @@ -1988,7 +1996,7 @@ typedef struct TclStubs { CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */ CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */ int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ - int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ + TCL_DEPRECATED_API("Use Tcl_FSEvalFile") int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ @@ -2207,8 +2215,8 @@ typedef struct TclStubs { int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ - CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ - void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ + TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ + TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ @@ -2223,7 +2231,7 @@ typedef struct TclStubs { char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ - Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ + TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */ @@ -2301,8 +2309,8 @@ typedef struct TclStubs { int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ - int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ - Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ + TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ + TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 6e8bd09..87bf415 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -137,7 +137,7 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if TCL_MAJOR_VERSION < 9 +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { /* * The code below provides backwards compatibility with an old @@ -439,7 +439,7 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if TCL_MAJOR_VERSION < 9 +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* * The code below provides backwards compatibility with an old * form of the command that is no longer recommended or @@ -454,7 +454,7 @@ Tcl_ReadObjCmd( TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if TCL_MAJOR_VERSION < 9 +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 } newline = 1; #endif diff --git a/generic/tclInt.h b/generic/tclInt.h index 29392b6..6b61af1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3240,7 +3240,7 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..03ef7d6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,6 +72,14 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclBNInitBignumFromWideUInt 0 # define TclBNInitBignumFromWideInt 0 # define TclBNInitBignumFromLong 0 +# define Tcl_BackSlash 0 +# define Tcl_EvalFile 0 +# define Tcl_GetDefaultEncodingDir 0 +# define Tcl_SetDefaultEncodingDir 0 +# define Tcl_EvalTokens 0 +# define Tcl_CreateMathFunc 0 +# define Tcl_GetMathFuncInfo 0 +# define Tcl_ListMathFuncs 0 #else #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) diff --git a/generic/tclTest.c b/generic/tclTest.c index 834cd79..3aa853f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -305,14 +305,6 @@ static int TestlinkCmd(ClientData dummy, static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#ifndef TCL_NO_DEPRECATED -static int TestMathFunc(ClientData clientData, - Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr); -static int TestMathFunc2(ClientData clientData, - Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr); -#endif /* TCL_NO_DEPRECATED */ static int TestmainthreadCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetmainloopCmd(ClientData dummy, @@ -549,10 +541,6 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { -#ifndef TCL_NO_DEPRECATED - Tcl_ValueType t3ArgTypes[2]; -#endif /* TCL_NO_DEPRECATED */ - Tcl_Obj *listPtr; Tcl_Obj **objv; int objc, index; @@ -701,10 +689,6 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED - Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); - Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, @@ -715,13 +699,6 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif -#ifndef TCL_NO_DEPRECATED - t3ArgTypes[0] = TCL_EITHER; - t3ArgTypes[1] = TCL_EITHER; - Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, - NULL); -#endif /* TCL_NO_DEPRECATED */ - Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, NULL, NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, @@ -3347,146 +3324,6 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * - * TestMathFunc -- - * - * This is a user-defined math procedure to test out math procedures - * with no arguments. - * - * Results: - * A normal Tcl completion code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -#ifndef TCL_NO_DEPRECATED -static int -TestMathFunc( - ClientData clientData, /* Integer value to return. */ - Tcl_Interp *interp, /* Not used. */ - Tcl_Value *args, /* Not used. */ - Tcl_Value *resultPtr) /* Where to store result. */ -{ - resultPtr->type = TCL_INT; - resultPtr->intValue = PTR2INT(clientData); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestMathFunc2 -- - * - * This is a user-defined math procedure to test out math procedures - * that do have arguments, in this case 2. - * - * Results: - * A normal Tcl completion code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -static int -TestMathFunc2( - ClientData clientData, /* Integer value to return. */ - Tcl_Interp *interp, /* Used to report errors. */ - Tcl_Value *args, /* Points to an array of two Tcl_Value structs - * for the two arguments. */ - Tcl_Value *resultPtr) /* Where to store the result. */ -{ - int result = TCL_OK; - - /* - * Return the maximum of the two arguments with the correct type. - */ - - if (args[0].type == TCL_INT) { - int i0 = args[0].intValue; - - if (args[1].type == TCL_INT) { - int i1 = args[1].intValue; - - resultPtr->type = TCL_INT; - resultPtr->intValue = ((i0 > i1)? i0 : i1); - } else if (args[1].type == TCL_DOUBLE) { - double d0 = i0; - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - Tcl_WideInt w0 = Tcl_LongAsWide(i0); - Tcl_WideInt w1 = args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else { - Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL); - result = TCL_ERROR; - } - } else if (args[0].type == TCL_DOUBLE) { - double d0 = args[0].doubleValue; - - if (args[1].type == TCL_INT) { - double d1 = args[1].intValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_DOUBLE) { - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - double d1 = Tcl_WideAsDouble(args[1].wideValue); - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else { - Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL); - result = TCL_ERROR; - } - } else if (args[0].type == TCL_WIDE_INT) { - Tcl_WideInt w0 = args[0].wideValue; - - if (args[1].type == TCL_INT) { - Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else if (args[1].type == TCL_DOUBLE) { - double d0 = Tcl_WideAsDouble(w0); - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - Tcl_WideInt w1 = args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else { - Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL); - result = TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "T3: wrong type for arg 1", NULL); - result = TCL_ERROR; - } - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index d7558a9..0000000 --- a/tests/case.test +++ /dev/null @@ -1,94 +0,0 @@ -# Commands covered: case -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {![llength [info commands case]]} { - # No "case" command? So no need to test - return -} - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} - -test case-1.1 {simple pattern} { - case a in a {format 1} b {format 2} c {format 3} default {format 4} -} 1 -test case-1.2 {simple pattern} { - case b a {format 1} b {format 2} c {format 3} default {format 4} -} 2 -test case-1.3 {simple pattern} { - case x in a {format 1} b {format 2} c {format 3} default {format 4} -} 4 -test case-1.4 {simple pattern} { - case x a {format 1} b {format 2} c {format 3} -} {} -test case-1.5 {simple pattern matches many times} { - case b a {format 1} b {format 2} b {format 3} b {format 4} -} 2 -test case-1.6 {fancier pattern} { - case cx a {format 1} *c {format 2} *x {format 3} default {format 4} -} 3 -test case-1.7 {list of patterns} { - case abc in {a b c} {format 1} {def abc ghi} {format 2} -} 2 - -test case-2.1 {error in executed command} { - list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ - $msg $::errorInfo -} {1 {Just a test} {Just a test - while executing -"error "Just a test"" - ("a" arm line 1) - invoked from within -"case a in a {error "Just a test"} default {format 1}"}} -test case-2.2 {error: not enough args} { - list [catch {case} msg] $msg -} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} -test case-2.3 {error: pattern with no body} { - list [catch {case a b} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.4 {error: pattern with no body} { - list [catch {case a in b {format 1} c} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.5 {error in default command} { - list [catch {case foo in a {error case1} default {error case2} \ - b {error case 3}} msg] $msg $::errorInfo -} {1 case2 {case2 - while executing -"error case2" - ("default" arm line 1) - invoked from within -"case foo in a {error case1} default {error case2} b {error case 3}"}} - -test case-3.1 {single-argument form for pattern/command pairs} { - case b in { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.2 {single-argument form for pattern/command pairs} { - case b { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.3 {single-argument form for pattern/command pairs} { - list [catch {case z in {a 2 b}} msg] $msg -} {1 {extra case pattern with no body}} - -# cleanup -::tcltest::cleanupTests -return diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bae26a0..0136ccd 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -20,12 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} - # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -602,22 +596,6 @@ test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body { test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * -test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr 2*T1() -} 246 -test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T2()*3 -} 1035 -test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(21, 37) -} 37 -test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(21.2, 37) -} 37.0 -test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(-21.2, -17.5) -} -17.5 - test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} set a(VALUE) ff15 diff --git a/tests/compExpr.test b/tests/compExpr.test index 14c875d..3b44af8 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -16,12 +16,6 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} - # Constrain memory leak tests testConstraint memory [llength [info commands memory]] @@ -319,12 +313,6 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { expr {do_it()} } -returnCodes error -match glob -result {* "*do_it"} -test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr 3*T1()-1 -} 368 -test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T2()*3 -} 1035 test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body { expr {atan2(1.0)} } -returnCodes error -match glob -result {too few arguments for math function*} diff --git a/tests/expr-old.test b/tests/expr-old.test index 3adfb63..cea20f1 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -24,12 +24,6 @@ testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} - # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -847,12 +841,6 @@ test expr-old-32.41 {math functions in expressions} { test expr-old-32.42 {math functions in expressions} { list [catch {expr hypot(5*.8,3)} msg] $msg } {0 5.0} -test expr-old-32.43 {math functions in expressions} testmathfunctions { - expr 2*T1() -} 246 -test expr-old-32.44 {math functions in expressions} testmathfunctions { - expr T2()*3 -} 1035 test expr-old-32.45 {math functions in expressions} { expr (0 <= rand()) && (rand() < 1) } {1} @@ -952,11 +940,6 @@ test expr-old-34.15 {errors in math functions} { test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 -test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \ - -body { - list [catch {expr T1(4)} msg] $msg - } -match glob -result {1 {too many arguments for math function*}} - test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 } -returnCodes error -match glob -result {*invalid octal number*} diff --git a/tests/expr.test b/tests/expr.test index 8e083c5..0b3620a 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -18,10 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] -testConstraint testmathfunctions [expr { - ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"}) -}] - # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. @@ -685,41 +681,6 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} -body { test expr-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * -test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr 2*T1() -} 246 -test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T2()*3 -} 1035 -test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(21, 37) -} 37 -test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(21.2, 37) -} 37.0 -test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(-21.2, -17.5) -} -17.5 -test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(21, wide(37)) -} 37 -test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), 37) -} 37 -test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), wide(37)) -} 37 -test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(21.0, wide(37)) -} 37.0 -test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), 37.0) -} 37.0 -test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints { - testmathfunctions -} -body { - expr T3(0,"a") -} -returnCodes error -result {argument to math function didn't have numeric value} test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { -- cgit v0.12 From 9c9ce91ef5f2bc6693e38d6ff6fad7047ea71a17 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Nov 2017 15:50:06 +0000 Subject: Tcl-9 huge cleanup: Remove many unused internal functions which do nothing more than occupy the internal stub table. --- generic/tcl.decls | 16 +-- generic/tclDecls.h | 19 +-- generic/tclInt.decls | 279 ++++++++++++++++++++++------------------- generic/tclIntDecls.h | 276 +++++++++++------------------------------ generic/tclIntPlatDecls.h | 131 +++++++------------- generic/tclStubInit.c | 206 ++++++------------------------ unix/tclUnixThrd.c | 52 -------- unix/tclUnixTime.c | 202 ------------------------------ win/tclWinSock.c | 62 ---------- win/tclWinTime.c | 310 ---------------------------------------------- 10 files changed, 320 insertions(+), 1233 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..7428911 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -780,10 +780,10 @@ declare 218 { declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Obsolete -declare 220 { - int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) -} +# Removed in 9.0: +#declare 220 { +# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +#} declare 221 { int Tcl_ServiceAll(void) } @@ -868,10 +868,10 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Obsolete -declare 246 { - int Tcl_TellOld(Tcl_Channel chan) -} +# Removed in 9.0: +#declare 246 { +# int Tcl_TellOld(Tcl_Channel chan) +#} declare 247 { int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 17d60a8..752760a 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -668,8 +668,7 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ EXTERN int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr); -/* 220 */ -EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); +/* Slot 220 is reserved */ /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ @@ -740,8 +739,7 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, Tcl_PackageInitProc *safeInitProc); /* 245 */ EXTERN int Tcl_StringMatch(const char *str, const char *pattern); -/* 246 */ -EXTERN int Tcl_TellOld(Tcl_Channel chan); +/* Slot 246 is reserved */ /* 247 */ EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, @@ -2086,7 +2084,7 @@ typedef struct TclStubs { void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ - int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ + void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ @@ -2112,7 +2110,7 @@ typedef struct TclStubs { void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */ void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ - int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ + void (*reserved246)(void); int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ @@ -2969,8 +2967,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ -#define Tcl_SeekOld \ - (tclStubsPtr->tcl_SeekOld) /* 220 */ +/* Slot 220 is reserved */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ @@ -3021,8 +3018,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_StaticPackage) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ +/* Slot 246 is reserved */ #define Tcl_TraceVar \ (tclStubsPtr->tcl_TraceVar) /* 247 */ #define Tcl_TraceVar2 \ @@ -3826,9 +3822,6 @@ extern const TclStubs *tclStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef Tcl_SeekOld -#undef Tcl_TellOld - #undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index dea698c..ec0b489 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -50,10 +50,11 @@ declare 6 { declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } -declare 8 { - int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, - Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) -} +# Removed in 9.0: +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. @@ -419,9 +420,10 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -declare 104 { - int TclSockMinimumBuffersOld(int sock, int size) -} +# Removed in 9.0: +#declare 104 { +# int TclSockMinimumBuffersOld(int sock, int size) +#} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -454,29 +456,35 @@ declare 111 { Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } -declare 112 { - int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - Tcl_Obj *objPtr) -} -declare 113 { - Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) -} -declare 114 { - void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) -} -declare 115 { - int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst) -} -declare 116 { - Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} -declare 117 { - Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} +# Removed in 9.0: +#declare 112 { +# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 113 { +# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, +# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) +#} +# Removed in 9.0: +#declare 114 { +# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) +#} +# Removed in 9.0: +#declare 115 { +# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int resetListFirst) +#} +# Removed in 9.0: +#declare 116 { +# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} +# Removed in 9.0: +#declare 117 { +# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) @@ -489,31 +497,37 @@ declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } -declare 121 { - int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern) -} -declare 122 { - Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} -declare 123 { - void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, - Tcl_Obj *objPtr) -} -declare 124 { - Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) -} -declare 125 { - Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) -} +# Removed in 9.0: +#declare 121 { +# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern) +#} +# Removed in 9.0: +#declare 122 { +# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 123 { +# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 124 { +# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) +#} +# Removed in 9.0: +#declare 125 { +# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) +#} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } -declare 127 { - int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite) -} +# Removed in 9.0: +#declare 127 { +# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int allowOverwrite) +#} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } @@ -532,9 +546,10 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -declare 133 { - struct tm *TclpGetDate(const time_t *time, int useGMT) -} +# Removed in 9.0 +#declare 133 { +# struct tm *TclpGetDate(const time_t *time, int useGMT) +#} # Removed in 8.5 #declare 134 { # size_t TclpStrftime(char *s, size_t maxsize, const char *format, @@ -625,14 +640,14 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -# REMOVED (except from stub table) - use public Tcl_SetStartupScript() -declare 158 { - void TclSetStartupScriptFileName(const char *filename) -} -# REMOVED (except from stub table) - use public Tcl_GetStartupScript() -declare 159 { - const char *TclGetStartupScriptFileName(void) -} +# Removed in 9.0: +#declare 158 { +# void TclSetStartupScriptFileName(const char *filename) +#} +# Removed in 9.0: +#declare 159 { +# const char *TclGetStartupScriptFileName(void) +#} #declare 160 { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, @@ -677,14 +692,14 @@ declare 166 { } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) -# REMOVED (except from stub table) - use public Tcl_SetStartupScript() -declare 167 { - void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -} -# REMOVED (except from stub table) - use public Tcl_GetStartupScript() -declare 168 { - Tcl_Obj *TclGetStartupScriptPath(void) -} +# Removed from 9.0: +#declare 167 { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +# Removed from 9.0: +#declare 168 { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) @@ -730,13 +745,13 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -# TIP 338 made these public - now declared in tcl.h too -declare 178 { - void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) -} -declare 179 { - Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) -} +# TIP 338 moved those to the public API +#declare 178 { +# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +#} +#declare 179 { +# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) +#} # REMOVED # Allocate lists without copying arrays @@ -748,14 +763,14 @@ declare 179 { # const char *file, int line) #} -# TclpGmtime and TclpLocaltime promoted to the generic interface from unix - -declare 182 { - struct tm *TclpLocaltime(const time_t *clock) -} -declare 183 { - struct tm *TclpGmtime(const time_t *clock) -} +# Removed in 9.0 +#declare 182 { +# struct tm *TclpLocaltime(const time_t *clock) +#} +# Removed in 9.0 +#declare 183 { +# struct tm *TclpGmtime(const time_t *clock) +#} # For the new "Thread Storage" subsystem. @@ -940,9 +955,10 @@ declare 235 { # TIP 337 made this one public -declare 236 { - void TclBackgroundException(Tcl_Interp *interp, int code) -} +# Removed in 9.0 +#declare 236 { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 { @@ -1051,17 +1067,20 @@ interface tclIntPlat declare 0 win { void TclWinConvertError(DWORD errCode) } -declare 1 win { - void TclWinConvertWSAError(DWORD errCode) -} -declare 2 win { - struct servent *TclWinGetServByName(const char *nm, - const char *proto) -} -declare 3 win { - int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen) -} +# Removed in 9.0: +#declare 1 win { +# void TclWinConvertWSAError(DWORD errCode) +#} +# Removed in 9.0: +#declare 2 win { +# struct servent *TclWinGetServByName(const char *nm, +# const char *proto) +#} +# Removed in 9.0: +#declare 3 win { +# int TclWinGetSockOpt(SOCKET s, int level, int optname, +# char *optval, int *optlen) +#} declare 4 win { HINSTANCE TclWinGetTclInstance(void) } @@ -1073,23 +1092,25 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -declare 6 win { - unsigned short TclWinNToHS(unsigned short ns) -} -declare 7 win { - int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen) -} +# Removed in 9.0: +#declare 6 win { +# unsigned short TclWinNToHS(unsigned short ns) +#} +# Removed in 9.0: +#declare 7 win { +# int TclWinSetSockOpt(SOCKET s, int level, int optname, +# const char *optval, int optlen) +#} declare 8 win { 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 9.0: +#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) @@ -1140,10 +1161,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 in 9.0: +#declare 21 win { +# char *TclpInetNtoa(struct in_addr addr) +#} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -1164,9 +1185,10 @@ declare 24 win { #declare 25 win { # TclPlatformType *TclWinGetPlatform(void) #} -declare 26 win { - void TclWinSetInterfaces(int wide) -} +# Removed in 9.0: +#declare 26 win { +# void TclWinSetInterfaces(int wide) +#} # Added in Tcl 8.3.3 / 8.4 @@ -1228,17 +1250,18 @@ declare 9 unix { declare 10 unix { Tcl_DirEntry *TclpReaddir(DIR *dir) } -# Slots 11 and 12 are forwarders for functions that were promoted to -# generic Stubs -declare 11 unix { - struct tm *TclpLocaltime_unix(const time_t *clock) -} -declare 12 unix { - struct tm *TclpGmtime_unix(const time_t *clock) -} -declare 13 unix { - char *TclpInetNtoa(struct in_addr addr) -} +# Removed in 9.0: +#declare 11 unix { +# struct tm *TclpLocaltime_unix(const time_t *clock) +#} +# Removed in 9.0: +#declare 12 unix { +# struct tm *TclpGmtime_unix(const time_t *clock) +#} +# Removed in 9.0: +#declare 13 unix { +# char *TclpInetNtoa(struct in_addr addr) +#} # Added in 8.5: diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5bccfe5..b20c31d 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -28,22 +28,6 @@ # endif #endif -/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */ -#undef Tcl_CreateNamespace -#undef Tcl_DeleteNamespace -#undef Tcl_AppendExportList -#undef Tcl_Export -#undef Tcl_Import -#undef Tcl_ForgetImport -#undef Tcl_GetCurrentNamespace -#undef Tcl_GetGlobalNamespace -#undef Tcl_FindNamespace -#undef Tcl_FindCommand -#undef Tcl_GetCommandFromObj -#undef Tcl_GetCommandFullName -#undef Tcl_SetStartupScript -#undef Tcl_GetStartupScript - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -74,10 +58,7 @@ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ EXTERN int TclCopyAndCollapse(int count, const char *src, char *dst); -/* 8 */ -EXTERN int TclCopyChannelOld(Tcl_Interp *interp, - Tcl_Channel inChan, Tcl_Channel outChan, - int toRead, Tcl_Obj *cmdPtr); +/* Slot 8 is reserved */ /* 9 */ EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, @@ -266,8 +247,7 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* 104 */ -EXTERN int TclSockMinimumBuffersOld(int sock, int size); +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -283,25 +263,12 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); -/* 112 */ -EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, - Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); -/* 113 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, - const char *name, ClientData clientData, - Tcl_NamespaceDeleteProc *deleteProc); -/* 114 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); -/* 115 */ -EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst); -/* 116 */ -EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags); -/* 117 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, - const char *name, - Tcl_Namespace *contextNsPtr, int flags); +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ /* 118 */ EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); @@ -313,25 +280,15 @@ EXTERN int Tcl_GetNamespaceResolvers( EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); -/* 121 */ -EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, - Tcl_Namespace *nsPtr, const char *pattern); -/* 122 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); -/* 123 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, - Tcl_Command command, Tcl_Obj *objPtr); -/* 124 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); -/* 125 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ /* 126 */ EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); -/* 127 */ -EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite); +/* Slot 127 is reserved */ /* 128 */ EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ @@ -349,8 +306,7 @@ EXTERN void Tcl_SetNamespaceResolvers( Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* 133 */ -EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT); +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -400,10 +356,8 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); -/* 158 */ -EXTERN void TclSetStartupScriptFileName(const char *filename); -/* 159 */ -EXTERN const char * TclGetStartupScriptFileName(void); +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform(Tcl_Interp *interp, @@ -421,10 +375,8 @@ EXTERN void TclpSetInitialEncodings(void); EXTERN int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); -/* 167 */ -EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr); -/* 168 */ -EXTERN Tcl_Obj * TclGetStartupScriptPath(void); +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ /* 169 */ EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n); @@ -456,17 +408,12 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); -/* 178 */ -EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr, - const char *encodingName); -/* 179 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* 182 */ -EXTERN struct tm * TclpLocaltime(const time_t *clock); -/* 183 */ -EXTERN struct tm * TclpGmtime(const time_t *clock); +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -569,8 +516,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* 236 */ -EXTERN void TclBackgroundException(Tcl_Interp *interp, int code); +/* Slot 236 is reserved */ /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ @@ -652,7 +598,7 @@ typedef struct TclIntStubs { int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ - int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ + void (*reserved8)(void); int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ @@ -748,7 +694,7 @@ typedef struct TclIntStubs { CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ - int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ + void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); @@ -756,28 +702,28 @@ typedef struct TclIntStubs { int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ 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 */ - void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ - int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ - Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ - Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ + void (*reserved112)(void); + void (*reserved113)(void); + void (*reserved114)(void); + void (*reserved115)(void); + void (*reserved116)(void); + void (*reserved117)(void); int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ - int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ - Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ - void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ - Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */ - Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */ + void (*reserved121)(void); + void (*reserved122)(void); + void (*reserved123)(void); + void (*reserved124)(void); + void (*reserved125)(void); void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ - int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ + void (*reserved127)(void); void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ + void (*reserved133)(void); void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); @@ -802,8 +748,8 @@ typedef struct TclIntStubs { void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ - void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ - const char * (*tclGetStartupScriptFileName) (void); /* 159 */ + void (*reserved158)(void); + void (*reserved159)(void); void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ @@ -811,8 +757,8 @@ typedef struct TclIntStubs { void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ - void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ - Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ + void (*reserved167)(void); + void (*reserved168)(void); int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ @@ -822,12 +768,12 @@ typedef struct TclIntStubs { int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ - Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ + void (*reserved178)(void); + void (*reserved179)(void); void (*reserved180)(void); void (*reserved181)(void); - struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ - struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ + void (*reserved182)(void); + void (*reserved183)(void); void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); @@ -880,7 +826,7 @@ typedef struct TclIntStubs { void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ - void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ + void (*reserved236)(void); int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ @@ -927,8 +873,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ -#define TclCopyChannelOld \ - (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ +/* Slot 8 is reserved */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ @@ -1075,8 +1020,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -#define TclSockMinimumBuffersOld \ - (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -1088,38 +1032,26 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ -#define Tcl_AppendExportList \ - (tclIntStubsPtr->tcl_AppendExportList) /* 112 */ -#define Tcl_CreateNamespace \ - (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */ -#define Tcl_DeleteNamespace \ - (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */ -#define Tcl_Export \ - (tclIntStubsPtr->tcl_Export) /* 115 */ -#define Tcl_FindCommand \ - (tclIntStubsPtr->tcl_FindCommand) /* 116 */ -#define Tcl_FindNamespace \ - (tclIntStubsPtr->tcl_FindNamespace) /* 117 */ +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ -#define Tcl_ForgetImport \ - (tclIntStubsPtr->tcl_ForgetImport) /* 121 */ -#define Tcl_GetCommandFromObj \ - (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */ -#define Tcl_GetCommandFullName \ - (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */ -#define Tcl_GetCurrentNamespace \ - (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */ -#define Tcl_GetGlobalNamespace \ - (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */ +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ -#define Tcl_Import \ - (tclIntStubsPtr->tcl_Import) /* 127 */ +/* Slot 127 is reserved */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ @@ -1130,8 +1062,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -#define TclpGetDate \ - (tclIntStubsPtr->tclpGetDate) /* 133 */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1172,10 +1103,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ -#define TclSetStartupScriptFileName \ - (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ -#define TclGetStartupScriptFileName \ - (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ @@ -1189,10 +1118,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ -#define TclSetStartupScriptPath \ - (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ -#define TclGetStartupScriptPath \ - (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ @@ -1210,16 +1137,12 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -#define Tcl_SetStartupScript \ - (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */ -#define Tcl_GetStartupScript \ - (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -#define TclpLocaltime \ - (tclIntStubsPtr->tclpLocaltime) /* 182 */ -#define TclpGmtime \ - (tclIntStubsPtr->tclpGmtime) /* 183 */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -1300,8 +1223,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -#define TclBackgroundException \ - (tclIntStubsPtr->tclBackgroundException) /* 236 */ +/* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ @@ -1350,58 +1272,4 @@ extern const TclIntStubs *tclIntStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclGetStartupScriptFileName -#undef TclSetStartupScriptFileName -#undef TclGetStartupScriptPath -#undef TclSetStartupScriptPath -#undef TclBackgroundException - -#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED) -# undef Tcl_SetStartupScript -# define Tcl_SetStartupScript \ - (tclStubsPtr->tcl_SetStartupScript) /* 622 */ -# undef Tcl_GetStartupScript -# define Tcl_GetStartupScript \ - (tclStubsPtr->tcl_GetStartupScript) /* 623 */ -# undef Tcl_CreateNamespace -# define Tcl_CreateNamespace \ - (tclStubsPtr->tcl_CreateNamespace) /* 506 */ -# undef Tcl_DeleteNamespace -# define Tcl_DeleteNamespace \ - (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ -# undef Tcl_AppendExportList -# define Tcl_AppendExportList \ - (tclStubsPtr->tcl_AppendExportList) /* 508 */ -# undef Tcl_Export -# define Tcl_Export \ - (tclStubsPtr->tcl_Export) /* 509 */ -# undef Tcl_Import -# define Tcl_Import \ - (tclStubsPtr->tcl_Import) /* 510 */ -# undef Tcl_ForgetImport -# define Tcl_ForgetImport \ - (tclStubsPtr->tcl_ForgetImport) /* 511 */ -# undef Tcl_GetCurrentNamespace -# define Tcl_GetCurrentNamespace \ - (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ -# undef Tcl_GetGlobalNamespace -# define Tcl_GetGlobalNamespace \ - (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ -# undef Tcl_FindNamespace -# define Tcl_FindNamespace \ - (tclStubsPtr->tcl_FindNamespace) /* 514 */ -# undef Tcl_FindCommand -# define Tcl_FindCommand \ - (tclStubsPtr->tcl_FindCommand) /* 515 */ -# undef Tcl_GetCommandFromObj -# define Tcl_GetCommandFromObj \ - (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ -# undef Tcl_GetCommandFullName -# define Tcl_GetCommandFullName \ - (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ -#endif - -#undef TclCopyChannelOld -#undef TclSockMinimumBuffersOld - #endif /* _TCLINTDECLS */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 494d6f1..f9e74df 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -73,12 +73,9 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -107,29 +104,20 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); -/* 1 */ -EXTERN void TclWinConvertWSAError(DWORD errCode); -/* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, - const char *proto); -/* 3 */ -EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen); +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); -/* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); -/* 7 */ -EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen); +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ /* 8 */ EXTERN int TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN int TclWinGetPlatformId(void); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +/* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -158,16 +146,14 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); -/* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); +/* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); /* 28 */ @@ -207,12 +193,9 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -270,9 +253,9 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ 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 */ + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ void (*reserved15)(void); void (*reserved16)(void); @@ -293,16 +276,16 @@ typedef struct TclIntPlatStubs { #endif /* UNIX */ #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 */ + void (*reserved1)(void); + void (*reserved2)(void); + void (*reserved3)(void); HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ 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 */ + void (*reserved6)(void); + void (*reserved7)(void); int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ + void (*reserved10)(void); 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 */ @@ -313,12 +296,12 @@ 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 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ + void (*reserved21)(void); TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); - void (*tclWinSetInterfaces) (int wide); /* 26 */ + void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*tclWinResetInterfaces) (void); /* 28 */ int (*tclWinCPUID) (int index, int *regs); /* 29 */ @@ -336,9 +319,9 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ 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 */ + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); 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 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ @@ -393,12 +376,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ /* Slot 15 is reserved */ @@ -423,26 +403,20 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +/* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -463,16 +437,14 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +/* Slot 21 is reserved */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ +/* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ #define TclWinResetInterfaces \ @@ -504,12 +476,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -543,23 +512,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclpLocaltime_unix -#undef TclpGmtime_unix -#undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError -#undef TclpInetNtoa -#define TclpInetNtoa inet_ntoa -#if defined(_WIN32) -# undef TclWinNToHS -# undef TclWinGetServByName -# undef TclWinGetSockOpt -# undef TclWinSetSockOpt -# define TclWinNToHS ntohs -# define TclWinGetServByName getservbyname -# define TclWinGetSockOpt getsockopt -# define TclWinSetSockOpt setsockopt -#else +#if !defined(_WIN32) # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) #endif diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..b138fe2 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -42,70 +42,12 @@ #undef TclpGetPid #undef TclSockMinimumBuffers #undef Tcl_SetIntObj -#undef TclpInetNtoa -#undef TclWinGetServByName -#undef TclWinGetSockOpt -#undef TclWinSetSockOpt -#undef TclWinNToHS - -/* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) -# define TclSockMinimumBuffersOld 0 -#else -#define TclSockMinimumBuffersOld sockMinimumBuffersOld -static int TclSockMinimumBuffersOld(int sock, int size) -{ - return TclSockMinimumBuffers(INT2PTR(sock), size); -} -#endif #if defined(TCL_NO_DEPRECATED) -# define TclSetStartupScriptPath 0 -# define TclGetStartupScriptPath 0 -# define TclSetStartupScriptFileName 0 -# define TclGetStartupScriptFileName 0 -# define TclpInetNtoa 0 -# define TclWinGetServByName 0 -# define TclWinGetSockOpt 0 -# define TclWinSetSockOpt 0 -# define TclWinNToHS 0 # define TclBNInitBignumFromWideUInt 0 # define TclBNInitBignumFromWideInt 0 # define TclBNInitBignumFromLong 0 #else -#define TclSetStartupScriptPath setStartupScriptPath -static void TclSetStartupScriptPath(Tcl_Obj *path) -{ - Tcl_SetStartupScript(path, NULL); -} -#define TclGetStartupScriptPath getStartupScriptPath -static Tcl_Obj *TclGetStartupScriptPath(void) -{ - return Tcl_GetStartupScript(NULL); -} -#define TclSetStartupScriptFileName setStartupScriptFileName -static void TclSetStartupScriptFileName( - const char *fileName) -{ - Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); -} -#define TclGetStartupScriptFileName getStartupScriptFileName -static const char *TclGetStartupScriptFileName(void) -{ - Tcl_Obj *path = Tcl_GetStartupScript(NULL); - if (path == NULL) { - return NULL; - } - return Tcl_GetString(path); -} - -#if defined(_WIN32) || defined(__CYGWIN__) -#undef TclWinNToHS -#define TclWinNToHS winNToHS -static unsigned short TclWinNToHS(unsigned short ns) { - return ntohs(ns); -} -#endif # define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt # define TclBNInitBignumFromWideInt TclInitBignumFromWideInt # define TclBNInitBignumFromLong TclInitBignumFromLong @@ -115,11 +57,9 @@ static unsigned short TclWinNToHS(unsigned short ns) { # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 -# define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty -# define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing # define TclWinResetInterfaces doNothing @@ -149,31 +89,6 @@ void *TclWinGetTclInstance() return hInstance; } -#ifndef TCL_NO_DEPRECATED -#define TclWinSetSockOpt winSetSockOpt -static int -TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen) -{ - return setsockopt((int) s, level, optname, optval, optlen); -} - -#define TclWinGetSockOpt winGetSockOpt -static int -TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen) -{ - return getsockopt((int) s, level, optname, optval, optlen); -} - -#define TclWinGetServByName winGetServByName -static struct servent * -TclWinGetServByName(const char *name, const char *proto) -{ - return getservbyname(name, proto); -} -#endif /* TCL_NO_DEPRECATED */ - #define TclWinNoBackslash winNoBackslash static char * TclWinNoBackslash(char *path) @@ -312,8 +227,6 @@ static int formatInt(char *buffer, int n){ #endif /* __CYGWIN__ */ #ifdef TCL_NO_DEPRECATED -# define Tcl_SeekOld 0 -# define Tcl_TellOld 0 # undef Tcl_SetBooleanObj # define Tcl_SetBooleanObj 0 # undef Tcl_PkgPresent @@ -363,45 +276,6 @@ static int formatInt(char *buffer, int n){ # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 -# define TclBackgroundException 0 -# undef TclpReaddir -# define TclpReaddir 0 -# undef TclpGetDate -# define TclpGetDate 0 -# undef TclpLocaltime -# define TclpLocaltime 0 -# undef TclpGmtime -# define TclpGmtime 0 -# define TclpLocaltime_unix 0 -# define TclpGmtime_unix 0 -#else /* TCL_NO_DEPRECATED */ -# define Tcl_SeekOld seekOld -# define Tcl_TellOld tellOld -# define TclBackgroundException Tcl_BackgroundException -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime - -static int -seekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - Tcl_WideInt wOffset, wResult; - - wOffset = Tcl_LongAsWide((long) offset); - wResult = Tcl_Seek(chan, wOffset, mode); - return (int) Tcl_WideAsLong(wResult); -} - -static int -tellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); -} #endif /* !TCL_NO_DEPRECATED */ /* @@ -426,7 +300,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -522,7 +396,7 @@ static const TclIntStubs tclIntStubs = { TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -530,28 +404,28 @@ static const TclIntStubs tclIntStubs = { TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ - Tcl_AppendExportList, /* 112 */ - Tcl_CreateNamespace, /* 113 */ - Tcl_DeleteNamespace, /* 114 */ - Tcl_Export, /* 115 */ - Tcl_FindCommand, /* 116 */ - Tcl_FindNamespace, /* 117 */ + 0, /* 112 */ + 0, /* 113 */ + 0, /* 114 */ + 0, /* 115 */ + 0, /* 116 */ + 0, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ - Tcl_ForgetImport, /* 121 */ - Tcl_GetCommandFromObj, /* 122 */ - Tcl_GetCommandFullName, /* 123 */ - Tcl_GetCurrentNamespace, /* 124 */ - Tcl_GetGlobalNamespace, /* 125 */ + 0, /* 121 */ + 0, /* 122 */ + 0, /* 123 */ + 0, /* 124 */ + 0, /* 125 */ Tcl_GetVariableFullName, /* 126 */ - Tcl_Import, /* 127 */ + 0, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - TclpGetDate, /* 133 */ + 0, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -576,8 +450,8 @@ static const TclIntStubs tclIntStubs = { 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - TclSetStartupScriptFileName, /* 158 */ - TclGetStartupScriptFileName, /* 159 */ + 0, /* 158 */ + 0, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ @@ -585,8 +459,8 @@ static const TclIntStubs tclIntStubs = { TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - TclSetStartupScriptPath, /* 167 */ - TclGetStartupScriptPath, /* 168 */ + 0, /* 167 */ + 0, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ @@ -596,12 +470,12 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - Tcl_SetStartupScript, /* 178 */ - Tcl_GetStartupScript, /* 179 */ + 0, /* 178 */ + 0, /* 179 */ 0, /* 180 */ 0, /* 181 */ - TclpLocaltime, /* 182 */ - TclpGmtime, /* 183 */ + 0, /* 182 */ + 0, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -654,7 +528,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -692,9 +566,9 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ 0, /* 15 */ 0, /* 16 */ @@ -715,16 +589,16 @@ static const TclIntPlatStubs tclIntPlatStubs = { #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ + 0, /* 1 */ + 0, /* 2 */ + 0, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ + 0, /* 6 */ + 0, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ - TclpReaddir, /* 10 */ + 0, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ @@ -735,12 +609,12 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - TclpInetNtoa, /* 21 */ + 0, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ - TclWinSetInterfaces, /* 26 */ + 0, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ @@ -758,9 +632,9 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ @@ -1124,7 +998,7 @@ const TclStubs tclStubs = { Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - Tcl_SeekOld, /* 220 */ + 0, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ @@ -1150,7 +1024,7 @@ const TclStubs tclStubs = { Tcl_SplitPath, /* 243 */ Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ + 0, /* 246 */ Tcl_TraceVar, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index f475aed..bb78e51 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -15,12 +15,6 @@ #ifdef TCL_THREADS -typedef struct { - char nabuf[16]; -} ThreadSpecificData; - -static Tcl_ThreadDataKey dataKey; - /* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the @@ -623,52 +617,6 @@ TclpFinalizeCondition( } #endif /* TCL_THREADS */ -/* - *---------------------------------------------------------------------- - * - * TclpReaddir, TclpInetNtoa -- - * - * These procedures replace core C versions to be used in a threaded - * environment. - * - * Results: - * See documentation of C functions. - * - * Side effects: - * See documentation of C functions. - * - * Notes: - * TclpReaddir is no longer used by the core (see 1095909), but it - * appears in the internal stubs table (see #589526). - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -Tcl_DirEntry * -TclpReaddir( - DIR * dir) -{ - return TclOSreaddir(dir); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ -#ifdef TCL_THREADS - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - unsigned char *b = (unsigned char*) &addr.s_addr; - - sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); - return tsdPtr->nabuf; -#else - return inet_ntoa(addr); -#endif -} -#endif /* TCL_NO_DEPRECATED */ - #ifdef TCL_THREADS /* * Additions by AOL for specialized thread memory allocator. diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 6a73ac2..2d6560b 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -22,32 +22,6 @@ * variable is the key to this buffer. */ -#ifndef TCL_NO_DEPRECATED -static Tcl_ThreadDataKey tmKey; -typedef struct { - struct tm gmtime_buf; - struct tm localtime_buf; -} ThreadSpecificData; - -/* - * If we fall back on the thread-unsafe versions of gmtime and localtime, use - * this mutex to try to protect them. - */ - -TCL_DECLARE_MUTEX(tmMutex) - -static char *lastTZ = NULL; /* Holds the last setting of the TZ - * environment variable, or an empty string if - * the variable was not set. */ - -/* - * Static functions declared in this file. - */ - -static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); -#endif /* TCL_NO_DEPRECATED */ - static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, @@ -251,116 +225,6 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGetDate( - const time_t *time, - int useGMT) -{ - if (useGMT) { - return TclpGmtime(time); - } else { - return TclpLocaltime(time); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - -#ifdef HAVE_GMTIME_R - gmtime_r(timePtr, &tsdPtr->gmtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->gmtime_buf; -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - - SetTZIfNecessary(); -#ifdef HAVE_LOCALTIME_R - localtime_r(timePtr, &tsdPtr->localtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->localtime_buf; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -472,72 +336,6 @@ NativeGetTime( timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } -/* - *---------------------------------------------------------------------- - * - * SetTZIfNecessary -- - * - * Determines whether a call to 'tzset' is needed prior to the next call - * to 'localtime' or examination of the 'timezone' variable. - * - * Results: - * None. - * - * Side effects: - * If 'tzset' has never been called in the current process, or if the - * value of the environment variable TZ has changed since the last call - * to 'tzset', then 'tzset' is called again. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static void -SetTZIfNecessary(void) -{ - const char *newTZ = getenv("TZ"); - - Tcl_MutexLock(&tmMutex); - if (newTZ == NULL) { - newTZ = ""; - } - if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { - tzset(); - if (lastTZ == NULL) { - Tcl_CreateExitHandler(CleanupMemory, NULL); - } else { - ckfree(lastTZ); - } - lastTZ = ckalloc(strlen(newTZ) + 1); - strcpy(lastTZ, newTZ); - } - Tcl_MutexUnlock(&tmMutex); -} - -/* - *---------------------------------------------------------------------- - * - * CleanupMemory -- - * - * Releases the private copy of the TZ environment variable upon exit - * from Tcl. - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -CleanupMemory( - ClientData ignored) -{ - ckfree(lastTZ); -} -#endif /* TCL_NO_DEPRECATED */ /* * Local Variables: diff --git a/win/tclWinSock.c b/win/tclWinSock.c index ee6be96..7be194e 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -3404,68 +3404,6 @@ FindFDInList( /* *---------------------------------------------------------------------- * - * TclWinGetSockOpt, et al. -- - * - * Those functions are historically exported by the stubs table and - * just use the original system calls now. - * - * Warning: - * Those functions are depreciated and will be removed with TCL 9.0. - * - * Results: - * As defined for each function. - * - * Side effects: - * As defined for each function. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef TclWinGetSockOpt -int -TclWinGetSockOpt( - SOCKET s, - int level, - int optname, - char *optval, - int *optlen) -{ - - return getsockopt(s, level, optname, optval, optlen); -} -#undef TclWinSetSockOpt -int -TclWinSetSockOpt( - SOCKET s, - int level, - int optname, - const char *optval, - int optlen) -{ - return setsockopt(s, level, optname, optval, optlen); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ - return inet_ntoa(addr); -} -#undef TclWinGetServByName -struct servent * -TclWinGetServByName( - const char *name, - const char *proto) -{ - return getservbyname(name, proto); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * TcpThreadActionProc -- * * Insert or remove any thread local refs to this channel. diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 18702e7..83d691d 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -23,27 +23,6 @@ #define SAMPLES 64 /* - * The following arrays contain the day of year for the last day of each - * month, where index 1 is January. - */ - -#ifndef TCL_NO_DEPRECATED -static const int normalDays[] = { - -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 -}; - -static const int leapDays[] = { - -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 -}; - -typedef struct { - char tzName[64]; /* Time zone name */ - struct tm tm; /* time information */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; -#endif /* TCL_NO_DEPRECATED */ - -/* * Data for managing high-resolution timers. */ @@ -115,9 +94,6 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ -#ifndef TCL_NO_DEPRECATED -static struct tm * ComputeGMT(const time_t *tp); -#endif /* TCL_NO_DEPRECATED */ static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -511,229 +487,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGetDate( - const time_t *t, - int useGMT) -{ - struct tm *tmPtr; - time_t time; - - if (!useGMT) { - tzset(); - - /* - * If we are in the valid range, let the C run-time library handle it. - * Otherwise we need to fake it. Note that this algorithm ignores - * daylight savings time before the epoch. - */ - - /* - * Hm, Borland's localtime manages to return NULL under certain - * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, - * since 'localtime' isn't supposed to do this, possibly leading to - * crashes. - * - * Patch: We only call this function if we are at least one day into - * the epoch, else we handle it ourselves (like we do for times < 0). - * H. Giese, June 2003 - */ - -#ifdef __BORLANDC__ -#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY -#else -#define LOCALTIME_VALIDITY_BOUNDARY 0 -#endif - - if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(t); - } - - time = *t - timezone; - - /* - * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust the - * result at the end. - */ - - if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(t); - - tzset(); - - /* - * Add the bias directly to the tm structure to avoid overflow. - * Propagate seconds overflow into minutes, hours and days. - */ - - time = tmPtr->tm_sec - timezone; - tmPtr->tm_sec = (int)(time % 60); - if (tmPtr->tm_sec < 0) { - tmPtr->tm_sec += 60; - time -= 60; - } - - time = tmPtr->tm_min + time/60; - tmPtr->tm_min = (int)(time % 60); - if (tmPtr->tm_min < 0) { - tmPtr->tm_min += 60; - time -= 60; - } - - time = tmPtr->tm_hour + time/60; - tmPtr->tm_hour = (int)(time % 24); - if (tmPtr->tm_hour < 0) { - tmPtr->tm_hour += 24; - time -= 24; - } - - time /= 24; - tmPtr->tm_mday += (int)time; - tmPtr->tm_yday += (int)time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; - } - } else { - tmPtr = ComputeGMT(t); - } - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * - * ComputeGMT -- - * - * This function computes GMT given the number of seconds since the epoch - * (midnight Jan 1 1970). - * - * Results: - * Returns a (per thread) statically allocated struct tm. - * - * Side effects: - * Updates the values of the static struct tm. - * - *---------------------------------------------------------------------- - */ - -static struct tm * -ComputeGMT( - const time_t *tp) -{ - struct tm *tmPtr; - long tmp, rem; - int isLeap; - const int *days; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tmPtr = &tsdPtr->tm; - - /* - * Compute the 4 year span containing the specified time. - */ - - tmp = (long)(*tp / SECSPER4YEAR); - rem = (long)(*tp % SECSPER4YEAR); - - /* - * Correct for weird mod semantics so the remainder is always positive. - */ - - if (rem < 0) { - tmp--; - rem += SECSPER4YEAR; - } - - /* - * Compute the year after 1900 by taking the 4 year span and adjusting for - * the remainder. This works because 2000 is a leap year, and 1900/2100 - * are out of the range. - */ - - tmp = (tmp * 4) + 70; - isLeap = 0; - if (rem >= SECSPERYEAR) { /* 1971, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR) { /* 1972, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ - tmp++; - rem -= SECSPERYEAR + SECSPERDAY; - } else { - isLeap = 1; - } - } - } - tmPtr->tm_year = tmp; - - /* - * Compute the day of year and leave the seconds in the current day in the - * remainder. - */ - - tmPtr->tm_yday = rem / SECSPERDAY; - rem %= SECSPERDAY; - - /* - * Compute the time of day. - */ - - tmPtr->tm_hour = rem / 3600; - rem %= 3600; - tmPtr->tm_min = rem / 60; - tmPtr->tm_sec = rem % 60; - - /* - * Compute the month and day of month. - */ - - days = (isLeap) ? leapDays : normalDays; - for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { - /* empty body */ - } - tmPtr->tm_mon = --tmp; - tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; - - /* - * Compute day of week. Epoch started on a Thursday. - */ - - tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; - if ((*tp % SECSPERDAY) < 0) { - tmPtr->tm_wday--; - } - tmPtr->tm_wday %= 7; - if (tmPtr->tm_wday < 0) { - tmPtr->tm_wday += 7; - } - - return tmPtr; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -1061,69 +814,6 @@ AccumulateSample( /* *---------------------------------------------------------------------- * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of gmtime is thread safe because it returns the - * time in a block of thread-local storage, and Windows does not provide a - * Posix gmtime_r function. - */ - - return gmtime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of localtime is thread safe because it returns - * the time in a block of thread-local storage, and Windows does not - * provide a Posix localtime_r function. - */ - - return localtime(timePtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the -- cgit v0.12 From a31c6998331d753a6a0473e26f6f8c7a1b6c03dc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Nov 2017 16:12:29 +0000 Subject: Forgot TclpGetTime() --- generic/tcl.decls | 4 ++-- generic/tclInt.decls | 52 +++++++++++++++++++++++------------------------ generic/tclIntDecls.h | 8 +++----- generic/tclIntPlatDecls.h | 16 ++++++--------- generic/tclStubInit.c | 6 +++--- generic/tclUtil.c | 25 ----------------------- 6 files changed, 40 insertions(+), 71 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 7428911..de1c581 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -780,7 +780,7 @@ declare 218 { declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Removed in 9.0: +# Removed in Tcl 9 #declare 220 { # int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) #} @@ -868,7 +868,7 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Removed in 9.0: +# Removed in Tcl 9 #declare 246 { # int Tcl_TellOld(Tcl_Channel chan) #} diff --git a/generic/tclInt.decls b/generic/tclInt.decls index ec0b489..d6e41bb 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -50,7 +50,7 @@ declare 6 { declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } -# Removed in 9.0: +# Removed in Tcl 9 #declare 8 { # int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, # Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) @@ -315,10 +315,10 @@ declare 76 { unsigned long TclpGetSeconds(void) } -# deprecated -declare 77 { - void TclpGetTime(Tcl_Time *time) -} +# Removed in 9.0: +#declare 77 { +# void TclpGetTime(Tcl_Time *time) +#} # Removed in 8.6: #declare 78 { # int TclpGetTimeZone(unsigned long time) @@ -420,7 +420,7 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -# Removed in 9.0: +# Removed in Tcl 9 #declare 104 { # int TclSockMinimumBuffersOld(int sock, int size) #} @@ -640,11 +640,11 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -# Removed in 9.0: +# REMOVED - use public Tcl_SetStartupScript() #declare 158 { # void TclSetStartupScriptFileName(const char *filename) #} -# Removed in 9.0: +# REMOVED - use public Tcl_GetStartupScript() #declare 159 { # const char *TclGetStartupScriptFileName(void) #} @@ -692,11 +692,11 @@ declare 166 { } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) -# Removed from 9.0: +# REMOVED - use public Tcl_SetStartupScript() #declare 167 { # void TclSetStartupScriptPath(Tcl_Obj *pathPtr) #} -# Removed from 9.0: +# REMOVED - use public Tcl_GetStartupScript() #declare 168 { # Tcl_Obj *TclGetStartupScriptPath(void) #} @@ -745,7 +745,7 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -# TIP 338 moved those to the public API +# TIP 338 made these public - now declared in tcl.h #declare 178 { # void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) #} @@ -955,7 +955,6 @@ declare 235 { # TIP 337 made this one public -# Removed in 9.0 #declare 236 { # void TclBackgroundException(Tcl_Interp *interp, int code) #} @@ -1067,16 +1066,16 @@ interface tclIntPlat declare 0 win { void TclWinConvertError(DWORD errCode) } -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 1 win { # void TclWinConvertWSAError(DWORD errCode) #} -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 2 win { # struct servent *TclWinGetServByName(const char *nm, # const char *proto) #} -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 3 win { # int TclWinGetSockOpt(SOCKET s, int level, int optname, # char *optval, int *optlen) @@ -1092,11 +1091,11 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -# Removed in 9.0: +# Removed in Tcl 9.0: #declare 6 win { # unsigned short TclWinNToHS(unsigned short ns) #} -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 7 win { # int TclWinSetSockOpt(SOCKET s, int level, int optname, # const char *optval, int optlen) @@ -1107,7 +1106,7 @@ declare 8 win { declare 9 win { int TclWinGetPlatformId(void) } -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 10 win { # Tcl_DirEntry *TclpReaddir(DIR *dir) #} @@ -1161,7 +1160,7 @@ declare 19 win { declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 21 win { # char *TclpInetNtoa(struct in_addr addr) #} @@ -1185,7 +1184,7 @@ declare 24 win { #declare 25 win { # TclPlatformType *TclWinGetPlatform(void) #} -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 26 win { # void TclWinSetInterfaces(int wide) #} @@ -1247,18 +1246,19 @@ declare 9 unix { # Added in 8.4: -declare 10 unix { - Tcl_DirEntry *TclpReaddir(DIR *dir) -} -# Removed in 9.0: +# Removed in Tcl 9.0 +#declare 10 unix { +# Tcl_DirEntry *TclpReaddir(DIR *dir) +#} +# Removed in Tcl 9.0 #declare 11 unix { # struct tm *TclpLocaltime_unix(const time_t *clock) #} -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 12 unix { # struct tm *TclpGmtime_unix(const time_t *clock) #} -# Removed in 9.0: +# Removed in Tcl 9.0 #declare 13 unix { # char *TclpInetNtoa(struct in_addr addr) #} diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index b20c31d..3a61f9c 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -198,8 +198,7 @@ EXTERN void TclpFree(char *ptr); EXTERN unsigned long TclpGetClicks(void); /* 76 */ EXTERN unsigned long TclpGetSeconds(void); -/* 77 */ -EXTERN void TclpGetTime(Tcl_Time *time); +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ @@ -667,7 +666,7 @@ typedef struct TclIntStubs { void (*tclpFree) (char *ptr); /* 74 */ unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*tclpGetSeconds) (void); /* 76 */ - void (*tclpGetTime) (Tcl_Time *time); /* 77 */ + void (*reserved77)(void); void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); @@ -980,8 +979,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ -#define TclpGetTime \ - (tclIntStubsPtr->tclpGetTime) /* 77 */ +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index f9e74df..6da74f9 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -71,8 +71,7 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +/* Slot 10 is reserved */ /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ @@ -191,8 +190,7 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +/* Slot 10 is reserved */ /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ @@ -252,7 +250,7 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ + void (*reserved10)(void); void (*reserved11)(void); void (*reserved12)(void); void (*reserved13)(void); @@ -318,7 +316,7 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ + void (*reserved10)(void); void (*reserved11)(void); void (*reserved12)(void); void (*reserved13)(void); @@ -374,8 +372,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +/* Slot 10 is reserved */ /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ @@ -474,8 +471,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +/* Slot 10 is reserved */ /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index b138fe2..8c97902 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -369,7 +369,7 @@ static const TclIntStubs tclIntStubs = { TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - TclpGetTime, /* 77 */ + 0, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ @@ -565,7 +565,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ + 0, /* 10 */ 0, /* 11 */ 0, /* 12 */ 0, /* 13 */ @@ -631,7 +631,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ + 0, /* 10 */ 0, /* 11 */ 0, /* 12 */ 0, /* 13 */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index bfa4b2d..4a83413 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4078,31 +4078,6 @@ Tcl_GetNameOfExecutable(void) /* *---------------------------------------------------------------------- * - * TclpGetTime -- - * - * Deprecated synonym for Tcl_GetTime. This function is provided for the - * benefit of extensions written before Tcl_GetTime was exported from the - * library. - * - * Results: - * None. - * - * Side effects: - * Stores current time in the buffer designated by "timePtr" - * - *---------------------------------------------------------------------- - */ - -void -TclpGetTime( - Tcl_Time *timePtr) -{ - Tcl_GetTime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the -- cgit v0.12 From 258b9f4333558f28988e0cbbc816a10987daf61c Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 8 Nov 2017 18:52:33 +0000 Subject: Also remove panicVA(). --- generic/tcl.h | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index 9cd7114..183cc1c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2574,7 +2574,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */ # define panic Tcl_Panic #endif -# define panicVA Tcl_PanicVA /* *---------------------------------------------------------------------------- -- cgit v0.12 From c1f627b31e04957f50e52d12dcf543085e1f629d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 09:02:44 +0000 Subject: Fogot to remove the TclWinSetInterfaces() implementation. --- generic/tcl.decls | 4 ++-- generic/tclInt.decls | 48 ++++++++++++++++++++++++------------------------ win/tclWinInit.c | 6 ------ 3 files changed, 26 insertions(+), 32 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index de1c581..7428911 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -780,7 +780,7 @@ declare 218 { declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Removed in Tcl 9 +# Removed in 9.0: #declare 220 { # int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) #} @@ -868,7 +868,7 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Removed in Tcl 9 +# Removed in 9.0: #declare 246 { # int Tcl_TellOld(Tcl_Channel chan) #} diff --git a/generic/tclInt.decls b/generic/tclInt.decls index d6e41bb..ad48007 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -50,7 +50,7 @@ declare 6 { declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } -# Removed in Tcl 9 +# Removed in 9.0: #declare 8 { # int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, # Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) @@ -74,7 +74,7 @@ declare 11 { declare 12 { void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr) } -# Removed in 8.5 +# Removed in 8.5: #declare 13 { # int TclDoGlob(Tcl_Interp *interp, char *separators, # Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) @@ -89,7 +89,7 @@ declare 14 { declare 16 { void TclExprFloatError(Tcl_Interp *interp, double value) } -# Removed in 8.4 +# Removed in 8.4: #declare 17 { # int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) #} @@ -124,7 +124,7 @@ declare 25 { # declare 26 { # char *TclGetCwd(Tcl_Interp *interp) # } -# Removed in 8.5 +# Removed in 8.5: #declare 27 { # int TclGetDate(char *p, unsigned long now, long zone, # unsigned long *timePtr) @@ -148,7 +148,7 @@ declare 32 { int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } -# Removed in Tcl 8.5 +# Removed in 8.5: #declare 33 { # TclCmdProcType TclGetInterpProc(void) #} @@ -161,7 +161,7 @@ declare 34 { # Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, # int flags) #} -# Removed in 8.6a2 +# Removed in 8.6a2: #declare 36 { # int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr) #} @@ -186,7 +186,7 @@ declare 41 { declare 42 { CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } -# Removed in Tcl 8.5a2 +# Removed in 8.5a2: #declare 43 { # int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, # int flags) @@ -221,7 +221,7 @@ declare 50 { declare 51 { int TclInterpInit(Tcl_Interp *interp) } -# Removed in Tcl 8.5a2 +# Removed in 8.5a2: #declare 52 { # int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, # int flags) @@ -274,7 +274,7 @@ declare 64 { int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) } -# Removed in Tcl 8.5a2 +# Removed in 8.5a2: #declare 65 { # int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, # Tcl_Obj *const objv[], int flags) @@ -381,7 +381,7 @@ declare 92 { declare 93 { void TclProcDeleteProc(ClientData clientData) } -# Removed in Tcl 8.5: +# Removed in 8.5: #declare 94 { # int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, # int argc, const char **argv) @@ -420,7 +420,7 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -# Removed in Tcl 9 +# Removed in 9.0: #declare 104 { # int TclSockMinimumBuffersOld(int sock, int size) #} @@ -1066,16 +1066,16 @@ interface tclIntPlat declare 0 win { void TclWinConvertError(DWORD errCode) } -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 1 win { # void TclWinConvertWSAError(DWORD errCode) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 2 win { # struct servent *TclWinGetServByName(const char *nm, # const char *proto) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 3 win { # int TclWinGetSockOpt(SOCKET s, int level, int optname, # char *optval, int *optlen) @@ -1091,11 +1091,11 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -# Removed in Tcl 9.0: +# Removed in 9.0: #declare 6 win { # unsigned short TclWinNToHS(unsigned short ns) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 7 win { # int TclWinSetSockOpt(SOCKET s, int level, int optname, # const char *optval, int optlen) @@ -1106,11 +1106,11 @@ declare 8 win { declare 9 win { int TclWinGetPlatformId(void) } -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 10 win { # Tcl_DirEntry *TclpReaddir(DIR *dir) #} -# Removed in 8.3.1 (for Win32s only) +# Removed in 8.3.1 (for Win32s only): #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) #} @@ -1160,7 +1160,7 @@ declare 19 win { declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 21 win { # char *TclpInetNtoa(struct in_addr addr) #} @@ -1184,7 +1184,7 @@ declare 24 win { #declare 25 win { # TclPlatformType *TclWinGetPlatform(void) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 26 win { # void TclWinSetInterfaces(int wide) #} @@ -1246,19 +1246,19 @@ declare 9 unix { # Added in 8.4: -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 10 unix { # Tcl_DirEntry *TclpReaddir(DIR *dir) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 11 unix { # struct tm *TclpLocaltime_unix(const time_t *clock) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 12 unix { # struct tm *TclpGmtime_unix(const time_t *clock) #} -# Removed in Tcl 9.0 +# Removed in 9.0: #declare 13 unix { # char *TclpInetNtoa(struct in_addr addr) #} diff --git a/win/tclWinInit.c b/win/tclWinInit.c index c590865..eaf4f36 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -498,12 +498,6 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -void TclWinSetInterfaces( - int dummy) /* Not used. */ -{ - TclpSetInterfaces(); -} - const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) -- cgit v0.12 From 429acda3ee22bea891e82e69efc09872e7608915 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 10:34:10 +0000 Subject: Put Tcl_EvalFile back, but then as a macro in terms of Tcl_FSEvalFileEx(). --- generic/tclDecls.h | 3 +++ generic/tclIOUtil.c | 24 +++++++++++------------- generic/tclStubInit.c | 2 ++ 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index c521845..7718588 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3984,5 +3984,8 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) +#undef Tcl_EvalFile +#define Tcl_EvalFile(interp, fileName) \ + Tcl_FSEvalFileEx(interp, Tcl_NewStringObj(filename, -1), NULL); #endif /* _TCLDECLS */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 2c389c6..39a9474 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -412,21 +412,18 @@ Tcl_GetCwd( return Tcl_DStringValue(cwdPtr); } +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* Obsolete */ +#undef Tcl_EvalFile int Tcl_EvalFile( Tcl_Interp *interp, /* Interpreter in which to process file. */ const char *fileName) /* Name of file to process. Tilde-substitution * will be performed on this name. */ { - int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); - - Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSEvalFile(interp, pathPtr); - Tcl_DecrRefCount(pathPtr); - return ret; + return Tcl_FSEvalFileEx(interp, Tcl_NewStringObj(fileName, -1), NULL); } +#endif /* * Now move on to the basic filesystem implementation. @@ -1740,8 +1737,11 @@ Tcl_FSEvalFileEx( Tcl_Channel chan; Tcl_Obj *objPtr; + Tcl_IncrRefCount(pathPtr); + objPtr = Tcl_NewObj(); + Tcl_IncrRefCount(objPtr); if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { - return result; + goto end; } if (Tcl_FSStat(pathPtr, &statBuf) == -1) { @@ -1756,7 +1756,7 @@ Tcl_FSEvalFileEx( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); - return result; + goto end; } /* @@ -1775,13 +1775,10 @@ Tcl_FSEvalFileEx( if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { Tcl_Close(interp,chan); - return result; + goto end; } } - objPtr = Tcl_NewObj(); - Tcl_IncrRefCount(objPtr); - /* * Try to read first character of stream, so we can check for utf-8 BOM to * be handled especially. @@ -1857,6 +1854,7 @@ Tcl_FSEvalFileEx( end: Tcl_DecrRefCount(objPtr); + Tcl_DecrRefCount(pathPtr); return result; } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 03ef7d6..eacc8ca 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -371,6 +371,8 @@ static int formatInt(char *buffer, int n){ # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 +# undef Tcl_EvalFile +# define Tcl_EvalFile 0 # define TclBackgroundException 0 # undef TclpReaddir # define TclpReaddir 0 -- cgit v0.12 From 56e7df256a6fc22cd478e4be02a8dca93634e942 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 11:04:49 +0000 Subject: No longer mark Tcl_EvalFile() as obsolete/deprecated. Thanks to all feedback to TIP #485! --- generic/tcl.decls | 4 ++-- generic/tclDecls.h | 5 ++--- generic/tclEncoding.c | 2 ++ generic/tclStubInit.c | 3 +-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index f7ffd29..1083adc 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -469,8 +469,8 @@ declare 128 { declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } -# This is obsolete, use Tcl_FSEvalFile -declare 130 {deprecated {Use Tcl_FSEvalFile}} { +# Stub entry no longer needed. It is now a macro in terms of Tcl_FSEvalFileEx(). +declare 130 { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } declare 131 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 7718588..9241175 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -420,8 +420,7 @@ EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err); /* 129 */ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); /* 130 */ -TCL_DEPRECATED("Use Tcl_FSEvalFile") -int Tcl_EvalFile(Tcl_Interp *interp, +EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); /* 131 */ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -1996,7 +1995,7 @@ typedef struct TclStubs { CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */ CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */ int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ - TCL_DEPRECATED_API("Use Tcl_FSEvalFile") int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ + int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1f48a1c..b0c595c 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -693,6 +693,7 @@ TclFinalizeEncodingSubsystem(void) *------------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 const char * Tcl_GetDefaultEncodingDir(void) { @@ -736,6 +737,7 @@ Tcl_SetDefaultEncodingDir( Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); Tcl_SetEncodingSearchPath(searchPath); } +#endif /* *------------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index eacc8ca..d276dbc 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,8 +72,7 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclBNInitBignumFromWideUInt 0 # define TclBNInitBignumFromWideInt 0 # define TclBNInitBignumFromLong 0 -# define Tcl_BackSlash 0 -# define Tcl_EvalFile 0 +# define Tcl_Backslash 0 # define Tcl_GetDefaultEncodingDir 0 # define Tcl_SetDefaultEncodingDir 0 # define Tcl_EvalTokens 0 -- cgit v0.12 From a037934e2165dc52888a2daa656c9e5d5ddc980e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 11:49:10 +0000 Subject: Get rid of Tcl_DStringTrunc et al, as described in the TIP (Thanks, Don!). --- generic/tcl.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 80c8dcb..54c6b73 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -997,7 +997,7 @@ typedef struct Tcl_DString { #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # define Tcl_DStringTrunc Tcl_DStringSetLength #endif /* !TCL_NO_DEPRECATED */ @@ -2615,7 +2615,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * Deprecated Tcl functions: */ -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* * These function have been renamed. The old names are deprecated, but we * define these macros for backwards compatibilty. -- cgit v0.12 From 932afb01058a92816df27ea786c0a5c0cbd09290 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 11 Nov 2017 09:18:09 +0000 Subject: Improvements to tip430 to embed the /library file system within a shared library or as a zip archive with a canonical name matching the current patch level This new version also builds a native executable version of minizip to allow archive to be built within make, even when cross compiling Added a new function TclZipfs_AppHook which implements tip430 core behavior startups to stock tclsh Embedding the file system as a zip archive can be defeated with --enable-zipfs=no --- generic/tcl.decls | 4 +- generic/tclDecls.h | 5 ++ generic/tclInterp.c | 2 + generic/tclPkgConfig.c | 2 + generic/tclStubInit.c | 1 + generic/tclZipfs.c | 73 +++++++++++++++++++- unix/Makefile.in | 152 +++++++++++++++++++++++++++++++++++++++-- unix/configure | 178 ++++++++++++++++++++++++++++++++++++++++++++++++- unix/configure.ac | 61 +++++++++++++++++ unix/tcl.m4 | 107 +++++++++++++++++++++++++++++ unix/tclAppInit.c | 2 + unix/tclConfig.sh.in | 3 + 12 files changed, 582 insertions(+), 8 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index c19bf68..fcc6235 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2343,7 +2343,9 @@ declare 632 { declare 633 { int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) } - +declare 634 { + int TclZipfs_AppHook(int *argc, char ***argv) +} ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 24a22c3..c7cac7c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1838,6 +1838,8 @@ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, /* 633 */ EXTERN int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname); +/* 634 */ +EXTERN int TclZipfs_AppHook(int *argc, char ***argv); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2507,6 +2509,7 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */ + int (*tclZipfs_AppHook) (int *argc, char ***argv); /* 634 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3805,6 +3808,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclZipfs_Mount) /* 632 */ #define TclZipfs_Unmount \ (tclStubsPtr->tclZipfs_Unmount) /* 633 */ +#define TclZipfs_AppHook \ + (tclStubsPtr->tclZipfs_AppHook) /* 634 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index d9dfd37..2b0582a 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -402,6 +402,8 @@ Tcl_Init( " set scripts {{set tcl_library}}\n" " } else {\n" " set scripts {}\n" +" lappend scripts {set temp zipfs:/lib/tcl/tcl_library}\n" +" lappend scripts {set temp zipfs:/app/tcl_library}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" " lappend scripts {\n" diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c index 466d535..53b7dbb 100644 --- a/generic/tclPkgConfig.c +++ b/generic/tclPkgConfig.c @@ -105,6 +105,8 @@ static Tcl_Config const cfg[] = { {"scriptdir,runtime", CFG_RUNTIME_SCRDIR}, {"includedir,runtime", CFG_RUNTIME_INCDIR}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, + {"dllfile,runtime", CFG_RUNTIME_DLLFILE}, + {"zipfile,runtime", CFG_RUNTIME_ZIPFILE}, /* Installation paths to various stuff */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index f251a57..16d5837 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1538,6 +1538,7 @@ const TclStubs tclStubs = { Tcl_OpenTcpServerEx, /* 631 */ TclZipfs_Mount, /* 632 */ TclZipfs_Unmount, /* 633 */ + TclZipfs_AppHook, /* 634 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index fe4553e..9dfca7a 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -28,7 +28,10 @@ #include "zlib.h" #include "crypt.h" -#define ZIPFS_VOLUME "zipfs:/" +#define ZIPFS_VOLUME "zipfs:/" +#define ZIPFS_APP_MOUNT "zipfs:/app" +#define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" + #define ZIPFS_VOLUME_LEN 7 /* @@ -3807,7 +3810,7 @@ const Tcl_Filesystem zipfsFilesystem = { *------------------------------------------------------------------------- */ -int +MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp) { #ifdef HAVE_ZLIB @@ -3877,6 +3880,72 @@ TclZipfs_Init(Tcl_Interp *interp) return TCL_ERROR; #endif } + +static int TclZipfs_AppHook_FindTclInit(const char *archive){ + Tcl_Obj *vfsinitscript; + int found; + if(TclZipfs_Mount(NULL, archive, ZIPFS_ZIP_MOUNT, NULL)) { + /* Either the file doesn't exist or it is not a zip archive */ + return TCL_ERROR; + } + vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + if(found==0) { + return TCL_OK; + } + Tcl_DecrRefCount(vfsinitscript); + vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + if(found==0) { + return TCL_OK; + } + return TCL_ERROR; +} + +int TclZipfs_AppHook(int *argc, char ***argv){ + /* + * Tclkit_MainHook -- + * Performs the argument munging for the shell + */ + + CONST char *archive; + Tcl_FindExecutable(*argv[0]); + archive=Tcl_GetNameOfExecutable(); + TclZipfs_Init(NULL); + if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { + int found; + Tcl_Obj *vfsinitscript; + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } else { + Tcl_DecrRefCount(vfsinitscript); + } + /* Set Tcl Encodings */ + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); + if(found==TCL_OK) { + return TCL_OK; + } + } + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_ZIPFILE)==TCL_OK) { + return TCL_OK; + } + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + return TCL_OK; + } + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { + return TCL_OK; + } + return TCL_OK; +} #ifndef HAVE_ZLIB diff --git a/unix/Makefile.in b/unix/Makefile.in index 5f4e125..d7cc3c7 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -199,6 +199,10 @@ LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@ BUILD_DLTEST = @BUILD_DLTEST@ #BUILD_DLTEST = +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + TCL_LIB_FILE = @TCL_LIB_FILE@ #TCL_LIB_FILE = libtcl.a @@ -242,6 +246,14 @@ ZLIB_DIR = ${COMPAT_DIR}/zlib ZLIB_INCLUDE = @ZLIB_INCLUDE@ CC = @CC@ +OBJEXT = @OBJEXT@ +HOST_CC = @CC_FOR_BUILD@ +HOST_EXEEXT = @EXEEXT_FOR_BUILD@ +HOST_OBJEXT = @OBJEXT_FOR_BUILD@ +ZIPFS_BUILD = @ZIPFS_BUILD@ +NATIVE_ZIP = @ZIP_PROG@ +SHARED_BUILD = @SHARED_BUILD@ + #CC = purify -best-effort @CC@ -DPURIFY # Flags to be passed to installManPage to control how the manpages should be @@ -251,6 +263,10 @@ MAN_FLAGS = @MAN_FLAGS@ # If non-empty, install the timezone files that are included with Tcl, # otherwise use the ones that ship with the OS. INSTALL_TZDATA = @INSTALL_TZDATA@ +INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ +INSTALL_MSGS = @INSTALL_MSGS@ + + #-------------------------------------------------------------------------- # The information below is usually usable as is. The configure script won't @@ -617,6 +633,26 @@ ZLIB_SRCS = \ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ +# Minizip +MINIZIP_OBJS = \ + adler32.$(HOST_OBJEXT) \ + compress.$(HOST_OBJEXT) \ + crc32.$(HOST_OBJEXT) \ + deflate.$(HOST_OBJEXT) \ + infback.$(HOST_OBJEXT) \ + inffast.$(HOST_OBJEXT) \ + inflate.$(HOST_OBJEXT) \ + inftrees.$(HOST_OBJEXT) \ + ioapi.$(HOST_OBJEXT) \ + trees.$(HOST_OBJEXT) \ + uncompr.$(HOST_OBJEXT) \ + zip.$(HOST_OBJEXT) \ + zutil.$(HOST_OBJEXT) \ + minizip.$(HOST_OBJEXT) + +ZIP_INSTALL_OBJS = minizip${EXEEXT_FOR_BUILD} + + #-------------------------------------------------------------------------- # Start of rules #-------------------------------------------------------------------------- @@ -629,11 +665,23 @@ libraries: doc: +tclzipfile: ${TCL_ZIP_FILE} + + +${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} + rm -rf ${TCL_VFS_ROOT} + mkdir -p ${TCL_VFS_PATH} + cp -a ../library/* ${TCL_VFS_PATH} + cd ${TCL_VFS_ROOT} ; ../minizip${EXEEXT_FOR_BUILD} -o ../${TCL_ZIP_FILE} `find . -type f` + # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. -${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} +${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE} rm -f $@ @MAKE_LIB@ +ifeq (${ZIPFS_BUILD},1) + cat ${TCL_ZIP_FILE} >> ${LIB_FILE} +endif ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ @@ -667,7 +715,8 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: clean-packages rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ - errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ + errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ + minizip${EXEEXT_FOR_BUILD} *.${HOST_OBJEXT} cd dltest ; $(MAKE) clean distclean: distclean-packages clean @@ -777,7 +826,7 @@ trace-test: ${TCLTEST_EXE} # Installation rules #-------------------------------------------------------------------------- -INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA) +INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) INSTALL_DOC_TARGETS = install-doc INSTALL_PACKAGE_TARGETS = install-packages INSTALL_DEV_TARGETS = install-headers @@ -821,6 +870,25 @@ install-binaries: binaries @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig @$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc +install-libraries-zipfs-shared: libraries + @for i in "$(SCRIPT_INSTALL_DIR)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"; + @for i in \ + $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \ + do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ + done; + +install-libraries-zipfs-static: install-libraries-zipfs-shared + $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" ;\ + install-libraries: libraries @for i in "$(SCRIPT_INSTALL_DIR)"; \ do \ @@ -875,6 +943,7 @@ install-libraries: libraries echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \ "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \ fi + end install-tzdata: @for i in tzdata; \ @@ -1282,6 +1351,8 @@ tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ \ $(GENERIC_DIR)/tclPkgConfig.c @@ -1331,7 +1402,11 @@ tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c - $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ + -DCFG_RUNTIME_PATH="\"$(DLL_INSTALL_DIR)\"" \ + $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c @@ -1741,6 +1816,74 @@ tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c $(CC) -c $(CC_SWITCHES) $< #-------------------------------------------------------------------------- +# Minizip implementation +#-------------------------------------------------------------------------- +adler32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c + +compress.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c + +crc32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c + +deflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c + +ioapi.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + +infback.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c + +inffast.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c + +inflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c + +inftrees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c + +trees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c + +uncompr.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c + +zip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c + +zutil.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c + +minizip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + +minizip${EXEEXT_FOR_BUILD}: $(MINIZIP_OBJS) + $(HOST_CC) -o $@ $(MINIZIP_OBJS) + +tclvfs.zip: minizip${EXEEXT_FOR_BUILD} + rm -rf $(TCL_VFS_ROOT) + mkdir -p $(TCL_VFS_PATH) + @for i in "$(TCL_VFS_PATH)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + cp -a ../library/* $(TCL_VFS_PATH) + (cd $TCL_VFS ROOT ; ./minizip${EXEEXT_FOR_BUILD} -o ../tclvfs.zip `find . -type f`) + +zipsetupstub.$(HOST_OBJEXT): $(COMPAT_DIR)/zipsetupstub.c + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(COMPAT_DIR)/zipsetupstub.c + +zipsetupstub${EXEEXT_FOR_BUILD}: zipsetupstub.$(HOST_OBJEXT) + $(HOST_CC) -o $@ zipsetupstub.$(HOST_OBJEXT) + +#-------------------------------------------------------------------------- # Bundled Package targets #-------------------------------------------------------------------------- @@ -2148,6 +2291,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages +.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/unix/configure b/unix/configure index 129c283..8e2ec0f 100755 --- a/unix/configure +++ b/unix/configure @@ -658,12 +658,16 @@ TCL_STUB_LIB_FILE TCL_LIB_SPEC TCL_LIB_FLAG TCL_LIB_FILE +TCL_ZIP_FILE PKG_CFG_ARGS TCL_YEAR TCL_PATCH_LEVEL TCL_MINOR_VERSION TCL_MAJOR_VERSION TCL_VERSION +INSTALL_MSGS +INSTALL_LIBRARIES +ZIPFS_BUILD DTRACE LDFLAGS_DEFAULT CFLAGS_DEFAULT @@ -698,7 +702,11 @@ RANLIB ZLIB_INCLUDE ZLIB_SRCS ZLIB_OBJS +EXEEXT_FOR_BUILD +CC_FOR_BUILD +ZIP_PROG TCLSH_PROG +SHARED_BUILD TCL_THREADS EGREP GREP @@ -748,7 +756,8 @@ PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR -SHELL' +SHELL +OBJEXT_FOR_BUILD' ac_subst_files='' ac_user_opts=' enable_option_checking @@ -768,6 +777,7 @@ enable_langinfo enable_dll_unloading with_tzdata enable_dtrace +enable_zipfs enable_framework ' ac_precious_vars='build_alias @@ -1408,6 +1418,7 @@ Optional Features: startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) --enable-dtrace build with DTrace support (default: off) + --enable-zipfs build with Zipfs support (default: on) --enable-framework package shared libraries in MacOSX frameworks (default: off) @@ -2330,6 +2341,7 @@ VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} +TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip #------------------------------------------------------------------------ # Setup configure arguments for bundled packages @@ -3273,6 +3285,7 @@ _ACEOF esac + #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or @@ -4545,6 +4558,7 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi + #-------------------------------------------------------------------- # Look for a native installed tclsh binary (if available) # If one cannot be found then use the binary we build (fails for @@ -4590,6 +4604,120 @@ if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi +# +# Check for --enable-zipfs flag +# +SC_ENABLE_ZIPFS + +# +# Find a native zip implementation +# + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + else + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH" >&5 +$as_echo "No zip found on PATH" >&6; } + fi + + + +# +# Find a native compiler +# +# Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 +$as_echo_n "checking for gcc... " >&6; } + if ${ac_cv_path_cc+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + +fi + + fi +fi + +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 +$as_echo_n "checking for build system executable suffix... " >&6; } +if ${bfd_cv_build_exeext+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 +$as_echo "$bfd_cv_build_exeext" >&6; } + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi + + +if test "$ZIP_PROG" = ""; then + ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' +fi + + + + #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ @@ -10151,6 +10279,53 @@ fi $as_echo "$tcl_ok" >&6; } #-------------------------------------------------------------------- +# Zipfs support +#-------------------------------------------------------------------- + +# Check whether --enable-zipfs was given. +if test "${enable_zipfs+set}" = set; then : + enableval=$enable_zipfs; tcl_ok=$enableval +else + tcl_ok=yes +fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + ZIPFS_BUILD=1 + else + ZIPFS_BUILD=0 + fi + # Do checking message here to not mess up interleaved configure output + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 +$as_echo_n "checking for building with zipfs... " >&6; } + if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + +$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h + + INSTALL_LIBRARIES=install-libraries-zipfs-static + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + +$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h +\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + INSTALL_LIBRARIES=install-libraries + INSTALL_MSGS=install-msgs + fi + + + + + +#-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- @@ -10436,6 +10611,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD} + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF diff --git a/unix/configure.ac b/unix/configure.ac index e14d85e..b2700cf 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -30,6 +30,7 @@ VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} +TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip #------------------------------------------------------------------------ # Setup configure arguments for bundled packages @@ -86,6 +87,7 @@ fi AC_PROG_CC AC_C_INLINE + #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or @@ -153,6 +155,28 @@ if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi +# +# Check for --enable-zipfs flag +# +SC_ENABLE_ZIPFS + +# +# Find a native zip implementation +# +SC_PROG_ZIP + +# +# Find a native compiler +# +AX_CC_FOR_BUILD + +if test "$ZIP_PROG" = ""; then + ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' +fi + + + + #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ @@ -791,6 +815,42 @@ fi AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- +# Zipfs support +#-------------------------------------------------------------------- + +AC_ARG_ENABLE(zipfs, + AC_HELP_STRING([--enable-zipfs], + [build with Zipfs support (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + ZIPFS_BUILD=1 + else + ZIPFS_BUILD=0 + fi + # Do checking message here to not mess up interleaved configure output + AC_MSG_CHECKING([for building with zipfs]) + if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) + INSTALL_LIBRARIES=install-libraries-zipfs-static + AC_MSG_RESULT([yes]) + else + AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + AC_MSG_RESULT([yes]) + fi + else + AC_MSG_RESULT([no]) + INSTALL_LIBRARIES=install-libraries + INSTALL_MSGS=install-msgs + fi + AC_SUBST(ZIPFS_BUILD) + AC_SUBST(INSTALL_LIBRARIES) + AC_SUBST(INSTALL_MSGS) + + +#-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- @@ -960,6 +1020,7 @@ AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_YEAR) AC_SUBST(PKG_CFG_ARGS) +AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 45922e0..132e602 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -276,6 +276,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE +# TCL_ZIP_FILE #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ @@ -289,6 +290,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ fi # eval is required to do the TCL_DBGX substitution + eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\"" eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" @@ -336,6 +338,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) + AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) @@ -542,6 +545,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi + AC_SUBST(SHARED_BUILD) ]) #------------------------------------------------------------------------ @@ -3014,6 +3018,109 @@ if test "x$NEED_FAKE_RFC2553" = "x1"; then AC_CHECK_FUNC(strlcpy) fi ]) + +#------------------------------------------------------------------------ +# SC_PROG_ZIP +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +#------------------------------------------------------------------------ + +AC_DEFUN([SC_PROG_ZIP], [ + AC_MSG_CHECKING([for zip]) + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip" + AC_MSG_RESULT([$ZIP_PROG]) + else + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + AC_MSG_RESULT([No zip found on PATH]) + fi + AC_SUBST(ZIP_PROG) +]) + +#------------------------------------------------------------------------ +# SC_CC_FOR_BUILD +# For cross compiles, locate a C compiler that can generate native binaries. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# CC_FOR_BUILD +# EXEEXT_FOR_BUILD +#------------------------------------------------------------------------ + +dnl Get a default for CC_FOR_BUILD to put into Makefile. +AC_DEFUN([AX_CC_FOR_BUILD], +[# Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + AC_MSG_CHECKING([for gcc]) + AC_CACHE_VAL(ac_cv_path_cc, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + ]) + fi +fi +AC_SUBST(CC_FOR_BUILD) +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, + [rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi +AC_SUBST(EXEEXT_FOR_BUILD)])dnl +AC_SUBST(OBJEXT_FOR_BUILD)])dnl # Local Variables: # mode: autoconf # End: diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 9bbc88b..3587f35 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -79,6 +79,8 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#else + TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index fdc56b7..3da4afd 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -39,6 +39,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' +# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library): +TCL_ZIP_FILE='@TCL_ZIP_FILE@' + # Additional libraries to use when linking Tcl. TCL_LIBS='@TCL_LIBS@' -- cgit v0.12 From 7590c5df93387698c15ecc2d52c643032c605d54 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 13 Nov 2017 15:34:50 +0000 Subject: Add back Tcl_Backslash(). Will be removed again when TIP #485 is brought in. Also revert some other API changes (unsigned long -> size_t), for which TIP's are still to be written. --- doc/Eval.3 | 21 ++++++++++++++- generic/tcl.decls | 15 +++++------ generic/tclCmdMZ.c | 74 +++++++++++++++++++++++++-------------------------- generic/tclDecls.h | 27 +++++++++++-------- generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 4 +-- generic/tclStubInit.c | 2 +- generic/tclUtf.c | 10 +++---- generic/tclUtil.c | 63 ++++++++++++++++++++++++++++++++++++++----- 9 files changed, 145 insertions(+), 73 deletions(-) diff --git a/doc/Eval.3 b/doc/Eval.3 index 89f557e..3936f5d 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -10,7 +10,7 @@ .so man.macros .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include \fR @@ -19,6 +19,9 @@ int \fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR) .sp int +\fBTcl_EvalFile\fR(\fIinterp, fileName\fR) +.sp +int \fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR) .sp int @@ -78,6 +81,22 @@ integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP +\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates +its contents as a Tcl script. It returns the same information as +\fBTcl_EvalObjEx\fR. +If the file could not be read then a Tcl error is returned to describe +why the file could not be read. +The eofchar for files is +.QW \e32 +(^Z) for all platforms. If you require a +.QW ^Z +in code for string comparison, you can use +.QW \e032 +or +.QW \eu001a , +which will be safely substituted by the Tcl interpreter into +.QW ^Z . +.PP \fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a script. The \fIobjc\fR and \fIobjv\fR arguments contain the values of the words for the Tcl command, one word in each value in diff --git a/generic/tcl.decls b/generic/tcl.decls index c11bf38..54d1921 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -292,10 +292,9 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -# Removed in 9.0 -#declare 77 { -# char Tcl_Backslash(const char *src, int *readPtr) -#} +declare 77 { + char Tcl_Backslash(const char *src, int *readPtr) +} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) @@ -1283,7 +1282,7 @@ declare 352 { } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) + unsigned long numChars) } declare 354 { char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, @@ -1345,10 +1344,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) + int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -1519,7 +1518,7 @@ declare 418 { } declare 419 { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) + unsigned long numChars) } declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d3b77b0..ad1dd5f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -335,7 +335,7 @@ Tcl_RegexpObjCmd( */ if (!doinline) { - Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } return TCL_OK; } @@ -457,7 +457,7 @@ Tcl_RegexpObjCmd( if (doinline) { Tcl_SetObjResult(interp, resultPtr); } else { - Tcl_SetObjResult(interp, Tcl_NewLongObj(all ? all-1 : 1)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1)); } return TCL_OK; } @@ -598,7 +598,7 @@ Tcl_RegsubObjCmd( */ int slen, nocase; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); Tcl_UniChar *p, wsrclc; numMatches = 0; @@ -633,7 +633,7 @@ Tcl_RegsubObjCmd( if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, - (size_t)slen) == 0))) { + (unsigned long) slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); @@ -959,7 +959,7 @@ Tcl_RegsubObjCmd( * holding the number of matches. */ - Tcl_SetObjResult(interp, Tcl_NewLongObj(numMatches)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches)); } } else { /* @@ -1118,8 +1118,8 @@ TclNRSourceObjCmd( }; int index; - if (TCL_ERROR == Tcl_GetIndexFromObjStruct(interp, objv[1], options, - sizeof(char *), "option", TCL_EXACT, &index)) { + if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options, + "option", TCL_EXACT, &index)) { return TCL_ERROR; } encodingName = TclGetString(objv[2]); @@ -1525,8 +1525,8 @@ StringIsCmd( "class ?-strict? ?-failindex var? str"); return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], isClasses, - sizeof(char *), "class", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0, + &index) != TCL_OK) { return TCL_ERROR; } @@ -1534,8 +1534,8 @@ StringIsCmd( for (i = 2; i < objc-1; i++) { int idx2; - if (Tcl_GetIndexFromObjStruct(interp, objv[i], isOptions, - sizeof(char *), "option", 0, &idx2) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0, + &idx2) != TCL_OK) { return TCL_ERROR; } switch ((enum isOptions) idx2) { @@ -1846,11 +1846,11 @@ StringIsCmd( str_is_done: if ((result == 0) && (failVarObj != NULL) && - Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewLongObj(failat), + Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(result!=0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -1897,7 +1897,7 @@ StringMapCmd( int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); @@ -2038,7 +2038,7 @@ StringMapCmd( if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - (size_t) length2) == 0)) { + (unsigned long) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; @@ -2086,7 +2086,7 @@ StringMapCmd( (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ (end-ustring1 >= length2) && ((length2 == 1) || - !strCmpFn(ustring2, ustring1, (size_t) length2))) { + !strCmpFn(ustring2, ustring1, (unsigned) length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. @@ -2185,8 +2185,8 @@ StringMatchCmd( return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewLongObj( - TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)!=0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + TclStringMatchObj(objv[objc-1], objv[objc-2], nocase))); return TCL_OK; } @@ -2459,7 +2459,7 @@ StringStartCmd( cur += 1; } } - Tcl_SetObjResult(interp, Tcl_NewLongObj(cur)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); return TCL_OK; } @@ -2521,7 +2521,7 @@ StringEndCmd( } else { cur = numChars; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(cur)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); return TCL_OK; } @@ -2558,7 +2558,7 @@ StringEqualCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, size_t); + typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2603,7 +2603,7 @@ StringEqualCmd( * Always match at 0 chars of if it is the same obj. */ - Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); return TCL_OK; } @@ -2671,7 +2671,7 @@ StringEqualCmd( } } - Tcl_SetObjResult(interp, Tcl_NewLongObj(match==0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } @@ -2708,7 +2708,7 @@ StringCmpCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, size_t); + typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2753,7 +2753,7 @@ StringCmpCmd( * Always match at 0 chars of if it is the same obj. */ - Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } @@ -2792,11 +2792,11 @@ StringCmpCmd( string1 = (char *) TclGetStringFromObj(objv[0], &length1); string2 = (char *) TclGetStringFromObj(objv[1], &length2); if ((reqlength < 0) && !nocase) { - strCmpFn = TclpUtfNcmp2; + strCmpFn = (strCmpFn_t) TclpUtfNcmp2; } else { length1 = Tcl_NumUtfChars(string1, length1); length2 = Tcl_NumUtfChars(string2, length2); - strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp; + strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); } } @@ -2812,13 +2812,13 @@ StringCmpCmd( reqlength = length + 1; } - match = strCmpFn(string1, string2, (size_t) length); + match = strCmpFn(string1, string2, (unsigned) length); if ((match == 0) && (reqlength > length)) { match = length1 - length2; } Tcl_SetObjResult(interp, - Tcl_NewLongObj((match > 0) ? 1 : (match < 0) ? -1 : 0)); + Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0)); return TCL_OK; } @@ -2909,7 +2909,7 @@ StringBytesCmd( } (void) TclGetStringFromObj(objv[1], &length); - Tcl_SetObjResult(interp, Tcl_NewLongObj(length)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); return TCL_OK; } @@ -2943,7 +2943,7 @@ StringLenCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_GetCharLength(objv[1]))); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1]))); return TCL_OK; } @@ -3559,8 +3559,8 @@ TclNRSwitchObjCmd( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, - sizeof(char *), "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -3836,7 +3836,7 @@ TclNRSwitchObjCmd( rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1); } else { - rangeObjAry[0] = rangeObjAry[1] = Tcl_NewLongObj(-1); + rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1); } /* @@ -4156,7 +4156,7 @@ Tcl_TimeObjCmd( * Use int obj since we know time is not fractional. [Bug 1202178] */ - objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : (int) totalMicroSec); + objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } @@ -4236,8 +4236,8 @@ TclNRTryObjCmd( int type; Tcl_Obj *info[5]; - if (Tcl_GetIndexFromObjStruct(interp, objv[i], handlerNames, - sizeof(char *), "handler type", 0, &type) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type", + 0, &type) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 720a994..ab2823c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -238,7 +238,8 @@ TCLAPI void Tcl_AsyncMark(Tcl_AsyncHandler async); TCLAPI int Tcl_AsyncReady(void); /* 76 */ TCLAPI void Tcl_BackgroundError(Tcl_Interp *interp); -/* Slot 77 is reserved */ +/* 77 */ +TCLAPI char Tcl_Backslash(const char *src, int *readPtr); /* 78 */ TCLAPI int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, @@ -955,7 +956,8 @@ TCLAPI int Tcl_UniCharIsWordChar(int ch); TCLAPI int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); + const Tcl_UniChar *uct, + unsigned long numChars); /* 354 */ TCLAPI char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); @@ -1002,10 +1004,11 @@ TCLAPI int Tcl_Access(const char *path, int mode); /* 368 */ TCLAPI int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); +TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, + unsigned long n); /* 370 */ TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2, - size_t n); + unsigned long n); /* 371 */ TCLAPI int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); @@ -1134,7 +1137,8 @@ TCLAPI void Tcl_ClearChannelHandlers(Tcl_Channel channel); TCLAPI int Tcl_IsChannelExisting(const char *channelName); /* 419 */ TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); + const Tcl_UniChar *uct, + unsigned long numChars); /* 420 */ TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); @@ -1840,7 +1844,7 @@ typedef struct TclStubs { void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - void (*reserved77)(void); + char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ @@ -2124,7 +2128,7 @@ typedef struct TclStubs { int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ + int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ @@ -2140,8 +2144,8 @@ typedef struct TclStubs { int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ @@ -2190,7 +2194,7 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ + int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ void (*reserved421)(void); void (*reserved422)(void); @@ -2577,7 +2581,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ -/* Slot 77 is reserved */ +#define Tcl_Backslash \ + (tclStubsPtr->tcl_Backslash) /* 77 */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index b21822e..60cd635 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -702,7 +702,7 @@ declare 166 { #} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) + int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 381c22e..45b87b9 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -365,7 +365,7 @@ TCLAPI int TclListObjSetElement(Tcl_Interp *interp, /* Slot 168 is reserved */ /* 169 */ TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2, - size_t n); + unsigned long n); /* 170 */ TCLAPI int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, @@ -745,7 +745,7 @@ typedef struct TclIntStubs { int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ void (*reserved167)(void); void (*reserved168)(void); - int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ + int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 88118a3..1a704da 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -796,7 +796,7 @@ const TclStubs tclStubs = { Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ Tcl_BackgroundError, /* 76 */ - 0, /* 77 */ + Tcl_Backslash, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index b7813fc..25cc2d1 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -986,7 +986,7 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numBytes) /* Number of *bytes* to compare. */ + unsigned long numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1033,7 +1033,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1081,7 +1081,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { @@ -1285,7 +1285,7 @@ int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + unsigned long numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* @@ -1330,7 +1330,7 @@ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + unsigned long numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index cc5c0f0..e2bcd37 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -937,9 +937,9 @@ Tcl_SplitList( int Tcl_ScanElement( - const char *src, /* String to convert to list element. */ - int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + register const char *src, /* String to convert to list element. */ + register int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } @@ -1300,9 +1300,9 @@ TclScanElement( int Tcl_ConvertElement( - const char *src, /* Source information for list element. */ - char *dst, /* Place to put list-ified element. */ - int flags) /* Flags produced by Tcl_ScanElement. */ + register const char *src, /* Source information for list element. */ + register char *dst, /* Place to put list-ified element. */ + register int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1551,6 +1551,7 @@ Tcl_Merge( char localFlags[LOCAL_SIZE]; int i, bytesNeeded = 0; char *result, *dst, *flagPtr = NULL; + const int maxFlags = UINT_MAX / sizeof(int); /* * Handle empty list case first, so logic of the general case can be @@ -1569,6 +1570,20 @@ Tcl_Merge( if (argc <= LOCAL_SIZE) { flagPtr = localFlags; + } else if (argc > maxFlags) { + /* + * We cannot allocate a large enough flag array to format this list in + * one pass. We could imagine converting this routine to a multi-pass + * implementation, but for sizeof(int) == 4, the limit is a max of + * 2^30 list elements and since each element is at least one byte + * formatted, and requires one byte space between it and the next one, + * that a minimum space requirement of 2^31 bytes, which is already + * INT_MAX. If we tried to format a list of > maxFlags elements, we're + * just going to overflow the size limits on the formatted string + * anyway, so just issue that same panic early. + */ + + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { flagPtr = ckalloc(argc); } @@ -1607,6 +1622,40 @@ Tcl_Merge( /* *---------------------------------------------------------------------- * + * Tcl_Backslash -- + * + * Figure out how to handle a backslash sequence. + * + * Results: + * The return value is the character that should be substituted in place + * of the backslash sequence that starts at src. If readPtr isn't NULL + * then it is filled in with a count of the number of characters in the + * backslash sequence. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char +Tcl_Backslash( + const char *src, /* Points to the backslash character of a + * backslash sequence. */ + int *readPtr) /* Fill in with number of characters read from + * src, unless NULL. */ +{ + char buf[TCL_UTF_MAX]; + Tcl_UniChar ch = 0; + + Tcl_UtfBackslash(src, readPtr, buf); + TclUtfToUniChar(buf, &ch); + return (char) ch; +} + +/* + *---------------------------------------------------------------------- + * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null @@ -3226,7 +3275,7 @@ TclPrecTraceProc( if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr), + Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr), flags & TCL_GLOBAL_ONLY); return NULL; } -- cgit v0.12 From a35ad3e79420600ee4cd52813a7fbe390bd0f2fc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 14 Nov 2017 10:00:58 +0000 Subject: Remove extra.unused2 field from struct Interp. It really is unused ... --- generic/tclBasic.c | 3 +-- generic/tclCompile.c | 4 ++-- generic/tclInt.h | 10 +--------- 3 files changed, 4 insertions(+), 13 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b7a378c..93e0ef9 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -523,8 +523,7 @@ Tcl_CreateInterp(void) iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; - TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); - iPtr->extra.optimizer = TclOptimizeBytecode; + iPtr->optimizer = TclOptimizeBytecode; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index b5de230..b73753d 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -853,8 +853,8 @@ TclSetByteCodeFromAny( * instruction generator boundaries. */ - if (iPtr->extra.optimizer) { - (iPtr->extra.optimizer)(&compEnv); + if (iPtr->optimizer) { + (iPtr->optimizer)(&compEnv); } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 33a0236..7400e80 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1810,15 +1810,7 @@ typedef struct Interp { ClientData interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - union { - void (*optimizer)(void *envPtr); - Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The - * unused space in interp was repurposed for - * pluggable bytecode optimizers. The core - * contains one optimizer, which can be - * selectively overriden by extensions. */ - } extra; - + void (*optimizer)(void *envPtr); /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. -- cgit v0.12 From 1ed5a135edb9b30eae6aa9dcc091929aba2c3864 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 Nov 2017 18:35:22 +0000 Subject: TIP 484 proposes a re-implementation of Tcl's "int" Tcl_ObjType. Since the new implementation is not consistent with the former one, any callers of Tcl_GetObjType("int") who are expecting the return value to point them at something playing by the former rules are at risk of having their code broken. In this branch I remove the registation of Tcl's "int" type, so such callers will get NULL (which they should already be able to handle) instead of something misleading them into breakage. Examine this branch and decide if it should be incorporated into TIP 484. --- generic/tclObj.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 634f8db..318e41f 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -383,7 +383,6 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); - Tcl_RegisterObjType(&tclIntType); Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); -- cgit v0.12 From fd3fbe8801d5ad9b3e3653e77d83149f1e8d09d6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Nov 2017 13:50:32 +0000 Subject: Handle Tcl_UtfAtIndex/Tcl_UniCharAtIndex for extended index range. More field fixes. --- doc/Utf.3 | 6 +++--- generic/tcl.decls | 4 ++-- generic/tcl.h | 8 ++++---- generic/tclCompile.h | 12 ++++++------ generic/tclDecls.h | 8 ++++---- generic/tclHash.c | 46 +++++++++++++++++++++++----------------------- generic/tclInt.h | 6 +++--- generic/tclNamesp.c | 7 +++---- generic/tclStringRep.h | 10 +++++----- generic/tclUtf.c | 14 +++++++------- 10 files changed, 60 insertions(+), 61 deletions(-) diff --git a/doc/Utf.3 b/doc/Utf.3 index 4216955..2318648 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -104,7 +104,7 @@ equal to 0. A pointer to a previously initialized \fBTcl_DString\fR. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. -.AP int index in +.AP size_t index in The index of a character (not byte) in the UTF-8 string. .AP int *readPtr out If non-NULL, filled with the number of bytes in the backslash sequence, @@ -233,12 +233,12 @@ return value will be \fIstart\fR. Pascal Ord() function. It returns the Tcl_UniChar represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR -characters. Behavior is undefined if a negative \fIindex\fR is given. +characters. .PP \fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. This is equivalent to calling -\fBTcl_UtfNext\fR \fIindex\fR times. If a negative \fIindex\fR is given, +\fBTcl_UtfNext\fR \fIindex\fR times. If \fIindex\fR is -1, the return pointer points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl diff --git a/generic/tcl.decls b/generic/tcl.decls index 260bd7f..73a133b 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1148,7 +1148,7 @@ declare 319 { Tcl_QueuePosition position) } declare 320 { - Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index) + Tcl_UniChar Tcl_UniCharAtIndex(const char *src, size_t index) } declare 321 { Tcl_UniChar Tcl_UniCharToLower(int ch) @@ -1163,7 +1163,7 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index) + CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, size_t index) } declare 326 { int Tcl_UtfCharComplete(const char *src, size_t length) diff --git a/generic/tcl.h b/generic/tcl.h index 6929a71..87b25a4 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1228,13 +1228,13 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - size_t numBuckets1; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ size_t numEntries; /* Total number of entries present in * table. */ - size_t rebuildSize1; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - size_t mask1; /* Mask value used in hashing function. */ + size_t mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ @@ -1258,7 +1258,7 @@ struct Tcl_HashTable { typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - size_t nextIndex1; /* Index of next bucket to be enumerated after + size_t nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 56c3768..d6b9fa3 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -87,7 +87,7 @@ typedef enum { * to a catch PC offset. */ } ExceptionRangeType; -typedef struct ExceptionRange { +typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range @@ -162,7 +162,7 @@ typedef struct ExceptionAux { * source offset is not monotonic. */ -typedef struct CmdLocation { +typedef struct { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ @@ -180,7 +180,7 @@ typedef struct CmdLocation { * frame and associated information, like the path of a sourced file. */ -typedef struct ECL { +typedef struct { int srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the @@ -190,7 +190,7 @@ typedef struct ECL { * lines. */ } ECL; -typedef struct ExtCmdLoc { +typedef struct { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in @@ -417,7 +417,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this + size_t compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -429,7 +429,7 @@ typedef struct ByteCode { * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ - int refCount; /* Reference count: set 1 when created plus 1 + size_t refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3e403da..8fcd413 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -957,7 +957,7 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); +EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, size_t index); /* 321 */ EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch); /* 322 */ @@ -967,7 +967,7 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index); +EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, size_t index); /* 326 */ EXTERN int Tcl_UtfCharComplete(const char *src, size_t length); /* 327 */ @@ -2182,12 +2182,12 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ - Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ + Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */ Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */ Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ + CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */ int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ diff --git a/generic/tclHash.c b/generic/tclHash.c index 3055eed..3ea9f66 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -35,7 +35,7 @@ */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask1) + ((((i)*(size_t)1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. @@ -169,11 +169,11 @@ Tcl_InitCustomHashTable( tablePtr->buckets = tablePtr->staticBuckets; tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0; tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0; - tablePtr->numBuckets1 = TCL_SMALL_HASH_TABLE; + tablePtr->numBuckets = TCL_SMALL_HASH_TABLE; tablePtr->numEntries = 0; - tablePtr->rebuildSize1 = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER; + tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER; tablePtr->downShift = 28; - tablePtr->mask1 = 3; + tablePtr->mask = 3; tablePtr->keyType = keyType; tablePtr->findProc = FindHashEntry; tablePtr->createProc = CreateHashEntry; @@ -291,7 +291,7 @@ CreateHashEntry( if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hash); } else { - index = hash & tablePtr->mask1; + index = hash & tablePtr->mask; } } else { hash = (size_t) key; @@ -360,7 +360,7 @@ CreateHashEntry( * buckets. */ - if (tablePtr->numEntries >= tablePtr->rebuildSize1) { + if (tablePtr->numEntries >= tablePtr->rebuildSize) { RebuildTable(tablePtr); } return hPtr; @@ -411,7 +411,7 @@ Tcl_DeleteHashEntry( || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = entryPtr->hash & tablePtr->mask1; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -478,7 +478,7 @@ Tcl_DeleteHashTable( * Free up all the entries in the table. */ - for (i = 0; i < tablePtr->numBuckets1; i++) { + for (i = 0; i < tablePtr->numBuckets; i++) { hPtr = tablePtr->buckets[i]; while (hPtr != NULL) { nextPtr = hPtr->nextPtr; @@ -539,7 +539,7 @@ Tcl_FirstHashEntry( * through the table. */ { searchPtr->tablePtr = tablePtr; - searchPtr->nextIndex1 = 0; + searchPtr->nextIndex = 0; searchPtr->nextEntryPtr = NULL; return Tcl_NextHashEntry(searchPtr); } @@ -575,12 +575,12 @@ Tcl_NextHashEntry( Tcl_HashTable *tablePtr = searchPtr->tablePtr; while (searchPtr->nextEntryPtr == NULL) { - if (searchPtr->nextIndex1 >= tablePtr->numBuckets1) { + if (searchPtr->nextIndex >= tablePtr->numBuckets) { return NULL; } searchPtr->nextEntryPtr = - tablePtr->buckets[searchPtr->nextIndex1]; - searchPtr->nextIndex1++; + tablePtr->buckets[searchPtr->nextIndex]; + searchPtr->nextIndex++; } hPtr = searchPtr->nextEntryPtr; searchPtr->nextEntryPtr = hPtr->nextPtr; @@ -624,7 +624,7 @@ Tcl_HashStats( } overflow = 0; average = 0.0; - for (i = 0; i < tablePtr->numBuckets1; i++) { + for (i = 0; i < tablePtr->numBuckets; i++) { j = 0; for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) { j++; @@ -646,7 +646,7 @@ Tcl_HashStats( result = ckalloc((NUM_COUNTERS * 60) + 300); sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n", - (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets1); + (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { sprintf(p, "number of buckets with %d entries: %" TCL_LL_MODIFIER "d\n", @@ -984,7 +984,7 @@ static void RebuildTable( register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - size_t count, index, oldSize = tablePtr->numBuckets1; + size_t count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; @@ -992,7 +992,7 @@ RebuildTable( /* Avoid outgrowing capability of the memory allocators */ if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) { - tablePtr->rebuildSize1 = INT_MAX; + tablePtr->rebuildSize = INT_MAX; return; } @@ -1012,21 +1012,21 @@ RebuildTable( * constants for new array size. */ - tablePtr->numBuckets1 *= 4; + tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc( - tablePtr->numBuckets1 * sizeof(Tcl_HashEntry *)); + tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } else { tablePtr->buckets = - ckalloc(tablePtr->numBuckets1 * sizeof(Tcl_HashEntry *)); + ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } - for (count = tablePtr->numBuckets1, newChainPtr = tablePtr->buckets; + for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; } - tablePtr->rebuildSize1 *= 4; + tablePtr->rebuildSize *= 4; tablePtr->downShift -= 2; - tablePtr->mask1 = (tablePtr->mask1 << 2) + 3; + tablePtr->mask = (tablePtr->mask << 2) + 3; /* * Rehash all of the existing entries into the new bucket array. @@ -1039,7 +1039,7 @@ RebuildTable( || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = hPtr->hash & tablePtr->mask1; + index = hPtr->hash & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; diff --git a/generic/tclInt.h b/generic/tclInt.h index ae83ca5..55d8c14 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -266,11 +266,11 @@ typedef struct Namespace { * NULL, there are no children. */ #endif size_t nsId; /* Unique id for the namespace. */ - Tcl_Interp *interp; /* The interpreter containing this + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ - int activationCount; /* Number of "activations" or active call + size_t activationCount; /* Number of "activations" or active call * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ @@ -1516,7 +1516,7 @@ typedef struct LiteralTable { * table. */ size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - TCL_HASH_TYPE mask; /* Mask value used in hashing function. */ + size_t mask; /* Mask value used in hashing function. */ } LiteralTable; /* diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 054fd72..2ce89bc 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -415,9 +415,8 @@ Tcl_PopCallFrame( */ nsPtr = framePtr->nsPtr; - nsPtr->activationCount--; - if ((nsPtr->flags & NS_DYING) - && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { + if ((--nsPtr->activationCount <= (nsPtr == iPtr->globalNsPtr)) + && (nsPtr->flags & NS_DYING)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; @@ -1003,7 +1002,7 @@ Tcl_DeleteNamespace( * refCount reaches 0. */ - if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { + if (nsPtr->activationCount > (nsPtr == globalNsPtr)) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index b4125c1..0ee1a14 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -48,7 +48,7 @@ typedef struct { size_t numChars; /* The number of chars in the string. (size_t)-1 means - * this value has not been calculated. >= 0 + * this value has not been calculated. Any other * means that there is a valid Unicode rep, or * that the number of UTF bytes == the number * of chars. */ @@ -65,14 +65,14 @@ typedef struct { } String; #define STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) + ((UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) #define STRING_SIZE(numChars) \ (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar))) #define stringCheckLimits(numChars) \ do { \ - if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ - Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ - (int)STRING_MAXCHARS); \ + if ((size_t)(numChars) > STRING_MAXCHARS) { \ + Tcl_Panic("max length for a Tcl unicode value (%" TCL_LL_MODIFIER "d chars) exceeded", \ + (Tcl_WideInt)STRING_MAXCHARS); \ } \ } while (0) #define stringAttemptAlloc(numChars) \ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index b0912ee..5f87ffa 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -701,12 +701,11 @@ Tcl_UtfPrev( Tcl_UniChar Tcl_UniCharAtIndex( register const char *src, /* The UTF-8 string to dereference. */ - register int index) /* The position of the desired character. */ + register size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; - while (index >= 0) { - index--; + while (index--) { src += TclUtfToUniChar(src, &ch); } return ch; @@ -732,13 +731,14 @@ Tcl_UniCharAtIndex( const char * Tcl_UtfAtIndex( register const char *src, /* The UTF-8 string. */ - register int index) /* The position of the desired character. */ + register size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; - while (index > 0) { - index--; - src += TclUtfToUniChar(src, &ch); + if (index != (size_t)-1) { + while (index--) { + src += TclUtfToUniChar(src, &ch); + } } return src; } -- cgit v0.12 From 9672bba339c071de7231ea922f64efdc6ba182a8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Nov 2017 15:34:14 +0000 Subject: Change TclOO epoch fields from int to size_t. --- generic/tclOO.c | 7 ++++--- generic/tclOOCall.c | 6 +++--- generic/tclOOInt.h | 14 +++++++------- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index e48158c..216219d 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -334,7 +334,7 @@ InitFoundation( DeletedObjdefNamespace); fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr, DeletedHelpersNamespace); - fPtr->epoch = 0; + fPtr->epoch = 1; fPtr->tsdPtr = tsdPtr; TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown"); TclNewLiteralStringObj(fPtr->constructorName, ""); @@ -562,7 +562,8 @@ AllocObject( Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - int creationEpoch, ignored; + size_t creationEpoch; + int ignored; oPtr = ckalloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); @@ -592,7 +593,7 @@ AllocObject( while (1) { char objName[10 + TCL_INTEGER_SPACE]; - sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); + sprintf(objName, "::oo::Obj%" TCL_LL_MODIFIER "d", (Tcl_WideInt)++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, ObjectNamespaceDeleted); if (oPtr->namespacePtr != NULL) { diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index d4e1e34..2a63e6c 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -1055,7 +1055,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (callPtr->numChain == 0) { TclOODeleteChain(callPtr); return NULL; @@ -1125,7 +1125,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; @@ -1292,7 +1292,7 @@ TclOOGetStereotypeCallChain( AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 11ba698..9e73fdf 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -170,9 +170,9 @@ typedef struct Object { * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - int creationEpoch; /* Unique value to make comparisons of objects + size_t creationEpoch; /* Unique value to make comparisons of objects * easier. */ - int epoch; /* Per-object epoch, incremented when the way + size_t epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to @@ -282,7 +282,7 @@ typedef struct Class { */ typedef struct ThreadLocalData { - int nsCount; /* Master epoch counter is used for keeping + size_t nsCount; /* Master epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter @@ -306,7 +306,7 @@ typedef struct Foundation { Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ - int epoch; /* Used to invalidate method chains when the + size_t epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ @@ -340,12 +340,12 @@ struct MInvoke { }; typedef struct CallChain { - int objectCreationEpoch; /* The object's creation epoch. Note that the + size_t objectCreationEpoch; /* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - int objectEpoch; /* Local (object structure) epoch counter + size_t objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - int epoch; /* Global (class structure) epoch counter + size_t epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ int refCount; /* Reference count. */ -- cgit v0.12 From be47788793ebb60ab44b11d994b5f053e8f6050a Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 17 Nov 2017 03:09:26 +0000 Subject: Moved Zipfs initialization and path hinting out of tclInterp.c and into a preinit script populated by TclZipfs_AppHook --- generic/tclInterp.c | 2 -- generic/tclZipfs.c | 22 +++++++++++++++++++++- 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 2b0582a..d9dfd37 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -402,8 +402,6 @@ Tcl_Init( " set scripts {{set tcl_library}}\n" " } else {\n" " set scripts {}\n" -" lappend scripts {set temp zipfs:/lib/tcl/tcl_library}\n" -" lappend scripts {set temp zipfs:/app/tcl_library}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" " lappend scripts {\n" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 9dfca7a..bc7d65a 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3816,6 +3816,7 @@ TclZipfs_Init(Tcl_Interp *interp) #ifdef HAVE_ZLIB /* one-time initialization */ WriteLock(); + Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); if (!ZipFS.initialized) { #ifdef TCL_THREADS static const Tcl_Time t = { 0, 0 }; @@ -3870,7 +3871,7 @@ TclZipfs_Init(Tcl_Interp *interp) Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, TCL_LINK_INT); TclMakeEnsemble(interp, "zipfs", initMap); - Tcl_PkgProvide(interp, "zipfs", "1.0"); + Tcl_PkgProvide(interp, "zipfs", "2.0"); } return TCL_OK; #else @@ -3914,6 +3915,25 @@ int TclZipfs_AppHook(int *argc, char ***argv){ Tcl_FindExecutable(*argv[0]); archive=Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); + TclSetPreInitScript( +"foreach {path} {\n" +" {" ZIPFS_APP_MOUNT "/tcl_library}\n" +" {" ZIPFS_ZIP_MOUNT "/tcl_library}\n" +"} {\n" +" if {![file exists [file join $path init.tcl]]} continue\n" +" set ::tcl_library $path\n" +" break\n" +"}\n" +"foreach {path} {\n" +" {" ZIPFS_APP_MOUNT "/tk_library}\n" +" {" ZIPFS_ZIP_MOUNT "/tk_library}\n" +" {" ZIPFS_VOLUME "lib/tk/tk_library}\n" +"} {\n" +" if {[file exists [file join $path init.tcl]]} continue\n" +" set ::tk_library $path\n" +" break\n" +"}\n" + ); if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { int found; Tcl_Obj *vfsinitscript; -- cgit v0.12 From e84763748b39ba9655d93c056c0bfe614b7cb791 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 17 Nov 2017 04:13:48 +0000 Subject: First pass on the Msys style windows build. Moving Zipfs features closer together in the autoconf --- unix/Makefile.in | 32 ++++---- unix/configure | 231 ++++++++++++++++++++++++++-------------------------- unix/configure.ac | 41 +++++----- win/Makefile.in | 149 ++++++++++++++++++++++++++++++++- win/configure | 176 ++++++++++++++++++++++++++++++++++++++- win/configure.ac | 59 ++++++++++++++ win/tcl.m4 | 108 ++++++++++++++++++++++++ win/tclAppInit.c | 2 + win/tclConfig.sh.in | 3 + 9 files changed, 644 insertions(+), 157 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index d7cc3c7..4540710 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -199,10 +199,6 @@ LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@ BUILD_DLTEST = @BUILD_DLTEST@ #BUILD_DLTEST = -TCL_ZIP_FILE = @TCL_ZIP_FILE@ -TCL_VFS_PATH = libtcl.vfs/tcl_library -TCL_VFS_ROOT = libtcl.vfs - TCL_LIB_FILE = @TCL_LIB_FILE@ #TCL_LIB_FILE = libtcl.a @@ -247,12 +243,6 @@ ZLIB_INCLUDE = @ZLIB_INCLUDE@ CC = @CC@ OBJEXT = @OBJEXT@ -HOST_CC = @CC_FOR_BUILD@ -HOST_EXEEXT = @EXEEXT_FOR_BUILD@ -HOST_OBJEXT = @OBJEXT_FOR_BUILD@ -ZIPFS_BUILD = @ZIPFS_BUILD@ -NATIVE_ZIP = @ZIP_PROG@ -SHARED_BUILD = @SHARED_BUILD@ #CC = purify -best-effort @CC@ -DPURIFY @@ -263,10 +253,6 @@ MAN_FLAGS = @MAN_FLAGS@ # If non-empty, install the timezone files that are included with Tcl, # otherwise use the ones that ship with the OS. INSTALL_TZDATA = @INSTALL_TZDATA@ -INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ -INSTALL_MSGS = @INSTALL_MSGS@ - - #-------------------------------------------------------------------------- # The information below is usually usable as is. The configure script won't @@ -633,6 +619,23 @@ ZLIB_SRCS = \ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ +### +# Tip 430 - ZipFS Modifications +### + +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + +HOST_CC = @CC_FOR_BUILD@ +HOST_EXEEXT = @EXEEXT_FOR_BUILD@ +HOST_OBJEXT = @OBJEXT_FOR_BUILD@ +ZIPFS_BUILD = @ZIPFS_BUILD@ +NATIVE_ZIP = @ZIP_PROG@ +SHARED_BUILD = @SHARED_BUILD@ +INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ +INSTALL_MSGS = @INSTALL_MSGS@ + # Minizip MINIZIP_OBJS = \ adler32.$(HOST_OBJEXT) \ @@ -652,7 +655,6 @@ MINIZIP_OBJS = \ ZIP_INSTALL_OBJS = minizip${EXEEXT_FOR_BUILD} - #-------------------------------------------------------------------------- # Start of rules #-------------------------------------------------------------------------- diff --git a/unix/configure b/unix/configure index cff57cb..44bd2a6 100755 --- a/unix/configure +++ b/unix/configure @@ -668,6 +668,9 @@ TCL_VERSION INSTALL_MSGS INSTALL_LIBRARIES ZIPFS_BUILD +EXEEXT_FOR_BUILD +CC_FOR_BUILD +ZIP_PROG DTRACE LDFLAGS_DEFAULT CFLAGS_DEFAULT @@ -702,9 +705,6 @@ RANLIB ZLIB_INCLUDE ZLIB_SRCS ZLIB_OBJS -EXEEXT_FOR_BUILD -CC_FOR_BUILD -ZIP_PROG TCLSH_PROG SHARED_BUILD TCL_THREADS @@ -4594,120 +4594,6 @@ if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi -# -# Check for --enable-zipfs flag -# -SC_ENABLE_ZIPFS - -# -# Find a native zip implementation -# - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 -$as_echo_n "checking for zip... " >&6; } - if ${ac_cv_path_zip+:} false; then : - $as_echo_n "(cached) " >&6 -else - - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - -fi - - - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 -$as_echo "$ZIP_PROG" >&6; } - else - # It is not an error if an installed version of Zip can't be located. - ZIP_PROG="" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH" >&5 -$as_echo "No zip found on PATH" >&6; } - fi - - - -# -# Find a native compiler -# -# Put a plausible default for CC_FOR_BUILD in Makefile. -if test -z "$CC_FOR_BUILD"; then - if test "x$cross_compiling" = "xno"; then - CC_FOR_BUILD='$(CC)' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 -$as_echo_n "checking for gcc... " >&6; } - if ${ac_cv_path_cc+:} false; then : - $as_echo_n "(cached) " >&6 -else - - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/gcc 2> /dev/null` \ - `ls -r $dir/gcc 2> /dev/null` ; do - if test x"$ac_cv_path_cc" = x ; then - if test -f "$j" ; then - ac_cv_path_cc=$j - break - fi - fi - done - done - -fi - - fi -fi - -# Also set EXEEXT_FOR_BUILD. -if test "x$cross_compiling" = "xno"; then - EXEEXT_FOR_BUILD='$(EXEEXT)' - OBJEXT_FOR_BUILD='$(OBJEXT)' -else - OBJEXT_FOR_BUILD='.no' - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 -$as_echo_n "checking for build system executable suffix... " >&6; } -if ${bfd_cv_build_exeext+:} false; then : - $as_echo_n "(cached) " >&6 -else - rm -f conftest* - echo 'int main () { return 0; }' > conftest.c - bfd_cv_build_exeext= - ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 - for file in conftest.*; do - case $file in - *.c | *.o | *.obj | *.ilk | *.pdb) ;; - *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 -$as_echo "$bfd_cv_build_exeext" >&6; } - EXEEXT_FOR_BUILD="" - test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} -fi - - -if test "$ZIP_PROG" = ""; then - ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' -fi - - - - #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ @@ -10272,6 +10158,117 @@ $as_echo "$tcl_ok" >&6; } # Zipfs support #-------------------------------------------------------------------- +# +# Check for --enable-zipfs flag +# +SC_ENABLE_ZIPFS + +# +# Find a native zip implementation +# + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + else + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH" >&5 +$as_echo "No zip found on PATH" >&6; } + fi + + + +# +# Find a native compiler +# +# Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 +$as_echo_n "checking for gcc... " >&6; } + if ${ac_cv_path_cc+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + +fi + + fi +fi + +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 +$as_echo_n "checking for build system executable suffix... " >&6; } +if ${bfd_cv_build_exeext+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 +$as_echo "$bfd_cv_build_exeext" >&6; } + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi + + +if test "$ZIP_PROG" = ""; then + ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' +fi + # Check whether --enable-zipfs was given. if test "${enable_zipfs+set}" = set; then : enableval=$enable_zipfs; tcl_ok=$enableval diff --git a/unix/configure.ac b/unix/configure.ac index b2700cf..35429b5 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -155,28 +155,6 @@ if test "$TCLSH_PROG" = ""; then TCLSH_PROG='./${TCL_EXE}' fi -# -# Check for --enable-zipfs flag -# -SC_ENABLE_ZIPFS - -# -# Find a native zip implementation -# -SC_PROG_ZIP - -# -# Find a native compiler -# -AX_CC_FOR_BUILD - -if test "$ZIP_PROG" = ""; then - ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' -fi - - - - #------------------------------------------------------------------------ # Add stuff for zlib #------------------------------------------------------------------------ @@ -818,6 +796,25 @@ AC_MSG_RESULT([$tcl_ok]) # Zipfs support #-------------------------------------------------------------------- +# +# Check for --enable-zipfs flag +# +SC_ENABLE_ZIPFS + +# +# Find a native zip implementation +# +SC_PROG_ZIP + +# +# Find a native compiler +# +AX_CC_FOR_BUILD + +if test "$ZIP_PROG" = ""; then + ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' +fi + AC_ARG_ENABLE(zipfs, AC_HELP_STRING([--enable-zipfs], [build with Zipfs support (default: on)]), diff --git a/win/Makefile.in b/win/Makefile.in index 1a88cc8..14868cf 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -137,6 +137,11 @@ DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@ REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@ REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@ +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + + TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ @@ -196,6 +201,42 @@ SHELL = @SHELL@ RM = rm -f COPY = cp +### +# Tip 430 - ZipFS Modifications +### + +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + +HOST_CC = @CC_FOR_BUILD@ +HOST_EXEEXT = @EXEEXT_FOR_BUILD@ +HOST_OBJEXT = @OBJEXT_FOR_BUILD@ +ZIPFS_BUILD = @ZIPFS_BUILD@ +NATIVE_ZIP = @ZIP_PROG@ +SHARED_BUILD = @SHARED_BUILD@ +INSTALL_MSGS = @INSTALL_MSGS@ +INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ + +# Minizip +MINIZIP_OBJS = \ + adler32.$(HOST_OBJEXT) \ + compress.$(HOST_OBJEXT) \ + crc32.$(HOST_OBJEXT) \ + deflate.$(HOST_OBJEXT) \ + infback.$(HOST_OBJEXT) \ + inffast.$(HOST_OBJEXT) \ + inflate.$(HOST_OBJEXT) \ + inftrees.$(HOST_OBJEXT) \ + ioapi.$(HOST_OBJEXT) \ + trees.$(HOST_OBJEXT) \ + uncompr.$(HOST_OBJEXT) \ + zip.$(HOST_OBJEXT) \ + zutil.$(HOST_OBJEXT) \ + minizip.$(HOST_OBJEXT) + +ZIP_INSTALL_OBJS = minizip${EXEEXT_FOR_BUILD} + CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ -I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \ -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ @@ -434,9 +475,17 @@ libraries: doc: +tclzipfile: ${TCL_ZIP_FILE} + +${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} + rm -rf ${TCL_VFS_ROOT} + mkdir -p ${TCL_VFS_PATH} + cp -a ../library/* ${TCL_VFS_PATH} + cd ${TCL_VFS_ROOT} ; ../minizip${EXEEXT_FOR_BUILD} -o ../${TCL_ZIP_FILE} `find . -type f` + $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c @@ -453,10 +502,13 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ -${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE} @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ +ifeq (${ZIPFS_BUILD},1) + cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE} +endif ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} @@ -528,6 +580,8 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \ -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \ -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) @@ -551,6 +605,76 @@ tclOOStubLib.${OBJEXT}: tclOOStubLib.c .rc.$(RES): $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ + + +#-------------------------------------------------------------------------- +# Minizip implementation +#-------------------------------------------------------------------------- +adler32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c + +compress.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c + +crc32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c + +deflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c + +ioapi.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + +infback.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c + +inffast.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c + +inflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c + +inftrees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c + +trees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c + +uncompr.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c + +zip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c + +zutil.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c + +minizip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + +minizip${EXEEXT_FOR_BUILD}: $(MINIZIP_OBJS) + $(HOST_CC) -o $@ $(MINIZIP_OBJS) + +tclvfs.zip: minizip${EXEEXT_FOR_BUILD} + rm -rf $(TCL_VFS_ROOT) + mkdir -p $(TCL_VFS_PATH) + @for i in "$(TCL_VFS_PATH)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + cp -a ../library/* $(TCL_VFS_PATH) + (cd $TCL_VFS ROOT ; ./minizip${EXEEXT_FOR_BUILD} -o ../tclvfs.zip `find . -type f`) + +zipsetupstub.$(HOST_OBJEXT): $(COMPAT_DIR)/zipsetupstub.c + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(COMPAT_DIR)/zipsetupstub.c + +zipsetupstub${EXEEXT_FOR_BUILD}: zipsetupstub.$(HOST_OBJEXT) + $(HOST_CC) -o $@ zipsetupstub.$(HOST_OBJEXT) + # The following target generates the file generic/tclDate.c from the yacc # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is # not available in all environments. The name of the .c file is different than @@ -626,6 +750,25 @@ install-binaries: binaries $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi +install-libraries-zipfs-shared: libraries + @for i in "$(SCRIPT_INSTALL_DIR)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"; + @for i in \ + $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \ + do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ + done; + +install-libraries-zipfs-static: install-libraries-zipfs-shared + $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" ;\ + install-libraries: libraries install-tzdata install-msgs @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ $(SCRIPT_INSTALL_DIR); \ @@ -758,6 +901,7 @@ clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb + minizip${EXEEXT_FOR_BUILD} *.${HOST_OBJEXT} distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ @@ -890,5 +1034,6 @@ html-tk: $(TCLSH) .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk +.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/win/configure b/win/configure index fdd3adb..ddba42a 100755 --- a/win/configure +++ b/win/configure @@ -687,6 +687,7 @@ TCL_STATIC_LIB_FLAG TCL_STATIC_LIB_FILE TCL_LIB_FLAG TCL_LIB_FILE +TCL_ZIP_FILE TCL_EXE PKG_CFG_ARGS TCL_PATCH_LEVEL @@ -699,6 +700,12 @@ VC_MANIFEST_EMBED_EXE VC_MANIFEST_EMBED_DLL LDFLAGS_DEFAULT CFLAGS_DEFAULT +INSTALL_MSGS +INSTALL_LIBRARIES +ZIPFS_BUILD +EXEEXT_FOR_BUILD +CC_FOR_BUILD +ZIP_PROG ZLIB_OBJS ZLIB_LIBS ZLIB_DLL_FILE @@ -708,6 +715,7 @@ CFLAGS_DEBUG DL_LIBS CELIB_DIR CYGPATH +SHARED_BUILD TCL_THREADS SET_MAKE RC @@ -760,7 +768,8 @@ PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR -SHELL' +SHELL +OBJEXT_FOR_BUILD' ac_subst_files='' ac_user_opts=' enable_option_checking @@ -770,6 +779,7 @@ enable_shared enable_64bit enable_wince with_celib +enable_zipfs enable_symbols enable_embedded_manifest ' @@ -1393,6 +1403,7 @@ Optional Features: --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) + --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) @@ -2117,6 +2128,8 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ +TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip + #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ @@ -3772,6 +3785,7 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called @@ -4828,6 +4842,165 @@ _ACEOF fi + +#-------------------------------------------------------------------- +# Zipfs support +#-------------------------------------------------------------------- + +# +# Check for --enable-zipfs flag +# +SC_ENABLE_ZIPFS + +# +# Find a native zip implementation +# + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + else + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH" >&5 +$as_echo "No zip found on PATH" >&6; } + fi + + + +# +# Find a native compiler +# +# Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 +$as_echo_n "checking for gcc... " >&6; } + if ${ac_cv_path_cc+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + +fi + + fi +fi + +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 +$as_echo_n "checking for build system executable suffix... " >&6; } +if ${bfd_cv_build_exeext+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 +$as_echo "$bfd_cv_build_exeext" >&6; } + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi + + +if test "$ZIP_PROG" = ""; then + ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' +fi + +# Check whether --enable-zipfs was given. +if test "${enable_zipfs+set}" = set; then : + enableval=$enable_zipfs; tcl_ok=$enableval +else + tcl_ok=yes +fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + ZIPFS_BUILD=1 + else + ZIPFS_BUILD=0 + fi + # Do checking message here to not mess up interleaved configure output + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 +$as_echo_n "checking for building with zipfs... " >&6; } + if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + +$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h + + INSTALL_LIBRARIES=install-libraries-zipfs-static + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + +$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h +\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + INSTALL_LIBRARIES=install-libraries + INSTALL_MSGS=install-msgs + fi + + + + + #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- @@ -5220,6 +5393,7 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d + # empty on win diff --git a/win/configure.ac b/win/configure.ac index d03695c..0bb0d7d 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -29,6 +29,8 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ +TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip + #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ @@ -174,6 +176,62 @@ AC_CHECK_TYPE([uintptr_t], [ fi ]) + +#-------------------------------------------------------------------- +# Zipfs support +#-------------------------------------------------------------------- + +# +# Check for --enable-zipfs flag +# +SC_ENABLE_ZIPFS + +# +# Find a native zip implementation +# +SC_PROG_ZIP + +# +# Find a native compiler +# +AX_CC_FOR_BUILD + +if test "$ZIP_PROG" = ""; then + ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' +fi + +AC_ARG_ENABLE(zipfs, + AC_HELP_STRING([--enable-zipfs], + [build with Zipfs support (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + ZIPFS_BUILD=1 + else + ZIPFS_BUILD=0 + fi + # Do checking message here to not mess up interleaved configure output + AC_MSG_CHECKING([for building with zipfs]) + if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) + INSTALL_LIBRARIES=install-libraries-zipfs-static + AC_MSG_RESULT([yes]) + else + AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + AC_MSG_RESULT([yes]) + fi + else + AC_MSG_RESULT([no]) + INSTALL_LIBRARIES=install-libraries + INSTALL_MSGS=install-msgs + fi + AC_SUBST(ZIPFS_BUILD) + AC_SUBST(INSTALL_LIBRARIES) + AC_SUBST(INSTALL_MSGS) + + #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- @@ -370,6 +428,7 @@ AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(PKG_CFG_ARGS) AC_SUBST(TCL_EXE) +AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_STATIC_LIB_FILE) diff --git a/win/tcl.m4 b/win/tcl.m4 index b4fbcce..07be5a4 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -251,6 +251,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE +# TCL_ZIP_FILE # #------------------------------------------------------------------------ @@ -283,6 +284,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # eval is required to do the TCL_DBGX substitution # + eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\"" eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" @@ -295,6 +297,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) + AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) @@ -380,6 +383,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi + AC_SUBST(SHARED_BUILD) ]) #------------------------------------------------------------------------ @@ -1297,3 +1301,107 @@ print("manifest needed") AC_SUBST(VC_MANIFEST_EMBED_DLL) AC_SUBST(VC_MANIFEST_EMBED_EXE) ]) + + +#------------------------------------------------------------------------ +# SC_PROG_ZIP +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +#------------------------------------------------------------------------ + +AC_DEFUN([SC_PROG_ZIP], [ + AC_MSG_CHECKING([for zip]) + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip" + AC_MSG_RESULT([$ZIP_PROG]) + else + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + AC_MSG_RESULT([No zip found on PATH]) + fi + AC_SUBST(ZIP_PROG) +]) + +#------------------------------------------------------------------------ +# SC_CC_FOR_BUILD +# For cross compiles, locate a C compiler that can generate native binaries. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# CC_FOR_BUILD +# EXEEXT_FOR_BUILD +#------------------------------------------------------------------------ + +dnl Get a default for CC_FOR_BUILD to put into Makefile. +AC_DEFUN([AX_CC_FOR_BUILD], +[# Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + AC_MSG_CHECKING([for gcc]) + AC_CACHE_VAL(ac_cv_path_cc, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + ]) + fi +fi +AC_SUBST(CC_FOR_BUILD) +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, + [rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi +AC_SUBST(EXEEXT_FOR_BUILD)])dnl +AC_SUBST(OBJEXT_FOR_BUILD)])dnl diff --git a/win/tclAppInit.c b/win/tclAppInit.c index ef9f98b..bbe727f 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -124,6 +124,8 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#else + TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 97670aa..25fc3de 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -41,6 +41,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' +# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library): +TCL_ZIP_FILE='@TCL_ZIP_FILE@' + # Flag to indicate whether shared libraries need export files. TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@ -- cgit v0.12 From ded3368d3c2650fc1d5a7c888218f8ca7a4fd459 Mon Sep 17 00:00:00 2001 From: tne Date: Fri, 17 Nov 2017 04:45:07 +0000 Subject: Final tweaks to get Msys Zipfs build working --- unix/configure.ac | 5 ----- win/Makefile.in | 10 +++++++++- win/configure.ac | 5 ----- 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/unix/configure.ac b/unix/configure.ac index 35429b5..ed85184 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -797,11 +797,6 @@ AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- # -# Check for --enable-zipfs flag -# -SC_ENABLE_ZIPFS - -# # Find a native zip implementation # SC_PROG_ZIP diff --git a/win/Makefile.in b/win/Makefile.in index 14868cf..214cf7b 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -229,6 +229,7 @@ MINIZIP_OBJS = \ inflate.$(HOST_OBJEXT) \ inftrees.$(HOST_OBJEXT) \ ioapi.$(HOST_OBJEXT) \ + iowin32.$(HOST_OBJEXT) \ trees.$(HOST_OBJEXT) \ uncompr.$(HOST_OBJEXT) \ zip.$(HOST_OBJEXT) \ @@ -556,7 +557,11 @@ tclMain2.${OBJEXT}: tclMain.c # TIP #430, ZipFS Support tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c - $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ + -DCFG_RUNTIME_PATH="\"$(DLL_INSTALL_DIR)\"" \ + $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. @@ -625,6 +630,9 @@ deflate.$(HOST_OBJEXT): ioapi.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c +iowin32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c + infback.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c diff --git a/win/configure.ac b/win/configure.ac index 0bb0d7d..cf66fc2 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -182,11 +182,6 @@ AC_CHECK_TYPE([uintptr_t], [ #-------------------------------------------------------------------- # -# Check for --enable-zipfs flag -# -SC_ENABLE_ZIPFS - -# # Find a native zip implementation # SC_PROG_ZIP -- cgit v0.12 From 3c532f6336d06908079d7247329984747d31e152 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 17 Nov 2017 04:47:16 +0000 Subject: Rebuilt the configure files without the call to the missing SC_ENABLE_ZIPFS macro --- unix/configure | 5 ----- win/configure | 5 ----- 2 files changed, 10 deletions(-) diff --git a/unix/configure b/unix/configure index 44bd2a6..dd6bf6b 100755 --- a/unix/configure +++ b/unix/configure @@ -10159,11 +10159,6 @@ $as_echo "$tcl_ok" >&6; } #-------------------------------------------------------------------- # -# Check for --enable-zipfs flag -# -SC_ENABLE_ZIPFS - -# # Find a native zip implementation # diff --git a/win/configure b/win/configure index ddba42a..f65b78a 100755 --- a/win/configure +++ b/win/configure @@ -4848,11 +4848,6 @@ fi #-------------------------------------------------------------------- # -# Check for --enable-zipfs flag -# -SC_ENABLE_ZIPFS - -# # Find a native zip implementation # -- cgit v0.12 From da76cd286ccf8763ea9970ee813e3ef3da20e252 Mon Sep 17 00:00:00 2001 From: aspect Date: Fri, 17 Nov 2017 08:39:31 +0000 Subject: Zipfs: Use //zipfs:/ as mount point. Use Tcl_FSNormalizePath() on the way in to most VFS operations. Add some tests. --- generic/tclInterp.c | 4 +- generic/tclZipfs.c | 19 ++++++++-- tests/zipfs.test | 104 ++++++++++++++++++++++++++++++++++++++-------------- 3 files changed, 93 insertions(+), 34 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 2b0582a..8d45d87 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -402,8 +402,8 @@ Tcl_Init( " set scripts {{set tcl_library}}\n" " } else {\n" " set scripts {}\n" -" lappend scripts {set temp zipfs:/lib/tcl/tcl_library}\n" -" lappend scripts {set temp zipfs:/app/tcl_library}\n" +" lappend scripts {set temp //zipfs:/lib/tcl/tcl_library}\n" +" lappend scripts {set temp //zipfs:/app/tcl_library}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" " lappend scripts {\n" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 9dfca7a..6b707fc 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -28,11 +28,11 @@ #include "zlib.h" #include "crypt.h" -#define ZIPFS_VOLUME "zipfs:/" -#define ZIPFS_APP_MOUNT "zipfs:/app" -#define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" +#define ZIPFS_VOLUME "//zipfs:/" +#define ZIPFS_APP_MOUNT "//zipfs:/app" +#define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" -#define ZIPFS_VOLUME_LEN 7 +#define ZIPFS_VOLUME_LEN 9 /* * Various constants and offsets found in ZIP archive files @@ -2775,6 +2775,7 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) if (z == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + Tcl_AppendResult(interp, " \"", filename, "\"", NULL); } goto error; } @@ -3156,6 +3157,8 @@ Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, { int len; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, permissions); } @@ -3182,6 +3185,8 @@ Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) { int len; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); } @@ -3207,6 +3212,8 @@ Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) { int len; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); } @@ -3429,6 +3436,8 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) char *path; Tcl_DString ds; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + path = Tcl_GetStringFromObj(pathPtr, &len); if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) { return -1; @@ -3552,6 +3561,8 @@ Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, char *path; ZipEntry *z; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + path = Tcl_GetStringFromObj(pathPtr, &len); ReadLock(); z = ZipFSLookup(path); diff --git a/tests/zipfs.test b/tests/zipfs.test index 89d35ad..b14aa7d 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -18,69 +18,108 @@ if {"::tcltest" ni [namespace children]} { testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}] # Removed in tip430 - zipfs is no longer a static package -#test zipfs-1.1 {zipfs basics} -constraints zipfs -body { +#test zipfs-0.0 {zipfs basics} -constraints zipfs -body { # load {} zipfs #} -result {} -test zipfs-1.2 {zipfs basics} -constraints zipfs -body { +test zipfs-0.1 {zipfs basics} -constraints zipfs -body { package require zipfs } -result {1.0} -test zipfs-1.3 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-0.1 {zipfs basics} -constraints zipfs -body { + expr {"//zipfs:/" in [file volumes]} +} -result 1 + +test zipfs-0.2 {zipfs basics} -constraints zipfs -body { + string match //zipfs:/* $tcl_library +} -result 1 + +test zipfs-0.3 {zipfs basics: glob} -constraints zipfs -body { + set pwd [pwd] + cd $tcl_library + lsort [glob -dir . http*] +} -cleanup { + cd $pwd +} -result {./http ./http1.0} + +test zipfs-0.4 {zipfs basics: glob} -constraints zipfs -body { + set pwd [pwd] + cd $tcl_library + lsort [glob -dir [pwd] http*] +} -cleanup { + cd $pwd +} -result [list $tcl_library/http $tcl_library/http1.0] + +test zipfs-0.5 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -dir $tcl_library http*] +} -result [list $tcl_library/http $tcl_library/http1.0] + +test zipfs-0.6 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -tails -dir $tcl_library http*] +} -result {http http1.0} + +test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -nocomplain -tails -types d -dir $tcl_library http*] +} -result {http http1.0} + +test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -nocomplain -tails -types f -dir $tcl_library http*] +} -result {} + + +test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mount a b c d e f } -result {wrong # args: should be "zipfs mount ?zipfile? ?mountpoint? ?password?"} -test zipfs-1.4 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs unmount a b c d e f } -result {wrong # args: should be "zipfs unmount zipfile"} -test zipfs-1.5 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mkkey a b c d e f } -result {wrong # args: should be "zipfs mkkey password"} -test zipfs-1.6 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mkimg a b c d e f } -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"} -test zipfs-1.7 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mkzip a b c d e f } -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"} -test zipfs-1.8 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs exists a b c d e f } -result {wrong # args: should be "zipfs exists filename"} -test zipfs-1.9 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs info a b c d e f } -result {wrong # args: should be "zipfs info filename"} -test zipfs-1.10 {zipfs basics} -constraints zipfs -returnCodes error -body { +test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs list a b c d e f } -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"} -set ntcl_library [file normalize $tcl_library] - test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body { - zipfs mkzip abc.zip $ntcl_library/xxxx + zipfs mkzip /tmp/abc.zip $tcl_library/xxxx ;# FIXME: test independence } -result {empty archive} test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { set pwd [pwd] - cd $ntcl_library/encoding - zipfs mkzip abc.zip . - zipfs mount abc.zip zipfs:/abc - zipfs list -glob zipfs:/abc/cp850.* + cd $tcl_library/encoding + zipfs mkzip /tmp/abc.zip . + zipfs mount /tmp/abc.zip //zipfs:/abc ;# FIXME: test independence + zipfs list -glob //zipfs:/abc/cp850.* } -cleanup { cd $pwd -} -result {zipfs:/abc/cp850.enc} +} -result {//zipfs:/abc/cp850.enc} -test zipfs-2.3 {zipfs unmount} -constraints zipfs -body { - zipfs info zipfs:/abc/cp850.enc -} -result [list $ntcl_library/encoding/abc.zip 1090 527 39434] +test zipfs-2.3 {zipfs info} -constraints zipfs -body { + zipfs info //zipfs:/abc/cp850.enc +} -result [list /tmp/abc.zip 1090 527 39318] ;# FIXME: result depends on content of encodings dir -test zipfs-2.4 {zipfs unmount} -constraints zipfs -body { - set f [open zipfs:/abc/cp850.enc] - read $f +test zipfs-2.4 {zipfs data} -constraints zipfs -body { + set zipfd [open //zipfs:/abc/cp850.enc] ;# FIXME: leave open - see later test + read $zipfd } -result {# Encoding file: cp850, single-byte S 003F 0 1 @@ -101,14 +140,23 @@ S 00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 -} +} ;# FIXME: result depends on content of encodings dir test zipfs-2.5 {zipfs exists} -constraints zipfs -body { - zipfs unmount abc.zip zipfs exists /abc/cp850.enc -} -cleanup { - file delete abc.zip } -result 1 + +test zipfs-2.6 {zipfs unmount while busy} -constraints zipfs -body { + zipfs unmount /tmp/abc.zip +} -returnCodes error -result {filesystem is busy} + +test zipfs-2.7 {zipfs unmount} -constraints zipfs -body { + close $zipfd + zipfs unmount /tmp/abc.zip + zipfs exists /abc/cp850.enc +} -cleanup { + file delete /tmp/abc.zip ;# FIXME: test independence +} -result 0 ::tcltest::cleanupTests return -- cgit v0.12 From 87d37d3101b7ac510f9eb38766e63de5308a4d4b Mon Sep 17 00:00:00 2001 From: aspect Date: Fri, 17 Nov 2017 10:17:47 +0000 Subject: Zipfs: Nix AbsolutePath() and most uses of CanonicalPath(). Tcl_FSNormalizePath is to be trusted. --- generic/tclZipfs.c | 116 +++++++++++++++-------------------------------------- 1 file changed, 32 insertions(+), 84 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 6b707fc..a03f4cf 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -645,50 +645,6 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA /* *------------------------------------------------------------------------- * - * AbsolutePath -- - * - * This function computes the absolute path from a given - * (relative) path name into the specified Tcl_DString. - * - * Results: - * Returns the pointer to the absolute path contained in the - * specified Tcl_DString. - * - * Side effects: - * Modifies the specified Tcl_DString. - * - *------------------------------------------------------------------------- - */ - -static char * -AbsolutePath(const char *path, - Tcl_DString *dsPtr, - int ZIPFSPATH) -{ - char *result; - if (*path == '~') { - Tcl_DStringAppend(dsPtr, path, -1); - return Tcl_DStringValue(dsPtr); - } - if (*path != '/') { - Tcl_DString pwd; - - /* relative path */ - Tcl_DStringInit(&pwd); - Tcl_GetCwd(NULL, &pwd); - result = Tcl_DStringValue(&pwd); - result = CanonicalPath(result, path, dsPtr,ZIPFSPATH); - Tcl_DStringFree(&pwd); - } else { - /* absolute path */ - result = CanonicalPath("", path, dsPtr,ZIPFSPATH); - } - return result; -} - -/* - *------------------------------------------------------------------------- - * * ZipFSLookup -- * * This function returns the ZIP entry struct corresponding to @@ -708,14 +664,11 @@ AbsolutePath(const char *path, static ZipEntry * ZipFSLookup(char *filename) { - char *realname; - Tcl_HashEntry *hPtr; ZipEntry *z; Tcl_DString ds; Tcl_DStringInit(&ds); - realname = AbsolutePath(filename, &ds, 1); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, realname); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename); z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; Tcl_DStringFree(&ds); return z; @@ -743,18 +696,16 @@ ZipFSLookup(char *filename) static int ZipFSLookupMount(char *filename) { - char *realname; Tcl_HashEntry *hPtr; Tcl_HashSearch search; ZipFile *zf; Tcl_DString ds; int match = 0; Tcl_DStringInit(&ds); - realname = AbsolutePath(filename, &ds, 1); hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); while (hPtr != NULL) { if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (strcmp(zf->mntpt, realname) == 0) { + if (strcmp(zf->mntpt, filename) == 0) { match = 1; break; } @@ -1052,12 +1003,11 @@ int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { - char *realname, *p; int i, pwlen, isNew; ZipFile *zf, zf0; ZipEntry *z; Tcl_HashEntry *hPtr; - Tcl_DString ds, dsm, fpBuf; + Tcl_DString ds, fpBuf; unsigned char *q; ReadLock(); @@ -1096,9 +1046,7 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, Unlock(); return TCL_OK; } - Tcl_DStringInit(&ds); - p = AbsolutePath(zipname, &ds, 0); - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, p); + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); if (hPtr != NULL) { if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { Tcl_SetObjResult(interp, @@ -1106,7 +1054,6 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, } } Unlock(); - Tcl_DStringFree(&ds); return TCL_OK; } Unlock(); @@ -1124,18 +1071,13 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { return TCL_ERROR; } - Tcl_DStringInit(&ds); - realname = AbsolutePath(zipname, &ds, 0); /* * Mount point can come from Tcl_GetNameOfExecutable() * which sometimes is a relative or otherwise denormalized path. * But an absolute name is needed as mount point here. */ - Tcl_DStringInit(&dsm); - mntpt = CanonicalPath("", mntpt, &dsm, 1); WriteLock(); - hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, realname, &isNew); - Tcl_DStringSetLength(&ds, 0); + hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew); if (!isNew) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (interp != NULL) { @@ -1143,8 +1085,6 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, zf->mntpt : "/", "\"", (char *) NULL); } Unlock(); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsm); ZipFSCloseArchive(interp, &zf0); return TCL_ERROR; } @@ -1157,8 +1097,6 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, Tcl_AppendResult(interp, "out of memory", (char *) NULL); } Unlock(); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsm); ZipFSCloseArchive(interp, &zf0); return TCL_ERROR; } @@ -1209,6 +1147,7 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, } q = zf->data + zf->centoffs; Tcl_DStringInit(&fpBuf); + Tcl_DStringInit(&ds); for (i = 0; i < zf->nfiles; i++) { int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; unsigned char *lq, *gq = NULL; @@ -1374,7 +1313,6 @@ nextent: Unlock(); Tcl_DStringFree(&fpBuf); Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsm); Tcl_FSMountsChanged(NULL); return TCL_OK; } @@ -1398,7 +1336,6 @@ nextent: int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) { - char *realname; ZipFile *zf; ZipEntry *z, *znext; Tcl_HashEntry *hPtr; @@ -1406,12 +1343,11 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) int ret = TCL_OK, unmounted = 0; Tcl_DStringInit(&ds); - realname = AbsolutePath(zipname, &ds, 0); WriteLock(); if (!ZipFS.initialized) { goto done; } - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, realname); + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); if (hPtr == NULL) { /* don't report error */ goto done; @@ -2304,15 +2240,24 @@ ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, { char *filename; int exists; + Tcl_DString ds; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "filename"); return TCL_ERROR; } + + /* prepend ZIPFS_VOLUME to filename, eliding the final / */ filename = Tcl_GetStringFromObj(objv[1], 0); + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN-1); + Tcl_DStringAppend(&ds, filename, -1); + filename = Tcl_DStringValue(&ds); + ReadLock(); exists = ZipFSLookup(filename) != NULL; Unlock(); + Tcl_SetObjResult(interp,Tcl_NewBooleanObj(exists)); return TCL_OK; } @@ -3157,7 +3102,7 @@ Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, { int len; - if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return NULL; return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, permissions); @@ -3267,19 +3212,26 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, { Tcl_HashEntry *hPtr; Tcl_HashSearch search; + Tcl_Obj *normPathPtr; int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; char *pat, *prefix, *path; - Tcl_DString ds, dsPref; + Tcl_DString dsPref; + + if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + if (types != NULL) { dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; } - Tcl_DStringInit(&ds); - Tcl_DStringInit(&dsPref); + + /* the prefix that gets prepended to results */ prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); + + /* the (normalized) path we're searching */ + path = Tcl_GetStringFromObj(normPathPtr, &len); + + Tcl_DStringInit(&dsPref); Tcl_DStringAppend(&dsPref, prefix, prefixLen); - prefix = Tcl_DStringValue(&dsPref); - path = AbsolutePath(prefix, &ds, 1); - len = Tcl_DStringLength(&ds); + if (strcmp(prefix, path) == 0) { prefix = NULL; } else { @@ -3405,7 +3357,6 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, end: Unlock(); Tcl_DStringFree(&dsPref); - Tcl_DStringFree(&ds); return TCL_OK; } @@ -3434,7 +3385,6 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) ZipFile *zf; int ret = -1, len; char *path; - Tcl_DString ds; if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; @@ -3443,9 +3393,8 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) return -1; } - Tcl_DStringInit(&ds); - path = CanonicalPath("",path, &ds, 1); - len = Tcl_DStringLength(&ds); + len = strlen(path); + ReadLock(); hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); if (hPtr != NULL) { @@ -3476,7 +3425,6 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) } endloop: Unlock(); - Tcl_DStringFree(&ds); return ret; } -- cgit v0.12 From 451510384623e7c0f4ca04f3ec6d5845fe69de33 Mon Sep 17 00:00:00 2001 From: aspect Date: Fri, 17 Nov 2017 10:21:41 +0000 Subject: whitespace consistency --- generic/tclZipfs.c | 1152 ++++++++++++++++++++++++++-------------------------- 1 file changed, 576 insertions(+), 576 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index a03f4cf..5aa001f 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -503,141 +503,141 @@ CountSlashes(const char *string) static char * CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPATH) { - char *path; - char *result; - int i, j, c, isunc = 0, isvfs=0, n=0; + char *path; + char *result; + int i, j, c, isunc = 0, isvfs=0, n=0; #if HAS_DRIVES - int zipfspath=1; - if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && - (tail[1] == ':')) { - tail += 2; - zipfspath=0; - } - /* UNC style path */ - if (tail[0] == '\\') { - root = ""; - ++tail; - zipfspath=0; - } - if (tail[0] == '\\') { - root = "/"; - ++tail; - zipfspath=0; - } - if(zipfspath) { -#endif + int zipfspath=1; + if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && + (tail[1] == ':')) { + tail += 2; + zipfspath=0; + } /* UNC style path */ - if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) { - isvfs=1; - } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) { - isvfs=2; - } - if(isvfs!=1) { - if ((root[0] == '/') && (root[1] == '/')) { - isunc = 1; - } + if (tail[0] == '\\') { + root = ""; + ++tail; + zipfspath=0; } -#if HAS_DRIVES - } -#endif - if(isvfs!=2) { - if (tail[0] == '/') { - if(isvfs!=1) { - root = ""; - } - ++tail; - isunc = 0; + if (tail[0] == '\\') { + root = "/"; + ++tail; + zipfspath=0; } - if (tail[0] == '/') { - if(isvfs!=1) { - root = "/"; - } - ++tail; - isunc = 1; - } - } - i = strlen(root); - j = strlen(tail); - if(isvfs==1) { - if(i>ZIPFS_VOLUME_LEN) { - Tcl_DStringSetLength(dsPtr, i + j + 1); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - path[i++] = '/'; - memcpy(path + i, tail, j); - } else { - Tcl_DStringSetLength(dsPtr, i + j); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - memcpy(path + i, tail, j); + if(zipfspath) { +#endif + /* UNC style path */ + if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) { + isvfs=1; + } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) { + isvfs=2; + } + if(isvfs!=1) { + if ((root[0] == '/') && (root[1] == '/')) { + isunc = 1; + } + } +#if HAS_DRIVES } - } else if(isvfs==2) { - Tcl_DStringSetLength(dsPtr, j); - path = Tcl_DStringValue(dsPtr); - memcpy(path, tail, j); - } else { - if (ZIPFSPATH) { - Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); - path = Tcl_DStringValue(dsPtr); - memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN); - memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j); +#endif + if(isvfs!=2) { + if (tail[0] == '/') { + if(isvfs!=1) { + root = ""; + } + ++tail; + isunc = 0; + } + if (tail[0] == '/') { + if(isvfs!=1) { + root = "/"; + } + ++tail; + isunc = 1; + } + } + i = strlen(root); + j = strlen(tail); + if(isvfs==1) { + if(i>ZIPFS_VOLUME_LEN) { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + memcpy(path + i, tail, j); + } + } else if(isvfs==2) { + Tcl_DStringSetLength(dsPtr, j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, tail, j); } else { - Tcl_DStringSetLength(dsPtr, i + j + 1); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - path[i++] = '/'; - memcpy(path + i, tail, j); + if (ZIPFSPATH) { + Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); + path = Tcl_DStringValue(dsPtr); + memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN); + memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } } - } #if HAS_DRIVES - for (i = 0; path[i] != '\0'; i++) { - if (path[i] == '\\') { - path[i] = '/'; + for (i = 0; path[i] != '\0'; i++) { + if (path[i] == '\\') { + path[i] = '/'; + } } - } #endif - if(ZIPFSPATH) { - n=ZIPFS_VOLUME_LEN; - } else { - n=0; - } - for (i = j = n; (c = path[i]) != '\0'; i++) { - if (c == '/') { + if(ZIPFSPATH) { + n=ZIPFS_VOLUME_LEN; + } else { + n=0; + } + for (i = j = n; (c = path[i]) != '\0'; i++) { + if (c == '/') { int c2 = path[i + 1]; if (c2 == '/') { - continue; + continue; } if (c2 == '.') { - int c3 = path[i + 2]; - if ((c3 == '/') || (c3 == '\0')) { - i++; - continue; - } - if ((c3 == '.') && - ((path[i + 3] == '/') || (path [i + 3] == '\0'))) { - i += 2; - while ((j > 0) && (path[j - 1] != '/')) { - j--; - } - if (j > isunc) { - --j; - while ((j > 1 + isunc) && (path[j - 2] == '/')) { - j--; - } - } - continue; - } + int c3 = path[i + 2]; + if ((c3 == '/') || (c3 == '\0')) { + i++; + continue; + } + if ((c3 == '.') && + ((path[i + 3] == '/') || (path [i + 3] == '\0'))) { + i += 2; + while ((j > 0) && (path[j - 1] != '/')) { + j--; + } + if (j > isunc) { + --j; + while ((j > 1 + isunc) && (path[j - 2] == '/')) { + j--; + } + } + continue; + } } + } + path[j++] = c; + } + if (j == 0) { + path[j++] = '/'; } - path[j++] = c; - } - if (j == 0) { - path[j++] = '/'; - } - path[j] = 0; - Tcl_DStringSetLength(dsPtr, j); - result=Tcl_DStringValue(dsPtr); - return result; + path[j] = 0; + Tcl_DStringSetLength(dsPtr, j); + result=Tcl_DStringValue(dsPtr); + return result; } @@ -664,14 +664,14 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA static ZipEntry * ZipFSLookup(char *filename) { - Tcl_HashEntry *hPtr; - ZipEntry *z; - Tcl_DString ds; - Tcl_DStringInit(&ds); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename); - z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; - Tcl_DStringFree(&ds); - return z; + Tcl_HashEntry *hPtr; + ZipEntry *z; + Tcl_DString ds; + Tcl_DStringInit(&ds); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename); + z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; + Tcl_DStringFree(&ds); + return z; } #ifdef NEVER_USED @@ -696,24 +696,24 @@ ZipFSLookup(char *filename) static int ZipFSLookupMount(char *filename) { - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - ZipFile *zf; - Tcl_DString ds; - int match = 0; - Tcl_DStringInit(&ds); - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (strcmp(zf->mntpt, filename) == 0) { - match = 1; - break; - } + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + Tcl_DString ds; + int match = 0; + Tcl_DStringInit(&ds); + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (strcmp(zf->mntpt, filename) == 0) { + match = 1; + break; + } + } + hPtr = Tcl_NextHashEntry(&search); } - hPtr = Tcl_NextHashEntry(&search); - } - Tcl_DStringFree(&ds); - return match; + Tcl_DStringFree(&ds); + return match; } #endif @@ -1003,190 +1003,190 @@ int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd) { - int i, pwlen, isNew; - ZipFile *zf, zf0; - ZipEntry *z; - Tcl_HashEntry *hPtr; - Tcl_DString ds, fpBuf; - unsigned char *q; - - ReadLock(); - if (!ZipFS.initialized) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("not initialized", -1)); - } - Unlock(); - return TCL_ERROR; - } - if (zipname == NULL) { - Tcl_HashSearch search; - int ret = TCL_OK; + int i, pwlen, isNew; + ZipFile *zf, zf0; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_DString ds, fpBuf; + unsigned char *q; - i = 0; - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (interp != NULL) { - Tcl_AppendElement(interp, zf->mntpt); - Tcl_AppendElement(interp, zf->name); - } - ++i; - } - hPtr = Tcl_NextHashEntry(&search); + ReadLock(); + if (!ZipFS.initialized) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("not initialized", -1)); + } + Unlock(); + return TCL_ERROR; } - if (interp == NULL) { - ret = (i > 0) ? TCL_OK : TCL_BREAK; + if (zipname == NULL) { + Tcl_HashSearch search; + int ret = TCL_OK; + + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; } - Unlock(); - return ret; - } - if (mntpt == NULL) { - if (interp == NULL) { + if (mntpt == NULL) { + if (interp == NULL) { Unlock(); return TCL_OK; - } - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); - if (hPtr != NULL) { - if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); - } + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } + } + Unlock(); + return TCL_OK; } Unlock(); - return TCL_OK; - } - Unlock(); - pwlen = 0; - if (passwd != NULL) { - pwlen = strlen(passwd); - if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + pwlen = 0; + if (passwd != NULL) { + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); } return TCL_ERROR; + } } - } - if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { - return TCL_ERROR; - } - /* - * Mount point can come from Tcl_GetNameOfExecutable() - * which sometimes is a relative or otherwise denormalized path. - * But an absolute name is needed as mount point here. - */ - WriteLock(); - hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew); - if (!isNew) { - zf = (ZipFile *) Tcl_GetHashValue(hPtr); - if (interp != NULL) { - Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? - zf->mntpt : "/", "\"", (char *) NULL); - } - Unlock(); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; - } - if (strcmp(mntpt, "/") == 0) { - mntpt = ""; - } - zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); - if (zf == NULL) { - if (interp != NULL) { - Tcl_AppendResult(interp, "out of memory", (char *) NULL); + if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { + return TCL_ERROR; } - Unlock(); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; - } - *zf = zf0; - zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); - strcpy(zf->mntpt, mntpt); - zf->mntptlen = strlen(zf->mntpt); - zf->entries = NULL; - zf->topents = NULL; - zf->nopen = 0; - Tcl_SetHashValue(hPtr, (ClientData) zf); - if ((zf->pwbuf[0] == 0) && pwlen) { - int k = 0; - i = pwlen; - zf->pwbuf[k++] = i; - while (i > 0) { - zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | - pwrot[(passwd[i - 1] >> 4) & 0x0f]; - k++; - i--; - } - zf->pwbuf[k] = '\0'; - } - if (mntpt[0] != '\0') { - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = CountSlashes(mntpt); - z->zipfile = zf; - z->isdir = 1; - z->isenc = 0; - z->offset = zf->baseoffs; - z->crc32 = 0; - z->timestamp = 0; - z->nbyte = z->nbytecompr = 0; - z->cmeth = ZIP_COMPMETH_STORED; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); + /* + * Mount point can come from Tcl_GetNameOfExecutable() + * which sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ + WriteLock(); + hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew); if (!isNew) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (interp != NULL) { + Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? + zf->mntpt : "/", "\"", (char *) NULL); + } + Unlock(); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + if (strcmp(mntpt, "/") == 0) { + mntpt = ""; + } + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + Unlock(); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + *zf = zf0; + zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + strcpy(zf->mntpt, mntpt); + zf->mntptlen = strlen(zf->mntpt); + zf->entries = NULL; + zf->topents = NULL; + zf->nopen = 0; + Tcl_SetHashValue(hPtr, (ClientData) zf); + if ((zf->pwbuf[0] == 0) && pwlen) { + int k = 0; + i = pwlen; + zf->pwbuf[k++] = i; + while (i > 0) { + zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | + pwrot[(passwd[i - 1] >> 4) & 0x0f]; + k++; + i--; + } + zf->pwbuf[k] = '\0'; + } + if (mntpt[0] != '\0') { + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(mntpt); + z->zipfile = zf; + z->isdir = 1; + z->isenc = 0; + z->offset = zf->baseoffs; + z->crc32 = 0; + z->timestamp = 0; + z->nbyte = z->nbytecompr = 0; + z->cmeth = ZIP_COMPMETH_STORED; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); + if (!isNew) { /* skip it */ Tcl_Free((char *) z); - } else { + } else { Tcl_SetHashValue(hPtr, (ClientData) z); z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); z->next = zf->entries; zf->entries = z; + } } - } - q = zf->data + zf->centoffs; - Tcl_DStringInit(&fpBuf); - Tcl_DStringInit(&ds); - for (i = 0; i < zf->nfiles; i++) { - int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; - unsigned char *lq, *gq = NULL; - char *fullpath, *path; - - pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); - comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); - extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); - path = Tcl_DStringValue(&ds); - if ((pathlen > 0) && (path[pathlen - 1] == '/')) { + q = zf->data + zf->centoffs; + Tcl_DStringInit(&fpBuf); + Tcl_DStringInit(&ds); + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; + unsigned char *lq, *gq = NULL; + char *fullpath, *path; + + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); + path = Tcl_DStringValue(&ds); + if ((pathlen > 0) && (path[pathlen - 1] == '/')) { Tcl_DStringSetLength(&ds, pathlen - 1); path = Tcl_DStringValue(&ds); isdir = 1; - } - if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { + } + if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { goto nextent; - } - lq = zf->data + zf->baseoffs + - zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); - if ((lq < zf->data) || (lq > (zf->data + zf->length))) { + } + lq = zf->data + zf->baseoffs + + zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); + if ((lq < zf->data) || (lq > (zf->data + zf->length))) { goto nextent; - } - nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); - if (!isdir && (nbcompr == 0) && - (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && - (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { + } + nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); + if (!isdir && (nbcompr == 0) && + (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && + (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { gq = q; nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); - } - offs = (lq - zf->data) - + ZIP_LOCAL_HEADER_LEN - + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) - + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); - if ((offs + nbcompr) > zf->length) { + } + offs = (lq - zf->data) + + ZIP_LOCAL_HEADER_LEN + + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) + + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); + if ((offs + nbcompr) > zf->length) { goto nextent; - } - if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { + } + if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { #ifdef ANDROID /* * When mounting the ZIP archive on the root directory try @@ -1204,117 +1204,117 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, Tcl_DStringAppend(&ds2, path, -1); hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2)); if (hPtr != NULL) { - /* should not happen but skip it anyway */ - Tcl_DStringFree(&ds2); - goto nextent; + /* should not happen but skip it anyway */ + Tcl_DStringFree(&ds2); + goto nextent; } Tcl_DStringSetLength(&ds, 0); Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), - Tcl_DStringLength(&ds2)); + Tcl_DStringLength(&ds2)); path = Tcl_DStringValue(&ds); Tcl_DStringFree(&ds2); #else - /* - * Regular files skipped when mounting on root. - */ - goto nextent; + /* + * Regular files skipped when mounting on root. + */ + goto nextent; #endif - } - Tcl_DStringSetLength(&fpBuf, 0); - fullpath = CanonicalPath(mntpt, path, &fpBuf, 1); - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = CountSlashes(fullpath); - z->zipfile = zf; - z->isdir = isdir; - z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) + } + Tcl_DStringSetLength(&fpBuf, 0); + fullpath = CanonicalPath(mntpt, path, &fpBuf, 1); + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(fullpath); + z->zipfile = zf; + z->isdir = isdir; + z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) && (nbcompr > 12); - z->offset = offs; - if (gq != NULL) { + z->offset = offs; + if (gq != NULL) { z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); z->timestamp = DosTimeDate(dosDate, dosTime); z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); - } else { + } else { z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); z->timestamp = DosTimeDate(dosDate, dosTime); z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); - } - z->nbytecompr = nbcompr; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); - if (!isNew) { + } + z->nbytecompr = nbcompr; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); + if (!isNew) { /* should not happen but skip it anyway */ Tcl_Free((char *) z); - } else { + } else { Tcl_SetHashValue(hPtr, (ClientData) z); z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); z->next = zf->entries; zf->entries = z; if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { - z->tnext = zf->topents; - zf->topents = z; + z->tnext = zf->topents; + zf->topents = z; } if (!z->isdir && (z->depth > 1)) { - char *dir, *end; - ZipEntry *zd; - - Tcl_DStringSetLength(&ds, strlen(z->name) + 8); - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, z->name, -1); - dir = Tcl_DStringValue(&ds); - end = strrchr(dir, '/'); - while ((end != NULL) && (end != dir)) { - Tcl_DStringSetLength(&ds, end - dir); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); - if (hPtr != NULL) { - break; - } - zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); - zd->name = NULL; - zd->tnext = NULL; - zd->depth = CountSlashes(dir); - zd->zipfile = zf; - zd->isdir = 1; - zd->isenc = 0; - zd->offset = z->offset; - zd->crc32 = 0; - zd->timestamp = z->timestamp; - zd->nbyte = zd->nbytecompr = 0; - zd->cmeth = ZIP_COMPMETH_STORED; - zd->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); - if (!isNew) { - /* should not happen but skip it anyway */ - Tcl_Free((char *) zd); - } else { - Tcl_SetHashValue(hPtr, (ClientData) zd); - zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - zd->next = zf->entries; - zf->entries = zd; - if ((mntpt[0] == '\0') && (zd->depth == 1)) { - zd->tnext = zf->topents; - zf->topents = zd; - } - } - end = strrchr(dir, '/'); - } + char *dir, *end; + ZipEntry *zd; + + Tcl_DStringSetLength(&ds, strlen(z->name) + 8); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, z->name, -1); + dir = Tcl_DStringValue(&ds); + end = strrchr(dir, '/'); + while ((end != NULL) && (end != dir)) { + Tcl_DStringSetLength(&ds, end - dir); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); + if (hPtr != NULL) { + break; + } + zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); + zd->name = NULL; + zd->tnext = NULL; + zd->depth = CountSlashes(dir); + zd->zipfile = zf; + zd->isdir = 1; + zd->isenc = 0; + zd->offset = z->offset; + zd->crc32 = 0; + zd->timestamp = z->timestamp; + zd->nbyte = zd->nbytecompr = 0; + zd->cmeth = ZIP_COMPMETH_STORED; + zd->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) zd); + } else { + Tcl_SetHashValue(hPtr, (ClientData) zd); + zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + zd->next = zf->entries; + zf->entries = zd; + if ((mntpt[0] == '\0') && (zd->depth == 1)) { + zd->tnext = zf->topents; + zf->topents = zd; + } + } + end = strrchr(dir, '/'); + } } - } + } nextent: - q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; - } - Unlock(); - Tcl_DStringFree(&fpBuf); - Tcl_DStringFree(&ds); - Tcl_FSMountsChanged(NULL); - return TCL_OK; + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + Unlock(); + Tcl_DStringFree(&fpBuf); + Tcl_DStringFree(&ds); + Tcl_FSMountsChanged(NULL); + return TCL_OK; } /* @@ -1336,53 +1336,53 @@ nextent: int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) { - ZipFile *zf; - ZipEntry *z, *znext; - Tcl_HashEntry *hPtr; - Tcl_DString ds; - int ret = TCL_OK, unmounted = 0; - - Tcl_DStringInit(&ds); - WriteLock(); - if (!ZipFS.initialized) { - goto done; - } - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); - if (hPtr == NULL) { - /* don't report error */ - goto done; - } - zf = (ZipFile *) Tcl_GetHashValue(hPtr); - if (zf->nopen > 0) { - if (interp != NULL) { + ZipFile *zf; + ZipEntry *z, *znext; + Tcl_HashEntry *hPtr; + Tcl_DString ds; + int ret = TCL_OK, unmounted = 0; + + Tcl_DStringInit(&ds); + WriteLock(); + if (!ZipFS.initialized) { + goto done; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); + if (hPtr == NULL) { + /* don't report error */ + goto done; + } + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->nopen > 0) { + if (interp != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("filesystem is busy", -1)); + Tcl_NewStringObj("filesystem is busy", -1)); + } + ret = TCL_ERROR; + goto done; } - ret = TCL_ERROR; - goto done; - } - Tcl_DeleteHashEntry(hPtr); - for (z = zf->entries; z; z = znext) { - znext = z->next; - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); - if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + for (z = zf->entries; z; z = znext) { + znext = z->next; + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); + if (hPtr) { Tcl_DeleteHashEntry(hPtr); - } - if (z->data != NULL) { + } + if (z->data != NULL) { Tcl_Free((char *) z->data); + } + Tcl_Free((char *) z); } - Tcl_Free((char *) z); - } - ZipFSCloseArchive(interp, zf); - Tcl_Free((char *) zf); - unmounted = 1; + ZipFSCloseArchive(interp, zf); + Tcl_Free((char *) zf); + unmounted = 1; done: - Unlock(); - Tcl_DStringFree(&ds); - if (unmounted) { - Tcl_FSMountsChanged(NULL); - } - return ret; + Unlock(); + Tcl_DStringFree(&ds); + if (unmounted) { + Tcl_FSMountsChanged(NULL); + } + return ret; } /* @@ -2186,34 +2186,34 @@ static int ZipFSCanonicalObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - char *mntpoint=NULL; - char *filename=NULL; - char *result; - Tcl_DString dPath; + char *mntpoint=NULL; + char *filename=NULL; + char *result; + Tcl_DString dPath; - if (objc != 2 && objc != 3 && objc!=4) { - Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?"); - return TCL_ERROR; - } - Tcl_DStringInit(&dPath); - if(objc==2) { - filename = Tcl_GetString(objv[1]); - result=CanonicalPath("",filename,&dPath,1); - } else if (objc==3) { - mntpoint = Tcl_GetString(objv[1]); - filename = Tcl_GetString(objv[2]); - result=CanonicalPath(mntpoint,filename,&dPath,1); - } else { - int zipfs=0; - if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) { - return TCL_ERROR; + if (objc != 2 && objc != 3 && objc!=4) { + Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?"); + return TCL_ERROR; + } + Tcl_DStringInit(&dPath); + if(objc==2) { + filename = Tcl_GetString(objv[1]); + result=CanonicalPath("",filename,&dPath,1); + } else if (objc==3) { + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,1); + } else { + int zipfs=0; + if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) { + return TCL_ERROR; + } + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,zipfs); } - mntpoint = Tcl_GetString(objv[1]); - filename = Tcl_GetString(objv[2]); - result=CanonicalPath(mntpoint,filename,&dPath,zipfs); - } - Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1)); - return TCL_OK; + Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1)); + return TCL_OK; } /* @@ -3210,154 +3210,154 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types) { - Tcl_HashEntry *hPtr; - Tcl_HashSearch search; - Tcl_Obj *normPathPtr; - int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; - char *pat, *prefix, *path; - Tcl_DString dsPref; - - if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; - - if (types != NULL) { - dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; - } - - /* the prefix that gets prepended to results */ - prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); - - /* the (normalized) path we're searching */ - path = Tcl_GetStringFromObj(normPathPtr, &len); - - Tcl_DStringInit(&dsPref); - Tcl_DStringAppend(&dsPref, prefix, prefixLen); - - if (strcmp(prefix, path) == 0) { - prefix = NULL; - } else { - strip = len + 1; - } - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, "/", 1); - prefixLen++; - prefix = Tcl_DStringValue(&dsPref); - } - ReadLock(); - if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { - l = CountSlashes(path); - if (path[len - 1] == '/') { - len--; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *normPathPtr; + int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; + char *pat, *prefix, *path; + Tcl_DString dsPref; + + if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + + if (types != NULL) { + dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; + } + + /* the prefix that gets prepended to results */ + prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); + + /* the (normalized) path we're searching */ + path = Tcl_GetStringFromObj(normPathPtr, &len); + + Tcl_DStringInit(&dsPref); + Tcl_DStringAppend(&dsPref, prefix, prefixLen); + + if (strcmp(prefix, path) == 0) { + prefix = NULL; } else { - l++; + strip = len + 1; } - if ((pattern == NULL) || (pattern[0] == '\0')) { - pattern = "*"; + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, "/", 1); + prefixLen++; + prefix = Tcl_DStringValue(&dsPref); } - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { + ReadLock(); + if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { + l = CountSlashes(path); + if (path[len - 1] == '/') { + len--; + } else { + l++; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + pattern = "*"; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->mntptlen == 0) { - ZipEntry *z = zf->topents; - while (z != NULL) { - int lenz = strlen(z->name); - if ((lenz > len + 1) && - (strncmp(z->name, path, len) == 0) && - (z->name[len] == '/') && - (CountSlashes(z->name) == l) && - Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name, lenz); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name, lenz)); - } - } - z = z->tnext; - } + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + if ((lenz > len + 1) && + (strncmp(z->name, path, len) == 0) && + (z->name[len] == '/') && + (CountSlashes(z->name) == l) && + Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, lenz); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, lenz)); + } + } + z = z->tnext; + } } else if ((zf->mntptlen > len + 1) && - (strncmp(zf->mntpt, path, len) == 0) && - (zf->mntpt[len] == '/') && - (CountSlashes(zf->mntpt) == l) && - Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); - } + (strncmp(zf->mntpt, path, len) == 0) && + (zf->mntpt[len] == '/') && + (CountSlashes(zf->mntpt) == l) && + Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } } hPtr = Tcl_NextHashEntry(&search); + } + goto end; } - goto end; - } - if ((pattern == NULL) || (pattern[0] == '\0')) { - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); - if (hPtr != NULL) { + if ((pattern == NULL) || (pattern[0] == '\0')) { + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); if ((dirOnly < 0) || - (!dirOnly && !z->isdir) || - (dirOnly && z->isdir)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name, -1); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name, -1)); - } + (!dirOnly && !z->isdir) || + (dirOnly && z->isdir)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, -1)); + } } - } - goto end; - } - l = strlen(pattern); - pat = Tcl_Alloc(len + l + 2); - memcpy(pat, path, len); - while ((len > 1) && (pat[len - 1] == '/')) { - --len; - } - if ((len > 1) || (pat[0] != '/')) { - pat[len] = '/'; - ++len; - } - memcpy(pat + len, pattern, l + 1); - scnt = CountSlashes(pat); - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - if ((dirOnly >= 0) && - ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) { + } + goto end; + } + l = strlen(pattern); + pat = Tcl_Alloc(len + l + 2); + memcpy(pat, path, len); + while ((len > 1) && (pat[len - 1] == '/')) { + --len; + } + if ((len > 1) || (pat[0] != '/')) { + pat[len] = '/'; + ++len; + } + memcpy(pat + len, pattern, l + 1); + scnt = CountSlashes(pat); + for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + if ((dirOnly >= 0) && + ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) { continue; - } - if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { + } + if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name + strip, -1); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); + Tcl_DStringAppend(&dsPref, z->name + strip, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name + strip, -1)); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name + strip, -1)); } + } } - } - Tcl_Free(pat); + Tcl_Free(pat); end: - Unlock(); - Tcl_DStringFree(&dsPref); - return TCL_OK; + Unlock(); + Tcl_DStringFree(&dsPref); + return TCL_OK; } /* @@ -3445,7 +3445,7 @@ endloop: */ static Tcl_Obj * Zip_FSListVolumesProc(void) { - return Tcl_NewStringObj(ZIPFS_VOLUME, -1); + return Tcl_NewStringObj(ZIPFS_VOLUME, -1); } /* -- cgit v0.12 From 7c1f63bb60215a26625aa1f5a7ad3074d83d4898 Mon Sep 17 00:00:00 2001 From: aspect Date: Fri, 17 Nov 2017 10:24:45 +0000 Subject: clean up stray unused dstrings --- generic/tclZipfs.c | 6 ------ 1 file changed, 6 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 5aa001f..38abf0e 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -699,9 +699,7 @@ ZipFSLookupMount(char *filename) Tcl_HashEntry *hPtr; Tcl_HashSearch search; ZipFile *zf; - Tcl_DString ds; int match = 0; - Tcl_DStringInit(&ds); hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); while (hPtr != NULL) { if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { @@ -712,7 +710,6 @@ ZipFSLookupMount(char *filename) } hPtr = Tcl_NextHashEntry(&search); } - Tcl_DStringFree(&ds); return match; } #endif @@ -1339,10 +1336,8 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) ZipFile *zf; ZipEntry *z, *znext; Tcl_HashEntry *hPtr; - Tcl_DString ds; int ret = TCL_OK, unmounted = 0; - Tcl_DStringInit(&ds); WriteLock(); if (!ZipFS.initialized) { goto done; @@ -1378,7 +1373,6 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) unmounted = 1; done: Unlock(); - Tcl_DStringFree(&ds); if (unmounted) { Tcl_FSMountsChanged(NULL); } -- cgit v0.12 From f81c2ae72421a94e27139ec158ac8822ad6beb5c Mon Sep 17 00:00:00 2001 From: aspect Date: Fri, 17 Nov 2017 11:53:19 +0000 Subject: fix [glob] handling of leading // --- generic/tclFileName.c | 2 +- tests/zipfs.test | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 15fcde7..015cfc3 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1881,7 +1881,7 @@ TclGlob( separators = "/\\"; } else if (tclPlatform == TCL_PLATFORM_UNIX) { - if (pathPrefix == NULL && tail[0] == '/') { + if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') { pathPrefix = Tcl_NewStringObj(tail, 1); tail++; Tcl_IncrRefCount(pathPrefix); diff --git a/tests/zipfs.test b/tests/zipfs.test index b14aa7d..97dc463 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -55,14 +55,18 @@ test zipfs-0.5 {zipfs basics: glob} -constraints zipfs -body { } -result [list $tcl_library/http $tcl_library/http1.0] test zipfs-0.6 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob $tcl_library/http*] +} -result [list $tcl_library/http $tcl_library/http1.0] + +test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body { lsort [glob -tails -dir $tcl_library http*] } -result {http http1.0} -test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body { +test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body { lsort [glob -nocomplain -tails -types d -dir $tcl_library http*] } -result {http http1.0} -test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body { +test zipfs-0.9 {zipfs basics: glob} -constraints zipfs -body { lsort [glob -nocomplain -tails -types f -dir $tcl_library http*] } -result {} -- cgit v0.12 From 2ea8f0fe98ed8a2f72d7d355b9c080fbb5bdd912 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2017 16:08:49 +0000 Subject: merge core-8-branch. Fix some Tcl_UniChar initialization, in case TCL_UTF_MAX == 4 --- doc/ToUpper.3 | 6 +++--- doc/UniCharIsAlpha.3 | 7 ++----- doc/Utf.3 | 2 +- generic/tclScan.c | 2 +- generic/tclStringObj.c | 10 +++++----- generic/tclUtf.c | 34 ++++++++++++++++++++++++---------- generic/tclUtil.c | 14 +++++++------- win/tclWinSerial.c | 6 +++--- 8 files changed, 46 insertions(+), 35 deletions(-) diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index 14766da..b06b793 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -16,10 +16,10 @@ Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_ int \fBTcl_UniCharToUpper\fR(\fIch\fR) .sp -Tcl_UniChar +int \fBTcl_UniCharToLower\fR(\fIch\fR) .sp -Tcl_UniChar +int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp int @@ -33,7 +33,7 @@ int .SH ARGUMENTS .AS char *str in/out .AP int ch in -The Tcl_UniChar to be converted. +The character to be converted. .AP char *str in/out Pointer to UTF-8 string to be converted in place. .BE diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index 2336c34..e1d23ab 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -48,19 +48,16 @@ int .SH ARGUMENTS .AS int ch .AP int ch in -The Tcl_UniChar to be examined. +The character to be examined. .BE .SH DESCRIPTION .PP -All of the routines described examine Tcl_UniChars and return a +All of the routines described examine characters and return a boolean value. A non-zero return value means that the character does belong to the character class associated with the called routine. The rest of this document just describes the character classes associated with the various routines. -.PP -Note: A Tcl_UniChar is a Unicode character represented as an unsigned, -fixed-size quantity. .SH "CHARACTER CLASSES" .PP diff --git a/doc/Utf.3 b/doc/Utf.3 index 5cd6b7df..638f349 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -77,7 +77,7 @@ int Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer. .AP int ch in -The Tcl_UniChar to be converted or examined. +The character to be converted or examined. .AP Tcl_UniChar *chPtr out Filled with the Tcl_UniChar represented by the head of the UTF-8 string. .AP "const char" *src in diff --git a/generic/tclScan.c b/generic/tclScan.c index 7f71262..e0798df 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -889,7 +889,7 @@ Tcl_ScanObjCmd( i = (int)sch; #if TCL_UTF_MAX == 4 if (!offset) { - offset = Tcl_UtfToUniChar(string, &sch); + offset = TclUtfToUniChar(string, &sch); i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); } #endif diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 1ccd778..fda6ac1 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1869,20 +1869,20 @@ Tcl_AppendFormatToObj( } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG useWide = 1; #endif } else if ((format[1] == '3') && (format[2] == '2')) { format += (step + 2); - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); } else { format += step; - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); } } else if ((ch == 't') || (ch == 'z')) { format += step; - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG if (sizeof(size_t) > sizeof(int)) { useWide = 1; @@ -1890,7 +1890,7 @@ Tcl_AppendFormatToObj( #endif } else if ((ch == 'q') ||(ch == 'j')) { format += step; - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG useWide = 1; #endif diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 859fe78..e651757 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -398,7 +398,7 @@ Tcl_UtfToUniCharDString( * appended to this previously initialized * DString. */ { - Tcl_UniChar ch, *w, *wString; + Tcl_UniChar ch = 0, *w, *wString; const char *p, *end; int oldLength; @@ -522,12 +522,12 @@ Tcl_NumUtfChars( * * Tcl_UtfFindFirst -- * - * Returns a pointer to the first occurance of the given Tcl_UniChar in + * Returns a pointer to the first occurance of the given character in * the NULL-terminated UTF-8 string. The NULL terminator is considered * part of the UTF-8 string. Equivalent to Plan 9 utfrune(). * * Results: - * As above. If the Tcl_UniChar does not exist in the given string, the + * As above. If the character does not exist in the given string, the * return value is NULL. * * Side effects: @@ -539,14 +539,21 @@ Tcl_NumUtfChars( const char * Tcl_UtfFindFirst( const char *src, /* The UTF-8 string to be searched. */ - int ch) /* The Tcl_UniChar to search for. */ + int ch) /* The character to search for. */ { - int len; + int len, fullchar; Tcl_UniChar find = 0; while (1) { len = TclUtfToUniChar(src, &find); - if (find == ch) { + fullchar = find; +#if TCL_UTF_MAX == 4 + if (!len) { + len += TclUtfToUniChar(stringPtr, &find); + fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } +#endif + if (find == fullchar) { return src; } if (*src == '\0') { @@ -578,16 +585,23 @@ Tcl_UtfFindFirst( const char * Tcl_UtfFindLast( const char *src, /* The UTF-8 string to be searched. */ - int ch) /* The Tcl_UniChar to search for. */ + int ch) /* The character to search for. */ { - int len; + int len, fullchar; Tcl_UniChar find = 0; const char *last; last = NULL; while (1) { len = TclUtfToUniChar(src, &find); - if (find == ch) { + fullchar = find; +#if TCL_UTF_MAX == 4 + if (!len) { + len += TclUtfToUniChar(stringPtr, &find); + fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; + } +#endif + if (find == fullchar) { last = src; } if (*src == '\0') { @@ -1158,7 +1172,7 @@ TclUtfCasecmp( const char *ct) /* UTF string cs is compared to. */ { while (*cs && *ct) { - Tcl_UniChar ch1, ch2; + Tcl_UniChar ch1 = 0, ch2 = 0; cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 8ebace5..21d1071 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1695,7 +1695,7 @@ TclTrimRight( */ do { - Tcl_UniChar ch2; + Tcl_UniChar ch2 = 0; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -1763,7 +1763,7 @@ TclTrimLeft( */ do { - Tcl_UniChar ch1; + Tcl_UniChar ch1 = 0; int pInc = TclUtfToUniChar(p, &ch1); const char *q = trim; int bytesLeft = numTrim; @@ -1773,7 +1773,7 @@ TclTrimLeft( */ do { - Tcl_UniChar ch2; + Tcl_UniChar ch2 = 0; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -2107,7 +2107,7 @@ Tcl_StringCaseMatch( { int p, charLen; const char *pstart = pattern; - Tcl_UniChar ch1, ch2; + Tcl_UniChar ch1 = 0, ch2 = 0; while (1) { p = *pattern; @@ -2217,7 +2217,7 @@ Tcl_StringCaseMatch( */ if (p == '[') { - Tcl_UniChar startChar, endChar; + Tcl_UniChar startChar = 0, endChar = 0; pattern++; if (UCHAR(*str) < 0x80) { @@ -2225,7 +2225,7 @@ Tcl_StringCaseMatch( (nocase ? tolower(UCHAR(*str)) : UCHAR(*str)); str++; } else { - str += Tcl_UtfToUniChar(str, &ch1); + str += TclUtfToUniChar(str, &ch1); if (nocase) { ch1 = Tcl_UniCharToLower(ch1); } @@ -2254,7 +2254,7 @@ Tcl_StringCaseMatch( ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); pattern++; } else { - pattern += Tcl_UtfToUniChar(pattern, &endChar); + pattern += TclUtfToUniChar(pattern, &endChar); if (nocase) { endChar = Tcl_UniCharToLower(endChar); } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index ed1a8e5..894f431 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1738,15 +1738,15 @@ SerialSetOptionProc( dcb.XonChar = argv[0][0]; dcb.XoffChar = argv[1][0]; if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { - Tcl_UniChar character; + Tcl_UniChar character = 0; int charLen; - charLen = Tcl_UtfToUniChar(argv[0], &character); + charLen = TclUtfToUniChar(argv[0], &character); if (argv[0][charLen]) { goto badXchar; } dcb.XonChar = (char) character; - charLen = Tcl_UtfToUniChar(argv[1], &character); + charLen = TclUtfToUniChar(argv[1], &character); if (argv[1][charLen]) { goto badXchar; } -- cgit v0.12 From c6d82079ea51d3ce14e290d139edd76ddc971794 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 17 Nov 2017 17:23:01 +0000 Subject: Added a package manifest to init to allow core distributed packages to auto-populate [package ifneeded] on startup --- library/init.tcl | 4 ++++ library/pkgIndex.tcl | 16 ++++++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 library/pkgIndex.tcl diff --git a/library/init.tcl b/library/init.tcl index 87d9f14..38d8726 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -836,3 +836,7 @@ proc tcl::CopyDirectory {action src dest} { } return } +if {[file exists [file join $::tcl_library pkgIndex.tcl]]} { + set dir $::tcl_library + source [file join $::tcl_library pkgIndex.tcl] +} diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl new file mode 100644 index 0000000..ff8d0f1 --- /dev/null +++ b/library/pkgIndex.tcl @@ -0,0 +1,16 @@ +### +# Package manifest for all Tcl packages included in the /library file system +### +foreach {package version file} { + http 2.8.12 {http http.tcl} + http 1.0 {http1.0 http.tcl} + msgcat 1.6.1 {msgcat msgcat.tcl} + opt 0.4.7 {opt optparse.tcl} + platform 1.0.14 {platform platform.tcl} + platform::shell 1.1.4 {platform shell.tcl} + tcltest 2.4.1 {tcltest tcltest.tcl} +} { + package ifneeded $package $version [list source [file join $dir {*}$file]] +} +# Opt is the odd man out +package ifneeded opt 0.4.7 [list source [file join $dir opt optparse.tcl]] -- cgit v0.12 From b59255450b97c1cc7fe5223937c86c805aa89eb8 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 18 Nov 2017 11:48:08 +0000 Subject: Added a pool of literal strings to zipfs to manage constants that are being belched out by the file system. Created a separate mount point for Unix and Windows, with a new "zipfs root" command to tell the user which location to use for their platform --- generic/tclZipfs.c | 92 ++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 76 insertions(+), 16 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 8eae35a..4a72392 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -28,12 +28,21 @@ #include "zlib.h" #include "crypt.h" +/* +** On windows we need VFS to look like a volume +** On Unix we need it to look like a UNC path +*/ +#if defined(_WIN32) || defined(_WIN64) +#define ZIPFS_VOLUME "zipfs:/" +#define ZIPFS_VOLUME_LEN 7 +#define ZIPFS_APP_MOUNT "zipfs:/app" +#define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" +#else #define ZIPFS_VOLUME "//zipfs:/" +#define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT "//zipfs:/app" #define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" - -#define ZIPFS_VOLUME_LEN 9 - +#endif /* * Various constants and offsets found in ZIP archive files */ @@ -292,6 +301,11 @@ static const unsigned long crc32tab[256] = { 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, 0x2d02ef8d, }; + +static Tcl_Obj *zipfs_literal_fstype=NULL; +static Tcl_Obj *zipfs_literal_fsroot=NULL; +static Tcl_Obj *zipfs_literal_fsseparator=NULL; + /* *------------------------------------------------------------------------- @@ -1412,6 +1426,35 @@ ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, /* *------------------------------------------------------------------------- * + * ZipFSRootObjCmd -- + * + * This procedure is invoked to process the "zipfs::root" command. It + * returns the root that all zipfs file systems are mounted under. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSRootObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + if(!zipfs_literal_fsroot) { + zipfs_literal_fsroot=Tcl_NewStringObj(ZIPFS_VOLUME, -1); + Tcl_IncrRefCount(zipfs_literal_fsroot); + } + Tcl_IncrRefCount(zipfs_literal_fsroot); + Tcl_SetObjResult(interp,zipfs_literal_fsroot); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * * ZipFSUnmountObjCmd -- * * This procedure is invoked to process the "zipfs::unmount" command. @@ -3178,7 +3221,12 @@ Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) static Tcl_Obj * Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) { - return Tcl_NewStringObj("/", -1); + if(!zipfs_literal_fsseparator) { + zipfs_literal_fsseparator=Tcl_NewStringObj("/", -1); + Tcl_IncrRefCount(zipfs_literal_fsseparator); + } + Tcl_IncrRefCount(zipfs_literal_fsseparator); + return zipfs_literal_fsseparator; } /* @@ -3439,7 +3487,12 @@ endloop: */ static Tcl_Obj * Zip_FSListVolumesProc(void) { - return Tcl_NewStringObj(ZIPFS_VOLUME, -1); + if(!zipfs_literal_fsroot) { + zipfs_literal_fsroot=Tcl_NewStringObj(ZIPFS_VOLUME, -1); + Tcl_IncrRefCount(zipfs_literal_fsroot); + } + Tcl_IncrRefCount(zipfs_literal_fsroot); + return zipfs_literal_fsroot; } /* @@ -3586,7 +3639,12 @@ Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, static Tcl_Obj * Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) { - return Tcl_NewStringObj("zip", -1); + if(!zipfs_literal_fstype) { + zipfs_literal_fstype=Tcl_NewStringObj("zip", -1); + Tcl_IncrRefCount(zipfs_literal_fstype); + } + Tcl_IncrRefCount(zipfs_literal_fstype); + return zipfs_literal_fstype; } @@ -3788,17 +3846,19 @@ TclZipfs_Init(Tcl_Interp *interp) Unlock(); if(interp != NULL) { static const EnsembleImplMap initMap[] = { - {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, - {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, - {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, - {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, - {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, - {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, - {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, - {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, - {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, - {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, + {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, + {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, + {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, + {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, + {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, + {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, + {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, + {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, + {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, + {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1}, + {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 1}, + {NULL, NULL, NULL, NULL, NULL, 0} }; static const char findproc[] = -- cgit v0.12 From 02a019458f248912f3eaffedd11359545eb79abb Mon Sep 17 00:00:00 2001 From: tne Date: Sat, 18 Nov 2017 11:59:20 +0000 Subject: Updated zipfs tests to recognize the mount points are different on different platforms --- tests/zipfs.test | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 97dc463..9284404 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -22,16 +22,18 @@ testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [i # load {} zipfs #} -result {} +set ziproot [zipfs root] + test zipfs-0.1 {zipfs basics} -constraints zipfs -body { package require zipfs -} -result {1.0} +} -result {2.0} test zipfs-0.1 {zipfs basics} -constraints zipfs -body { - expr {"//zipfs:/" in [file volumes]} + expr {${ziproot} in [file volumes]} } -result 1 test zipfs-0.2 {zipfs basics} -constraints zipfs -body { - string match //zipfs:/* $tcl_library + string match ${ziproot}* $tcl_library } -result 1 test zipfs-0.3 {zipfs basics: glob} -constraints zipfs -body { @@ -111,18 +113,18 @@ test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { set pwd [pwd] cd $tcl_library/encoding zipfs mkzip /tmp/abc.zip . - zipfs mount /tmp/abc.zip //zipfs:/abc ;# FIXME: test independence - zipfs list -glob //zipfs:/abc/cp850.* + zipfs mount /tmp/abc.zip /abc ;# FIXME: test independence + zipfs list -glob ${ziproot}/abc/cp850.* } -cleanup { cd $pwd -} -result {//zipfs:/abc/cp850.enc} +} -result {[zipfs root]/abc/cp850.enc} test zipfs-2.3 {zipfs info} -constraints zipfs -body { - zipfs info //zipfs:/abc/cp850.enc + zipfs info ${ziproot}/abc/cp850.enc } -result [list /tmp/abc.zip 1090 527 39318] ;# FIXME: result depends on content of encodings dir test zipfs-2.4 {zipfs data} -constraints zipfs -body { - set zipfd [open //zipfs:/abc/cp850.enc] ;# FIXME: leave open - see later test + set zipfd [open ${ziproot}/abc/cp850.enc] ;# FIXME: leave open - see later test read $zipfd } -result {# Encoding file: cp850, single-byte S -- cgit v0.12 From b171f5cc41b72d1f0b313a6b720394c25bd8d310 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 18 Nov 2017 12:21:35 +0000 Subject: Added documentation for the zipfs root command and working of TclZipfs_AppHook --- doc/zipfs.3 | 22 +++++++++++++++++++++- doc/zipfs.n | 10 ++++++++-- 2 files changed, 29 insertions(+), 3 deletions(-) diff --git a/doc/zipfs.3 b/doc/zipfs.3 index a3b3da8..b23afae 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -10,16 +10,24 @@ .so man.macros .BS .SH NAME -Tclzipfs_Mount, Tclzipfs_Unmount \- handle ZIP files as VFS +TclZipfs_AppHook, Tclzipfs_Mount, Tclzipfs_Unmount, \- handle ZIP files as VFS .SH SYNOPSIS .nf .sp int +\fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR) +.sp +int \fBTclzipfs_Mount\fR(\fIinterp, zipname, mntpt, passwd\fR) .sp int \fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR) .SH ARGUMENTS +.AP "int" *argc in +Number of command line arguments from main() +.AP "char" ***argv in +Pointer to an array of strings containing the command +line arguments to main() .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in Interpreter in which the zip file system is mounted. The interpreter's result is @@ -32,6 +40,18 @@ Name of a mount point. An (optional) password. .BE .SH DESCRIPTION +\fBTclZipfs_AppHook()\fR is a utility function to perform standard +application initialization procedures. If the current application has +a mountable zip file system, that file system is mounted under \fIZIPROOT\fR\fB/app\fR. +If a file named \fBmain.tcl\fR is located in that file system, it is treated +as the startup script for the process. If the file \fIZIPROOT\fR\fB/app/tcl_library/init.tcl\fR +is present, \fBtcl_library\fR is set to \fIZIPROOT\fR\fB/app/tcl_library. +.PP +If the \fBtcl_library\fR was not found in the application, the system will then search for it +as either a VFS attached to the application dynamic library, or as a zip archive named +libtcl_\fIMAJOR\fR_\fIMINOR\fR_\fIpatchLevel\fR.zip either in the present working directory +or in the standard tcl install location. +.PP \fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR. Errors during that process are reported in the interpreter \fIinterp\fR. diff --git a/doc/zipfs.n b/doc/zipfs.n index f82100f..a026b6d 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -24,6 +24,7 @@ zipfs \- Mount and work with ZIP files within Tcl \fBzipfs mkkey\fR \fIpassword\fR \fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fBzipfs mount\fR \fI?zipfile?\fR \fI?mountpoint?\fR \fI?password?\fR +\fBzipfs root\fR \fBzipfs unmount\fR \fIzipfile\fR .fi .BE @@ -41,7 +42,7 @@ Return 1 if the given filename exists in the mounted zipfs and 0 if it does not. Recursively lists files including and below the directory \fIdir\fR. The result list consists of relative path names starting from the given directory. This command is also used by the \fBzipfs mkzip\fR -and \fBzipfs mkimg\fR commands. +and \fBzipfs mkimg\fR commands. .TP \fBzipfs info\fR \fIfile\fR . @@ -92,7 +93,7 @@ of the respective file name. .PP Caution: the choice of the \fIindir\fR parameter (less the optional stripped prefix) determines the later root name of the -archive's content. +archive's content. .RE .TP \fBzipfs mount ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR? @@ -107,6 +108,11 @@ With no \fIzipfile\fR, return all zipfile/mount pairs. If \fImountpoint\fR is specified as an empty string, mount on file path. .RE .TP +\fBzipfs root\fR +Returns a constant string which indicates the mount point for zipfs volumes +for the current platform. On Windows, this value is zipfs:/. On Unux, //zipfs:/ +.RE +.TP \fBzipfs unmount \fIzipfile\fR . Unmounts a previously mounted ZIP archive file \fIzipfile\fR. -- cgit v0.12 From 3730061388d459b86b5b62d877d786e1ddfee7ff Mon Sep 17 00:00:00 2001 From: aspect Date: Sat, 18 Nov 2017 17:02:08 +0000 Subject: fix zipfs tests --- tests/zipfs.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 9284404..ce287da 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -113,14 +113,14 @@ test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { set pwd [pwd] cd $tcl_library/encoding zipfs mkzip /tmp/abc.zip . - zipfs mount /tmp/abc.zip /abc ;# FIXME: test independence - zipfs list -glob ${ziproot}/abc/cp850.* + zipfs mount /tmp/abc.zip ${ziproot}abc ;# FIXME: test independence + zipfs list -glob ${ziproot}abc/cp850.* } -cleanup { cd $pwd -} -result {[zipfs root]/abc/cp850.enc} +} -result "[zipfs root]abc/cp850.enc" test zipfs-2.3 {zipfs info} -constraints zipfs -body { - zipfs info ${ziproot}/abc/cp850.enc + zipfs info ${ziproot}abc/cp850.enc } -result [list /tmp/abc.zip 1090 527 39318] ;# FIXME: result depends on content of encodings dir test zipfs-2.4 {zipfs data} -constraints zipfs -body { -- cgit v0.12 From d8a0c08bbc357c4f126c8852692c0fd6d9d2688a Mon Sep 17 00:00:00 2001 From: aspect Date: Sat, 18 Nov 2017 17:04:03 +0000 Subject: add some tests for join and normalize --- tests/zipfs.test | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/zipfs.test b/tests/zipfs.test index ce287da..abf888b 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -72,6 +72,17 @@ test zipfs-0.9 {zipfs basics: glob} -constraints zipfs -body { lsort [glob -nocomplain -tails -types f -dir $tcl_library http*] } -result {} +test zipfs-0.10 {zipfs basics: join} -constraints zipfs -body { + file join [zipfs root] bar baz +} -result "[zipfs root]bar/baz" + +test zipfs-0.11 {zipfs basics: join} -constraints zipfs -body { + file normalize [zipfs root] +} -result "[zipfs root]" + +test zipfs-0.12 {zipfs basics: join} -constraints zipfs -body { + file normalize [zipfs root]//bar/baz//qux/../ +} -result "[zipfs root]bar/baz" test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mount a b c d e f -- cgit v0.12 From 157e55c7bc831fdf3cb6d68917ac6c7222442166 Mon Sep 17 00:00:00 2001 From: aspect Date: Sat, 18 Nov 2017 17:07:48 +0000 Subject: Reserve paths matching //[^/]*: for VFS mount points, and prevent calling native filesystem ops during normalization for them. This is permitted by UNC standards (which do not allow : at the end), and should prevent observed slow [glob] operations (and others) on Windows when using such paths. --- generic/tclIOUtil.c | 59 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 45 insertions(+), 14 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 4f2288e..bca74fa 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1400,31 +1400,62 @@ TclFSNormalizeToUniquePath( { FilesystemRecord *fsRecPtr, *firstFsRecPtr; + int i; + int isVfsPath = 0; + char *path; + /* - * Call each of the "normalise path" functions in succession. This is a - * special case, in which if we have a native filesystem handler, we call - * it first. This is because the root of Tcl's filesystem is always a - * native filesystem (i.e., '/' on unix is native). + * Paths starting with a UNC prefix whose final character is a colon + * are reserved for VFS use. These names can not conflict with real + * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx + * and rfc3986's definition of reg-name. + * + * We check these first to avoid useless calls to the native filesystem's + * normalizePathProc. */ + path = Tcl_GetStringFromObj(pathPtr, &i); + + if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/') + || (path[0] == '\\' && path[1] == '\\') ) ) { + for ( i = 2; ; i++) { + if (path[i] == '\0') break; + if (path[i] == path[0]) break; + } + --i; + if (path[i] == ':') isVfsPath = 1; + } + /* + * Call each of the "normalise path" functions in succession. + */ firstFsRecPtr = FsGetFirstFilesystem(); Claim(); - for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { - if (fsRecPtr->fsPtr != &tclNativeFilesystem) { - continue; - } + + if (!isVfsPath) { /* - * TODO: Assume that we always find the native file system; it should - * always be there... + * If we have a native filesystem handler, we call it first. This is + * because the root of Tcl's filesystem is always a native filesystem + * (i.e., '/' on unix is native). */ - if (fsRecPtr->fsPtr->normalizePathProc != NULL) { - startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, - startAt); + for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { + if (fsRecPtr->fsPtr != &tclNativeFilesystem) { + continue; + } + + /* + * TODO: Assume that we always find the native file system; it should + * always be there... + */ + + if (fsRecPtr->fsPtr->normalizePathProc != NULL) { + startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, + startAt); + } + break; } - break; } for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { -- cgit v0.12 From 30938251a229de790732bbffff59a1de806d083d Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 18 Nov 2017 20:21:13 +0000 Subject: Adjust the rule to look for libtcl_XXX.zip ONLY in the directory that contains the executable or the install location for tcl. The directory adjacent copy is only looked for and mounted in an install location version cannot be located. --- generic/tclZipfs.c | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 4a72392..80d153b 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3928,6 +3928,11 @@ int TclZipfs_AppHook(int *argc, char ***argv){ Tcl_FindExecutable(*argv[0]); archive=Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); + /* + ** Look for init.tcl in one of the locations mounted later in this function + ** and failing that, look for a file name CFG_RUNTIME_ZIPFILE adjacent to the + ** executable + */ TclSetPreInitScript( "foreach {path} {\n" " {" ZIPFS_APP_MOUNT "/tcl_library}\n" @@ -3937,6 +3942,17 @@ int TclZipfs_AppHook(int *argc, char ***argv){ " set ::tcl_library $path\n" " break\n" "}\n" +"if {![info exists ::tcl_library] || $::tcl_library eq {}} {\n" +" set zipfile [file join [file dirname [info nameofexecutable]] " CFG_RUNTIME_ZIPFILE "]\n" +" if {[file exists $zipfile]} {\n" +" zipfs mount $zipfile {" ZIPFS_ZIP_MOUNT "}\n" +" if {[file exists [file join {" ZIPFS_ZIP_MOUNT "} init.tcl]]} \{\n" +" set ::tcl_library {" ZIPFS_ZIP_MOUNT "}\n" +" } else {\n" +" zipfs unmount {" ZIPFS_ZIP_MOUNT "}\n" +" }\n" +" }\n" +"}\n" "foreach {path} {\n" " {" ZIPFS_APP_MOUNT "/tk_library}\n" " {" ZIPFS_ZIP_MOUNT "/tk_library}\n" @@ -3968,15 +3984,12 @@ int TclZipfs_AppHook(int *argc, char ***argv){ } } /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_ZIPFILE)==TCL_OK) { + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { return TCL_OK; } if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return TCL_OK; } - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { - return TCL_OK; - } return TCL_OK; } -- cgit v0.12 From 1d444f56103f94c966ce2541224daf28a519421a Mon Sep 17 00:00:00 2001 From: tne Date: Sat, 18 Nov 2017 20:25:25 +0000 Subject: Now that UNC paths work correctly on Windows, removing the platform specific zipfs mount point for windows --- generic/tclZipfs.c | 7 ------- 1 file changed, 7 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 80d153b..af19224 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -32,17 +32,10 @@ ** On windows we need VFS to look like a volume ** On Unix we need it to look like a UNC path */ -#if defined(_WIN32) || defined(_WIN64) -#define ZIPFS_VOLUME "zipfs:/" -#define ZIPFS_VOLUME_LEN 7 -#define ZIPFS_APP_MOUNT "zipfs:/app" -#define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" -#else #define ZIPFS_VOLUME "//zipfs:/" #define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT "//zipfs:/app" #define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" -#endif /* * Various constants and offsets found in ZIP archive files */ -- cgit v0.12 From 280b6aa62e68db8d71bc519af2d89d05c745cfcc Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sun, 19 Nov 2017 18:16:43 +0000 Subject: Added handling to allow Tclsh to intercept a zip file fed as the first command line argument, and open it as a kit --- generic/tclZipfs.c | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index af19224..689a648 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3975,6 +3975,29 @@ int TclZipfs_AppHook(int *argc, char ***argv){ if(found==TCL_OK) { return TCL_OK; } + } else if (*argc>1) { + archive=(*argv)[1]; + fflush(stdout); + if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { + int found; + Tcl_Obj *vfsinitscript; + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } else { + Tcl_DecrRefCount(vfsinitscript); + } + /* Set Tcl Encodings */ + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); + if(found==TCL_OK) { + return TCL_OK; + } + } } /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { -- cgit v0.12 From c2eeda3f09a8b05e10e5f8f968fc28bb2dcf3750 Mon Sep 17 00:00:00 2001 From: pspjuth Date: Sun, 19 Nov 2017 18:40:13 +0000 Subject: Changed math functions min and max to C implementations. --- generic/tclBasic.c | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclExecute.c | 2 -- generic/tclInt.h | 2 ++ library/init.tcl | 37 ---------------------------- tests/expr-old.test | 20 ++++++++++++--- 5 files changed, 87 insertions(+), 43 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index acdcf41..eefb102 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -118,6 +118,8 @@ static Tcl_ObjCmdProc ExprEntierFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; +static Tcl_ObjCmdProc ExprMaxFunc; +static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; @@ -321,6 +323,8 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "isqrt", ExprIsqrtFunc, NULL }, { "log", ExprUnaryFunc, (ClientData) log }, { "log10", ExprUnaryFunc, (ClientData) log10 }, + { "max", ExprMaxFunc, NULL }, + { "min", ExprMinFunc, NULL }, { "pow", ExprBinaryFunc, (ClientData) pow }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, @@ -7677,6 +7681,71 @@ ExprWideFunc( return TCL_OK; } +/* + * Common implmentation of max() and min(). + */ +static int +ExprMaxMinFunc( + ClientData clientData, /* Ignored. */ + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count. */ + Tcl_Obj *const *objv, /* Actual parameter vector. */ + int op) /* Comparison direction */ +{ + Tcl_Obj *res; + double d; + int type, i; + ClientData ptr; + + if (objc < 2) { + MathFuncWrongNumArgs(interp, 2, objc, objv); + return TCL_ERROR; + } + res = objv[1]; + for (i = 1; i < objc; i++) { + if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } + } + + Tcl_SetObjResult(interp, res); + return TCL_OK; +} + +static int +ExprMaxFunc( + ClientData clientData, /* Ignored. */ + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count. */ + Tcl_Obj *const *objv) /* Actual parameter vector. */ +{ + return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT); +} + +static int +ExprMinFunc( + ClientData clientData, /* Ignored. */ + Tcl_Interp *interp, /* The interpreter in which to execute the + * function. */ + int objc, /* Actual parameter count. */ + Tcl_Obj *const *objv) /* Actual parameter vector. */ +{ + return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT); +} + static int ExprRandFunc( ClientData clientData, /* Ignored. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 761a23e..c4aa381 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -744,8 +744,6 @@ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void DeleteExecStack(ExecStack *esPtr); static void DupExprCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, - Tcl_Obj *value2Ptr); static Tcl_Obj * ExecuteExtendedBinaryMathOp(Tcl_Interp *interp, int opcode, Tcl_Obj **constants, Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); diff --git a/generic/tclInt.h b/generic/tclInt.h index 91c8b96..64c60e4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2878,6 +2878,8 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; +MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, + Tcl_Obj *value2Ptr); MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num, int *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, diff --git a/library/init.tcl b/library/init.tcl index c31eea3..d5beb69 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -73,43 +73,6 @@ namespace eval tcl { encoding dirs $Path } } - - # TIP #255 min and max functions - namespace eval mathfunc { - proc min {args} { - if {![llength $args]} { - return -code error \ - "too few arguments to math function \"min\"" - } - set val Inf - foreach arg $args { - # This will handle forcing the numeric value without - # ruining the internal type of a numeric object - if {[catch {expr {double($arg)}} err]} { - return -code error $err - } - if {$arg < $val} {set val $arg} - } - return $val - } - proc max {args} { - if {![llength $args]} { - return -code error \ - "too few arguments to math function \"max\"" - } - set val -Inf - foreach arg $args { - # This will handle forcing the numeric value without - # ruining the internal type of a numeric object - if {[catch {expr {double($arg)}} err]} { - return -code error $err - } - if {$arg > $val} {set val $arg} - } - return $val - } - namespace export min max - } } # Windows specific end of initialization diff --git a/tests/expr-old.test b/tests/expr-old.test index 06a00ba..262a71b 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -1159,8 +1159,8 @@ test expr-old-40.2 {min math function} -body { expr {min(0.0)} } -result 0.0 test expr-old-40.3 {min math function} -body { - list [catch {expr {min()}} msg] $msg -} -result {1 {too few arguments to math function "min"}} + expr {min()} +} -returnCodes error -result {too few arguments for math function "min"} test expr-old-40.4 {min math function} -body { expr {min(wide(-1) << 30, 4.5, -10)} } -result [expr {wide(-1) << 30}] @@ -1170,6 +1170,12 @@ test expr-old-40.5 {min math function} -body { test expr-old-40.6 {min math function} -body { expr {min(300, "0xFF")} } -result 255 +test expr-old-40.7 {min math function} -body { + expr min(1[string repeat 0 10000], 1e300) +} -result 1e+300 +test expr-old-40.8 {min math function} -body { + expr {min(0, "a")} +} -returnCodes error -match glob -result * test expr-old-41.1 {max math function} -body { expr {max(0)} @@ -1178,8 +1184,8 @@ test expr-old-41.2 {max math function} -body { expr {max(0.0)} } -result 0.0 test expr-old-41.3 {max math function} -body { - list [catch {expr {max()}} msg] $msg -} -result {1 {too few arguments to math function "max"}} + expr {max()} +} -returnCodes error -result {too few arguments for math function "max"} test expr-old-41.4 {max math function} -body { expr {max(wide(1) << 30, 4.5, -10)} } -result [expr {wide(1) << 30}] @@ -1189,6 +1195,12 @@ test expr-old-41.5 {max math function} -body { test expr-old-41.6 {max math function} -body { expr {max(200, "0xFF")} } -result 255 +test expr-old-41.7 {max math function} -body { + expr max(1[string repeat 0 10000], 1e300) +} -result 1[string repeat 0 10000] +test expr-old-41.8 {max math function} -body { + expr {max(0, "a")} +} -returnCodes error -match glob -result * # Special test for Pentium arithmetic bug of 1994: -- cgit v0.12 From b946ce971fbde11b9739fc0b77237ed382e24bd0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2017 08:58:39 +0000 Subject: Fix [e058307eef73cf21cf6805ad7c778e1024f9eb7d|e058307eef]: Use of values.h breaks build of Tk trunk on macOS --- unix/configure | 10 ---------- unix/tcl.m4 | 2 -- unix/tclConfig.h.in | 3 --- unix/tclUnixPort.h | 3 --- 4 files changed, 18 deletions(-) diff --git a/unix/configure b/unix/configure index 51d694f..90116c8 100755 --- a/unix/configure +++ b/unix/configure @@ -3733,16 +3733,6 @@ $as_echo "#define NO_DIRENT_H 1" >>confdefs.h fi - ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default" -if test "x$ac_cv_header_values_h" = xyes; then : - -else - -$as_echo "#define NO_VALUES_H 1" >>confdefs.h - -fi - - ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" if test "x$ac_cv_header_stdlib_h" = xyes; then : tcl_ok=1 diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 9aa3eb2..51459c9 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2040,7 +2040,6 @@ dnl # preprocessing tests use only CPPFLAGS. # # Defines some of the following vars: # NO_DIRENT_H -# NO_VALUES_H # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H @@ -2078,7 +2077,6 @@ closedir(d); AC_DEFINE(NO_DIRENT_H, 1, [Do we have ?]) fi - AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have ?])]) AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 28ce012..4902083 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -331,9 +331,6 @@ /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT -/* Do we have ? */ -#undef NO_VALUES_H - /* Do we have wait3() */ #undef NO_WAIT3 diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 8b766d6..d464f05 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -182,9 +182,6 @@ extern int TclUnixSetBlockingMode(int fd, int mode); */ #include -#ifndef NO_VALUES_H -# include -#endif #ifndef FLT_MAX # ifdef MAXFLOAT -- cgit v0.12 From bc3e198cba9e40c015a6acfa992c69434274dde6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2017 10:15:59 +0000 Subject: Fix error-message for min/math functions: "to" -> "for", for consistancy with the error-messages for other math functions. --- library/init.tcl | 4 ++-- tests/expr-old.test | 20 ++++++++++++++++---- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index 87d9f14..13a4300 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -79,7 +79,7 @@ namespace eval tcl { proc min {args} { if {![llength $args]} { return -code error \ - "too few arguments to math function \"min\"" + "too few arguments for math function \"min\"" } set val Inf foreach arg $args { @@ -95,7 +95,7 @@ namespace eval tcl { proc max {args} { if {![llength $args]} { return -code error \ - "too few arguments to math function \"max\"" + "too few arguments for math function \"max\"" } set val -Inf foreach arg $args { diff --git a/tests/expr-old.test b/tests/expr-old.test index 3adfb63..8c159b2 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -1159,8 +1159,8 @@ test expr-old-40.2 {min math function} -body { expr {min(0.0)} } -result 0.0 test expr-old-40.3 {min math function} -body { - list [catch {expr {min()}} msg] $msg -} -result {1 {too few arguments to math function "min"}} + expr {min()} +} -returnCodes error -result {too few arguments for math function "min"} test expr-old-40.4 {min math function} -body { expr {min(wide(-1) << 30, 4.5, -10)} } -result [expr {wide(-1) << 30}] @@ -1170,6 +1170,12 @@ test expr-old-40.5 {min math function} -body { test expr-old-40.6 {min math function} -body { expr {min(300, "0xFF")} } -result 255 +test expr-old-40.7 {min math function} -body { + expr min(1[string repeat 0 10000], 1e300) +} -result 1e+300 +test expr-old-40.8 {min math function} -body { + expr {min(0, "a")} +} -returnCodes error -match glob -result * test expr-old-41.1 {max math function} -body { expr {max(0)} @@ -1178,8 +1184,8 @@ test expr-old-41.2 {max math function} -body { expr {max(0.0)} } -result 0.0 test expr-old-41.3 {max math function} -body { - list [catch {expr {max()}} msg] $msg -} -result {1 {too few arguments to math function "max"}} + expr {max()} +} -returnCodes error -result {too few arguments for math function "max"} test expr-old-41.4 {max math function} -body { expr {max(wide(1) << 30, 4.5, -10)} } -result [expr {wide(1) << 30}] @@ -1189,6 +1195,12 @@ test expr-old-41.5 {max math function} -body { test expr-old-41.6 {max math function} -body { expr {max(200, "0xFF")} } -result 255 +test expr-old-41.7 {max math function} -body { + expr max(1[string repeat 0 10000], 1e300) +} -result 1[string repeat 0 10000] +test expr-old-41.8 {max math function} -body { + expr {max(0, "a")} +} -returnCodes error -match glob -result * # Special test for Pentium arithmetic bug of 1994: -- cgit v0.12 From a1bc5b8a2b3fbc46b0207124137c9b2a5a8cced1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2017 12:07:08 +0000 Subject: If Tcl is compiled with -DTCL_NO_DEPRECATED, remove a lot of (internal) stub entries which correspond to functions which will be removed in Tcl 9. This commit should have been part of [7849f573c0e7d758|this] earlier commit. No effect when Tcl is not compiled with -DTCL_NO_DEPRECATED. --- generic/tclIO.c | 2 + generic/tclInt.decls | 28 +++---- generic/tclIntDecls.h | 200 +++++++++++++++++++------------------------------- generic/tclStubInit.c | 67 ++++++++++++----- unix/tclUnixThrd.c | 2 + 5 files changed, 143 insertions(+), 156 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index df04794..81fd298 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9032,6 +9032,7 @@ ZeroTransferTimerProc( *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) int TclCopyChannelOld( Tcl_Interp *interp, /* Current interpreter. */ @@ -9043,6 +9044,7 @@ TclCopyChannelOld( return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, cmdPtr); } +#endif int TclCopyChannel( diff --git a/generic/tclInt.decls b/generic/tclInt.decls index b683a29..33bf0b3 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -453,26 +453,26 @@ declare 111 { Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 112 { - int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr) } declare 113 { - Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, + Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 114 { - void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) + void TclDeleteNamespace(Tcl_Namespace *nsPtr) } declare 115 { - int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst) } declare 116 { - Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, + Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 117 { - Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, + Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 118 { @@ -488,28 +488,28 @@ declare 120 { Tcl_Namespace *contextNsPtr, int flags) } declare 121 { - int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern) } declare 122 { - Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) + Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 123 { - void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, + void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr) } declare 124 { - Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) + Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp) } declare 125 { - Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) + Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp) } declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } declare 127 { - int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite) } declare 128 { @@ -724,10 +724,10 @@ declare 177 { const char *operation, const char *reason) } declare 178 { - void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) + void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) } declare 179 { - Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) + Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr) } # REMOVED diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 4244362..22b8072 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -28,22 +28,6 @@ # endif #endif -/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */ -#undef Tcl_CreateNamespace -#undef Tcl_DeleteNamespace -#undef Tcl_AppendExportList -#undef Tcl_Export -#undef Tcl_Import -#undef Tcl_ForgetImport -#undef Tcl_GetCurrentNamespace -#undef Tcl_GetGlobalNamespace -#undef Tcl_FindNamespace -#undef Tcl_FindCommand -#undef Tcl_GetCommandFromObj -#undef Tcl_GetCommandFullName -#undef Tcl_SetStartupScript -#undef Tcl_GetStartupScript - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -287,22 +271,22 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 112 */ -EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, +EXTERN int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 113 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, +EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 114 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); +EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr); /* 115 */ -EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 116 */ -EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, +EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 118 */ @@ -317,23 +301,23 @@ EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 121 */ -EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, +EXTERN int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 122 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, +EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 123 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, +EXTERN void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 124 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); +EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp); /* 125 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp); /* 126 */ EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 127 */ -EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 128 */ EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); @@ -465,10 +449,10 @@ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 178 */ -EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr, +EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName); /* 179 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); +EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr); /* Slot 180 is reserved */ /* Slot 181 is reserved */ /* 182 */ @@ -767,22 +751,22 @@ typedef struct TclIntStubs { int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ 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 */ - void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ - int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ - Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ - Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ + int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ + Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ + void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ + int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ + Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ + Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ - int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ - Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ - void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ - Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */ - Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */ + int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ + Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ + void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ + Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */ + Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */ void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ - int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ + int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ @@ -833,8 +817,8 @@ typedef struct TclIntStubs { int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ - Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ + void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ + Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */ void (*reserved180)(void); void (*reserved181)(void); TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ @@ -1099,38 +1083,38 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ -#define Tcl_AppendExportList \ - (tclIntStubsPtr->tcl_AppendExportList) /* 112 */ -#define Tcl_CreateNamespace \ - (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */ -#define Tcl_DeleteNamespace \ - (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */ -#define Tcl_Export \ - (tclIntStubsPtr->tcl_Export) /* 115 */ -#define Tcl_FindCommand \ - (tclIntStubsPtr->tcl_FindCommand) /* 116 */ -#define Tcl_FindNamespace \ - (tclIntStubsPtr->tcl_FindNamespace) /* 117 */ +#define TclAppendExportList \ + (tclIntStubsPtr->tclAppendExportList) /* 112 */ +#define TclCreateNamespace \ + (tclIntStubsPtr->tclCreateNamespace) /* 113 */ +#define TclDeleteNamespace \ + (tclIntStubsPtr->tclDeleteNamespace) /* 114 */ +#define TclExport \ + (tclIntStubsPtr->tclExport) /* 115 */ +#define TclFindCommand \ + (tclIntStubsPtr->tclFindCommand) /* 116 */ +#define TclFindNamespace \ + (tclIntStubsPtr->tclFindNamespace) /* 117 */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ -#define Tcl_ForgetImport \ - (tclIntStubsPtr->tcl_ForgetImport) /* 121 */ -#define Tcl_GetCommandFromObj \ - (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */ -#define Tcl_GetCommandFullName \ - (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */ -#define Tcl_GetCurrentNamespace \ - (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */ -#define Tcl_GetGlobalNamespace \ - (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */ +#define TclForgetImport \ + (tclIntStubsPtr->tclForgetImport) /* 121 */ +#define TclGetCommandFromObj \ + (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */ +#define TclGetCommandFullName \ + (tclIntStubsPtr->tclGetCommandFullName) /* 123 */ +#define TclGetCurrentNamespace_ \ + (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */ +#define TclGetGlobalNamespace_ \ + (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ -#define Tcl_Import \ - (tclIntStubsPtr->tcl_Import) /* 127 */ +#define TclImport \ + (tclIntStubsPtr->tclImport) /* 127 */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ @@ -1221,10 +1205,10 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -#define Tcl_SetStartupScript \ - (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */ -#define Tcl_GetStartupScript \ - (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ +#define TclSetStartupScript \ + (tclIntStubsPtr->tclSetStartupScript) /* 178 */ +#define TclGetStartupScript \ + (tclIntStubsPtr->tclGetStartupScript) /* 179 */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ #define TclpLocaltime \ @@ -1361,58 +1345,28 @@ extern const TclIntStubs *tclIntStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclGetStartupScriptFileName -#undef TclSetStartupScriptFileName -#undef TclGetStartupScriptPath -#undef TclSetStartupScriptPath -#undef TclBackgroundException - #if defined(USE_TCL_STUBS) -# undef Tcl_SetStartupScript -# define Tcl_SetStartupScript \ - (tclStubsPtr->tcl_SetStartupScript) /* 622 */ -# undef Tcl_GetStartupScript -# define Tcl_GetStartupScript \ - (tclStubsPtr->tcl_GetStartupScript) /* 623 */ -# undef Tcl_CreateNamespace -# define Tcl_CreateNamespace \ - (tclStubsPtr->tcl_CreateNamespace) /* 506 */ -# undef Tcl_DeleteNamespace -# define Tcl_DeleteNamespace \ - (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ -# undef Tcl_AppendExportList -# define Tcl_AppendExportList \ - (tclStubsPtr->tcl_AppendExportList) /* 508 */ -# undef Tcl_Export -# define Tcl_Export \ - (tclStubsPtr->tcl_Export) /* 509 */ -# undef Tcl_Import -# define Tcl_Import \ - (tclStubsPtr->tcl_Import) /* 510 */ -# undef Tcl_ForgetImport -# define Tcl_ForgetImport \ - (tclStubsPtr->tcl_ForgetImport) /* 511 */ -# undef Tcl_GetCurrentNamespace -# define Tcl_GetCurrentNamespace \ - (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ -# undef Tcl_GetGlobalNamespace -# define Tcl_GetGlobalNamespace \ - (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ -# undef Tcl_FindNamespace -# define Tcl_FindNamespace \ - (tclStubsPtr->tcl_FindNamespace) /* 514 */ -# undef Tcl_FindCommand -# define Tcl_FindCommand \ - (tclStubsPtr->tcl_FindCommand) /* 515 */ -# undef Tcl_GetCommandFromObj -# define Tcl_GetCommandFromObj \ - (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ -# undef Tcl_GetCommandFullName -# define Tcl_GetCommandFullName \ - (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ +# undef TclGetStartupScriptFileName +# undef TclSetStartupScriptFileName +# undef TclGetStartupScriptPath +# undef TclSetStartupScriptPath +# undef TclBackgroundException +# undef TclSetStartupScript +# undef TclGetStartupScript +# undef TclCreateNamespace +# undef TclDeleteNamespace +# undef TclAppendExportList +# undef TclExport +# undef TclImport +# undef TclForgetImport +# undef TclGetCurrentNamespace_ +# undef TclGetGlobalNamespace_ +# undef TclFindNamespace +# undef TclFindCommand +# undef TclGetCommandFromObj +# undef TclGetCommandFullName +# undef TclCopyChannelOld +# undef TclSockMinimumBuffersOld #endif -#undef TclCopyChannelOld -#undef TclSockMinimumBuffersOld - #endif /* _TCLINTDECLS */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 24b28e5..d2de021 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,11 +72,6 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclBNInitBignumFromWideUInt 0 # define TclBNInitBignumFromWideInt 0 # define TclBNInitBignumFromLong 0 -# define Tcl_AppendResultVA 0 -# define Tcl_AppendStringsToObjVA 0 -# define Tcl_SetErrorCodeVA 0 -# define Tcl_PanicVA 0 -# define Tcl_VarEvalVA 0 #else #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) @@ -371,6 +366,26 @@ static int formatInt(char *buffer, int n){ # define TclBackgroundException 0 # undef TclpReaddir # define TclpReaddir 0 +# define TclSetStartupScript 0 +# define TclGetStartupScript 0 +# define TclCreateNamespace 0 +# define TclDeleteNamespace 0 +# define TclAppendExportList 0 +# define TclExport 0 +# define TclImport 0 +# define TclForgetImport 0 +# define TclGetCurrentNamespace_ 0 +# define TclGetGlobalNamespace_ 0 +# define TclFindNamespace 0 +# define TclFindCommand 0 +# define TclGetCommandFromObj 0 +# define TclGetCommandFullName 0 +# define TclCopyChannelOld 0 +# define Tcl_AppendResultVA 0 +# define Tcl_AppendStringsToObjVA 0 +# define Tcl_SetErrorCodeVA 0 +# define Tcl_PanicVA 0 +# define Tcl_VarEvalVA 0 # undef TclpGetDate # define TclpGetDate 0 # undef TclpLocaltime @@ -383,6 +398,20 @@ static int formatInt(char *buffer, int n){ # define Tcl_SeekOld seekOld # define Tcl_TellOld tellOld # define TclBackgroundException Tcl_BackgroundException +# define TclSetStartupScript Tcl_SetStartupScript +# define TclGetStartupScript Tcl_GetStartupScript +# define TclCreateNamespace Tcl_CreateNamespace +# define TclDeleteNamespace Tcl_DeleteNamespace +# define TclAppendExportList Tcl_AppendExportList +# define TclExport Tcl_Export +# define TclImport Tcl_Import +# define TclForgetImport Tcl_ForgetImport +# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace +# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace +# define TclFindNamespace Tcl_FindNamespace +# define TclFindCommand Tcl_FindCommand +# define TclGetCommandFromObj Tcl_GetCommandFromObj +# define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime @@ -535,22 +564,22 @@ static const TclIntStubs tclIntStubs = { TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ - Tcl_AppendExportList, /* 112 */ - Tcl_CreateNamespace, /* 113 */ - Tcl_DeleteNamespace, /* 114 */ - Tcl_Export, /* 115 */ - Tcl_FindCommand, /* 116 */ - Tcl_FindNamespace, /* 117 */ + TclAppendExportList, /* 112 */ + TclCreateNamespace, /* 113 */ + TclDeleteNamespace, /* 114 */ + TclExport, /* 115 */ + TclFindCommand, /* 116 */ + TclFindNamespace, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ - Tcl_ForgetImport, /* 121 */ - Tcl_GetCommandFromObj, /* 122 */ - Tcl_GetCommandFullName, /* 123 */ - Tcl_GetCurrentNamespace, /* 124 */ - Tcl_GetGlobalNamespace, /* 125 */ + TclForgetImport, /* 121 */ + TclGetCommandFromObj, /* 122 */ + TclGetCommandFullName, /* 123 */ + TclGetCurrentNamespace_, /* 124 */ + TclGetGlobalNamespace_, /* 125 */ Tcl_GetVariableFullName, /* 126 */ - Tcl_Import, /* 127 */ + TclImport, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ @@ -601,8 +630,8 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - Tcl_SetStartupScript, /* 178 */ - Tcl_GetStartupScript, /* 179 */ + TclSetStartupScript, /* 178 */ + TclGetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ TclpLocaltime, /* 182 */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index f475aed..6fa837c 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -15,11 +15,13 @@ #ifdef TCL_THREADS +#ifndef TCL_NO_DEPRECATED typedef struct { char nabuf[16]; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; +#endif /* * masterLock is used to serialize creation of mutexes, condition variables, -- cgit v0.12 From 61536390c542d9aa9d1a91d173190cd2421294e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2017 13:05:36 +0000 Subject: Fix executable flags --- generic/tclDecls.h | 0 generic/tclIntDecls.h | 0 generic/tclStubInit.c | 0 3 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 generic/tclDecls.h mode change 100755 => 100644 generic/tclIntDecls.h mode change 100755 => 100644 generic/tclStubInit.c diff --git a/generic/tclDecls.h b/generic/tclDecls.h old mode 100755 new mode 100644 diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h old mode 100755 new mode 100644 diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c old mode 100755 new mode 100644 -- cgit v0.12 From 52b098ca11d6cbae8661a4d1e1461335674f2ce2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2017 16:26:03 +0000 Subject: Deprecate support for macro's like CONST, CONST84, _ANSI_ARGS_, INLINE, TCL_VARARGS --- generic/tcl.decls | 82 +++++++++++------------ generic/tcl.h | 41 +++--------- generic/tclDecls.h | 181 ++++++++++++++++++++++++-------------------------- generic/tclInt.decls | 10 +-- generic/tclInt.h | 6 +- generic/tclIntDecls.h | 14 ++-- 6 files changed, 153 insertions(+), 181 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index fd7468a..60aebfd 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -32,7 +32,7 @@ declare 0 { const char *version, const void *clientData) } declare 1 { - CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp, + const char *Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } @@ -154,7 +154,7 @@ declare 35 { } declare 36 { int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr) + const char *const *tablePtr, const char *msg, int flags, int *indexPtr) } declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) @@ -306,7 +306,7 @@ declare 82 { int Tcl_CommandComplete(const char *cmd) } declare 83 { - char *Tcl_Concat(int argc, CONST84 char *const *argv) + char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { int Tcl_ConvertElement(const char *src, char *dst, int flags) @@ -318,7 +318,7 @@ declare 85 { declare 86 { int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, - CONST84 char *const *argv) + const char *const *argv) } declare 87 { int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, @@ -461,10 +461,10 @@ declare 126 { int Tcl_Eof(Tcl_Channel chan) } declare 127 { - CONST84_RETURN char *Tcl_ErrnoId(void) + const char *Tcl_ErrnoId(void) } declare 128 { - CONST84_RETURN char *Tcl_ErrnoMsg(int err) + const char *Tcl_ErrnoMsg(int err) } declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) @@ -528,12 +528,12 @@ declare 147 { } declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, - int *argcPtr, CONST84 char ***argvPtr) + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, + int *argcPtr, const char ***argvPtr) } declare 149 { int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) } declare 150 { @@ -558,7 +558,7 @@ declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 { - CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan) + const char *Tcl_GetChannelName(Tcl_Channel chan) } declare 157 { int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, @@ -572,14 +572,14 @@ declare 159 { Tcl_CmdInfo *infoPtr) } declare 160 { - CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp, + const char *Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command) } declare 161 { int Tcl_GetErrno(void) } declare 162 { - CONST84_RETURN char *Tcl_GetHostName(void) + const char *Tcl_GetHostName(void) } declare 163 { int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp) @@ -622,14 +622,14 @@ declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 { - CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp) + const char *Tcl_GetStringResult(Tcl_Interp *interp) } declare 175 { - CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, + const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags) } declare 176 { - CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, + const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 177 { @@ -662,7 +662,7 @@ declare 185 { } # Obsolete, use Tcl_FSJoinPath declare 186 { - char *Tcl_JoinPath(int argc, CONST84 char *const *argv, + char *Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr) } declare 187 { @@ -685,7 +685,7 @@ declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) } declare 192 { - char *Tcl_Merge(int argc, CONST84 char *const *argv) + char *Tcl_Merge(int argc, const char *const *argv) } declare 193 { Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr) @@ -703,7 +703,7 @@ declare 196 { } declare 197 { Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, - CONST84 char **argv, int flags) + const char **argv, int flags) } # This is obsolete, use Tcl_FSOpenFileChannel declare 198 { @@ -729,7 +729,7 @@ declare 203 { int Tcl_PutEnv(const char *assignment) } declare 204 { - CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp) + const char *Tcl_PosixError(Tcl_Interp *interp) } declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) @@ -765,7 +765,7 @@ declare 214 { } declare 215 { void Tcl_RegExpRange(Tcl_RegExp regexp, int index, - CONST84 char **startPtr, CONST84 char **endPtr) + const char **startPtr, const char **endPtr) } declare 216 { void Tcl_Release(ClientData clientData) @@ -835,29 +835,29 @@ declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 { - CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, + const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags) } declare 238 { - CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, + const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) } declare 239 { - CONST84_RETURN char *Tcl_SignalId(int sig) + const char *Tcl_SignalId(int sig) } declare 240 { - CONST84_RETURN char *Tcl_SignalMsg(int sig) + const char *Tcl_SignalMsg(int sig) } declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, - CONST84 char ***argvPtr) + const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr) + void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } declare 244 { void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, @@ -952,15 +952,15 @@ declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { - CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, - CONST84 char **termPtr) + const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr) } declare 271 { - CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 272 { - CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp, + const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } @@ -970,7 +970,7 @@ declare 273 { } # TIP #268: The internally used new Require function is in slot 573. declare 274 { - CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 275 {deprecated {see TIP #422}} { @@ -1084,7 +1084,7 @@ declare 301 { Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name) } declare 302 { - CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding) + const char *Tcl_GetEncodingName(Tcl_Encoding encoding) } declare 303 { void Tcl_GetEncodingNames(Tcl_Interp *interp) @@ -1160,7 +1160,7 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index) + const char *Tcl_UtfAtIndex(const char *src, int index) } declare 326 { int Tcl_UtfCharComplete(const char *src, int length) @@ -1169,16 +1169,16 @@ declare 327 { int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { - CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch) + const char *Tcl_UtfFindFirst(const char *src, int ch) } declare 329 { - CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch) + const char *Tcl_UtfFindLast(const char *src, int ch) } declare 330 { - CONST84_RETURN char *Tcl_UtfNext(const char *src) + const char *Tcl_UtfNext(const char *src) } declare 331 { - CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start) + const char *Tcl_UtfPrev(const char *src, const char *start) } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, @@ -1212,7 +1212,7 @@ declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { - CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void) + const char *Tcl_GetDefaultEncodingDir(void) } declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { void Tcl_SetDefaultEncodingDir(const char *path) @@ -1276,7 +1276,7 @@ declare 359 { } declare 360 { int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) + Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 361 { int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, @@ -1289,7 +1289,7 @@ declare 362 { declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr) + const char **termPtr) } declare 364 { int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, @@ -1405,7 +1405,7 @@ declare 397 { int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 { - CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) + const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) } declare 399 { Tcl_ChannelTypeVersion Tcl_ChannelVersion( diff --git a/generic/tcl.h b/generic/tcl.h index 23a0a9a..e054c19 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -137,7 +137,7 @@ extern "C" { */ #include -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # define TCL_VARARGS(type, name) (type name, ...) # define TCL_VARARGS_DEF(type, name) (type name, ...) # define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) @@ -254,10 +254,9 @@ extern "C" { * New code should use prototypes. */ -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # undef _ANSI_ARGS_ # define _ANSI_ARGS_(x) x -#endif /* !TCL_NO_DEPRECATED */ /* * Definitions that allow this header file to be used either with or without @@ -267,34 +266,16 @@ extern "C" { #ifndef INLINE # define INLINE #endif - -#ifdef NO_CONST -# ifndef const -# define const -# endif -#endif #ifndef CONST # define CONST const #endif +#define CONST84 const +#define CONST84_RETURN const -#ifdef USE_NON_CONST -# ifdef USE_COMPAT_CONST -# error define at most one of USE_NON_CONST and USE_COMPAT_CONST -# endif -# define CONST84 -# define CONST84_RETURN -#else -# ifdef USE_COMPAT_CONST -# define CONST84 -# define CONST84_RETURN const -# else -# define CONST84 const -# define CONST84_RETURN const -# endif -#endif +#endif /* !TCL_NO_DEPRECATED */ #ifndef CONST86 -# define CONST86 CONST84 +# define CONST86 const #endif /* @@ -720,10 +701,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); typedef void (Tcl_CloseProc) (ClientData data); typedef void (Tcl_CmdDeleteProc) (ClientData clientData); typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, - int argc, CONST84 char *argv[]); + int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, CONST84 char *argv[]); + ClientData cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); @@ -760,7 +741,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, - CONST84 char *part1, CONST84 char *part2, int flags); + const char *part1, const char *part2, int flags); typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, @@ -1478,14 +1459,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, - CONST84 char *buf, int toWrite, int *errorCodePtr); + const char *buf, int toWrite, int *errorCodePtr); typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, int mode, int *errorCodePtr); typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, - Tcl_Interp *interp, CONST84 char *optionName, + Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3afe45a..0c1505b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -53,7 +53,7 @@ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 1 */ -EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, +EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 2 */ @@ -159,8 +159,7 @@ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, + Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, @@ -281,7 +280,7 @@ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ EXTERN int Tcl_CommandComplete(const char *cmd); /* 83 */ -EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv); +EXTERN char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ EXTERN int Tcl_ConvertElement(const char *src, char *dst, int flags); @@ -292,7 +291,7 @@ EXTERN int Tcl_ConvertCountedElement(const char *src, EXTERN int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, - CONST84 char *const *argv); + const char *const *argv); /* 87 */ EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, @@ -414,9 +413,9 @@ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ EXTERN int Tcl_Eof(Tcl_Channel chan); /* 127 */ -EXTERN CONST84_RETURN char * Tcl_ErrnoId(void); +EXTERN const char * Tcl_ErrnoId(void); /* 128 */ -EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err); +EXTERN const char * Tcl_ErrnoMsg(int err); /* 129 */ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); /* 130 */ @@ -471,13 +470,13 @@ EXTERN void Tcl_FreeResult(Tcl_Interp *interp); EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, - CONST84 char **targetCmdPtr, int *argcPtr, - CONST84 char ***argvPtr); + const char **targetCmdPtr, int *argcPtr, + const char ***argvPtr); /* 149 */ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, - CONST84 char **targetCmdPtr, int *objcPtr, + const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, @@ -496,7 +495,7 @@ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ -EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan); +EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan); /* 157 */ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, @@ -507,12 +506,12 @@ EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 160 */ -EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp, +EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command); /* 161 */ EXTERN int Tcl_GetErrno(void); /* 162 */ -EXTERN CONST84_RETURN char * Tcl_GetHostName(void); +EXTERN const char * Tcl_GetHostName(void); /* 163 */ EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); @@ -548,14 +547,13 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ -EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp); +EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp); /* 175 */ -EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, - const char *varName, int flags); -/* 176 */ -EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, +EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags); +/* 176 */ +EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, + const char *part2, int flags); /* 177 */ EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, const char *command); @@ -580,7 +578,7 @@ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp); /* 185 */ EXTERN int Tcl_IsSafe(Tcl_Interp *interp); /* 186 */ -EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv, +EXTERN char * Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr); /* 187 */ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, @@ -593,7 +591,7 @@ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); /* 192 */ -EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv); +EXTERN char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); /* 194 */ @@ -607,7 +605,7 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, int flags); /* 197 */ EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, - CONST84 char **argv, int flags); + const char **argv, int flags); /* 198 */ EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, @@ -629,7 +627,7 @@ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, /* 203 */ EXTERN int Tcl_PutEnv(const char *assignment); /* 204 */ -EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp); +EXTERN const char * Tcl_PosixError(Tcl_Interp *interp); /* 205 */ EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); @@ -659,8 +657,7 @@ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, - CONST84 char **startPtr, - CONST84 char **endPtr); + const char **startPtr, const char **endPtr); /* 216 */ EXTERN void Tcl_Release(ClientData clientData); /* 217 */ @@ -716,26 +713,25 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); /* 237 */ -EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, - const char *varName, const char *newValue, - int flags); -/* 238 */ -EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, +EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags); +/* 238 */ +EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, + const char *part2, const char *newValue, + int flags); /* 239 */ -EXTERN CONST84_RETURN char * Tcl_SignalId(int sig); +EXTERN const char * Tcl_SignalId(int sig); /* 240 */ -EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig); +EXTERN const char * Tcl_SignalMsg(int sig); /* 241 */ EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ EXTERN int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, - CONST84 char ***argvPtr); + const char ***argvPtr); /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, - CONST84 char ***argvPtr); + const char ***argvPtr); /* 244 */ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, @@ -826,23 +822,21 @@ void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, /* 269 */ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ -EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, - const char *start, CONST84 char **termPtr); +EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr); /* 271 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 272 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, +EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 273 */ EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, const char *version); /* 274 */ -EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 275 */ TCL_DEPRECATED("see TIP #422") void Tcl_SetErrorCodeVA(Tcl_Interp *interp, @@ -919,7 +913,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); /* 302 */ -EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding); +EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ @@ -978,20 +972,20 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index); +EXTERN const char * Tcl_UtfAtIndex(const char *src, int index); /* 326 */ EXTERN int Tcl_UtfCharComplete(const char *src, int length); /* 327 */ EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ -EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch); +EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ -EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch); +EXTERN const char * Tcl_UtfFindLast(const char *src, int ch); /* 330 */ -EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src); +EXTERN const char * Tcl_UtfNext(const char *src); /* 331 */ -EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start); +EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, @@ -1020,7 +1014,7 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); /* 341 */ TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") -CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); +const char * Tcl_GetDefaultEncodingDir(void); /* 342 */ TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") void Tcl_SetDefaultEncodingDir(const char *path); @@ -1071,7 +1065,7 @@ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr); + const char **termPtr); /* 361 */ EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, int nested, @@ -1083,7 +1077,7 @@ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr); + const char **termPtr); /* 364 */ EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, @@ -1173,8 +1167,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ -EXTERN CONST84_RETURN char * Tcl_ChannelName( - const Tcl_ChannelType *chanTypePtr); +EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr); /* 399 */ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr); @@ -1857,7 +1850,7 @@ typedef struct TclStubs { const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ - CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ + const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ char * (*tcl_Alloc) (unsigned int size); /* 3 */ void (*tcl_Free) (char *ptr); /* 4 */ @@ -1908,7 +1901,7 @@ typedef struct TclStubs { unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ - int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ + int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ @@ -1955,10 +1948,10 @@ typedef struct TclStubs { void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ - char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */ + char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ - int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */ + int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ @@ -1999,8 +1992,8 @@ typedef struct TclStubs { void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ - CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */ - CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */ + const char * (*tcl_ErrnoId) (void); /* 127 */ + const char * (*tcl_ErrnoMsg) (int err); /* 128 */ int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ @@ -2020,21 +2013,21 @@ typedef struct TclStubs { Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ - int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */ - int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ + int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ + int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ - CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ + const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ - CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ + const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ - CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */ + const char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */ Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ @@ -2054,9 +2047,9 @@ typedef struct TclStubs { int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ - CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ - CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ - CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ + const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ + const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ + const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ @@ -2066,25 +2059,25 @@ typedef struct TclStubs { int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */ int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */ int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */ - char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */ + char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */ void (*reserved188)(void); Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ - char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */ + char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */ Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */ - Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */ + Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ void (*tcl_Preserve) (ClientData data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ - CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ + const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ @@ -2095,7 +2088,7 @@ typedef struct TclStubs { Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ - void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */ + void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ @@ -2117,13 +2110,13 @@ typedef struct TclStubs { void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ - CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ - CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */ - CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */ + const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ + const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ + const char * (*tcl_SignalId) (int sig); /* 239 */ + const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */ - void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */ + int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ + void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ @@ -2150,11 +2143,11 @@ typedef struct TclStubs { TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ - CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */ - CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ - CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ + const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ + const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ + const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ - CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ + const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ @@ -2182,7 +2175,7 @@ typedef struct TclStubs { void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ - CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ + const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ @@ -2205,13 +2198,13 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ + const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ - CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ - CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ - CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */ - CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ + const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ + const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ + const char * (*tcl_UtfNext) (const char *src); /* 330 */ + const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ @@ -2221,7 +2214,7 @@ typedef struct TclStubs { int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ - TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ + TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ @@ -2240,10 +2233,10 @@ typedef struct TclStubs { TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ - int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */ + int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ - int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */ + int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ @@ -2278,7 +2271,7 @@ typedef struct TclStubs { int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ - CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ + const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 33bf0b3..3fe3e8f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -187,7 +187,7 @@ declare 42 { } # Removed in 8.5a2: #declare 43 { -# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 44 { @@ -222,12 +222,12 @@ declare 51 { } # Removed in 8.5a2: #declare 52 { -# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 53 { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, - int argc, CONST84 char **argv) + int argc, const char **argv) } declare 54 { int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, @@ -548,7 +548,7 @@ declare 133 {deprecated {}} { # int TclpChdir(const char *dirName) #} declare 138 { - CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr) + const char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } #declare 139 { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, @@ -560,7 +560,7 @@ declare 138 { #} # This is used by TclX, but should otherwise be considered private declare 141 { - CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) + const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, diff --git a/generic/tclInt.h b/generic/tclInt.h index 8aaa7a8..ecd2924 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -160,13 +160,13 @@ typedef struct Tcl_ResolvedVarInfo { } Tcl_ResolvedVarInfo; typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, - CONST84 char *name, int length, Tcl_Namespace *context, + const char *name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr); -typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name, +typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr); -typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name, +typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr); typedef struct Tcl_ResolverInfo { diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 22b8072..cd494f4 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -158,7 +158,7 @@ EXTERN int TclInterpInit(Tcl_Interp *interp); /* 53 */ EXTERN int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, - CONST84 char **argv); + const char **argv); /* 54 */ EXTERN int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, @@ -344,13 +344,11 @@ struct tm * TclpGetDate(const time_t *time, int useGMT); /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ -EXTERN CONST84_RETURN char * TclGetEnv(const char *name, - Tcl_DString *valuePtr); +EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr); /* Slot 139 is reserved */ /* Slot 140 is reserved */ /* 141 */ -EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp, - Tcl_DString *cwdPtr); +EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, @@ -692,7 +690,7 @@ typedef struct TclIntStubs { void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); - int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */ + int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); @@ -777,10 +775,10 @@ typedef struct TclIntStubs { void (*reserved135)(void); void (*reserved136)(void); void (*reserved137)(void); - CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ + const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ void (*reserved139)(void); void (*reserved140)(void); - CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ + const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ -- cgit v0.12 From 4e97c16367e23bcde62e1b0910c32a7d06614518 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Nov 2017 17:09:44 +0000 Subject: Modifications to allow the Tcl build system to exploit either a native zip executable in the path or a tclsh that understands the new "install" keyword from the command line Added a new file to /library which is run when the user executes "tclsh install ..." Embedded in installer.tcl is a facility for building zip archives --- generic/tclZipfs.c | 39 ++++++----- library/install.tcl | 13 ++++ unix/Makefile.in | 6 +- unix/configure | 194 +++++++++++++++++++++------------------------------- unix/configure.ac | 75 ++++++++++---------- unix/tcl.m4 | 192 +++++++++++++++++++++++++++++---------------------- win/Makefile.in | 6 +- win/configure | 114 ++++++++++-------------------- win/configure.ac | 77 ++++++++++----------- win/tcl.m4 | 112 +++++++++++++++++++----------- 10 files changed, 408 insertions(+), 420 deletions(-) create mode 100644 library/install.tcl diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 689a648..8c852b2 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3977,25 +3977,32 @@ int TclZipfs_AppHook(int *argc, char ***argv){ } } else if (*argc>1) { archive=(*argv)[1]; - fflush(stdout); - if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { - int found; + if(strcmp(archive,"install")==0) { + /* If the first argument is mkzip, run the mkzip program */ Tcl_Obj *vfsinitscript; - vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1); + vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1); Tcl_IncrRefCount(vfsinitscript); - if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { - /* Startup script should be set before calling Tcl_AppInit */ - Tcl_SetStartupScript(vfsinitscript,NULL); - } else { + Tcl_SetStartupScript(vfsinitscript,NULL); + } else { + if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { + int found; + Tcl_Obj *vfsinitscript; + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + /* Startup script should be set before calling Tcl_AppInit */ + Tcl_SetStartupScript(vfsinitscript,NULL); + } else { + Tcl_DecrRefCount(vfsinitscript); + } + /* Set Tcl Encodings */ + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); - } - /* Set Tcl Encodings */ - vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); - Tcl_IncrRefCount(vfsinitscript); - found=Tcl_FSAccess(vfsinitscript,F_OK); - Tcl_DecrRefCount(vfsinitscript); - if(found==TCL_OK) { - return TCL_OK; + if(found==TCL_OK) { + return TCL_OK; + } } } } diff --git a/library/install.tcl b/library/install.tcl new file mode 100644 index 0000000..f126b37 --- /dev/null +++ b/library/install.tcl @@ -0,0 +1,13 @@ +### +# Installer actions built into tclsh and invoked +# if the first command line argument is "install" +### +if {[llength $argv] < 2} { + exit 0 +} +switch [lindex $argv 1] { + mkzip { + zipfs mkzip {*}[lrange $argv 2 end] + } +} +exit 0 diff --git a/unix/Makefile.in b/unix/Makefile.in index 4540710..98c5865 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -632,6 +632,8 @@ HOST_EXEEXT = @EXEEXT_FOR_BUILD@ HOST_OBJEXT = @OBJEXT_FOR_BUILD@ ZIPFS_BUILD = @ZIPFS_BUILD@ NATIVE_ZIP = @ZIP_PROG@ +ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ +ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ SHARED_BUILD = @SHARED_BUILD@ INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ INSTALL_MSGS = @INSTALL_MSGS@ @@ -653,7 +655,7 @@ MINIZIP_OBJS = \ zutil.$(HOST_OBJEXT) \ minizip.$(HOST_OBJEXT) -ZIP_INSTALL_OBJS = minizip${EXEEXT_FOR_BUILD} +ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ #-------------------------------------------------------------------------- # Start of rules @@ -674,7 +676,7 @@ ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} rm -rf ${TCL_VFS_ROOT} mkdir -p ${TCL_VFS_PATH} cp -a ../library/* ${TCL_VFS_PATH} - cd ${TCL_VFS_ROOT} ; ../minizip${EXEEXT_FOR_BUILD} -o ../${TCL_ZIP_FILE} `find . -type f` + cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. diff --git a/unix/configure b/unix/configure index dd6bf6b..1c3a206 100755 --- a/unix/configure +++ b/unix/configure @@ -658,7 +658,6 @@ TCL_STUB_LIB_FILE TCL_LIB_SPEC TCL_LIB_FLAG TCL_LIB_FILE -TCL_ZIP_FILE PKG_CFG_ARGS TCL_YEAR TCL_PATCH_LEVEL @@ -667,10 +666,10 @@ TCL_MAJOR_VERSION TCL_VERSION INSTALL_MSGS INSTALL_LIBRARIES +TCL_ZIP_FILE ZIPFS_BUILD EXEEXT_FOR_BUILD CC_FOR_BUILD -ZIP_PROG DTRACE LDFLAGS_DEFAULT CFLAGS_DEFAULT @@ -2341,7 +2340,6 @@ VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} -TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip #------------------------------------------------------------------------ # Setup configure arguments for bundled packages @@ -10155,153 +10153,115 @@ fi $as_echo "$tcl_ok" >&6; } #-------------------------------------------------------------------- -# Zipfs support +# Zipfs support - Tip 430 #-------------------------------------------------------------------- - -# -# Find a native zip implementation -# - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 -$as_echo_n "checking for zip... " >&6; } - if ${ac_cv_path_zip+:} false; then : - $as_echo_n "(cached) " >&6 +# Check whether --enable-zipfs was given. +if test "${enable_zipfs+set}" = set; then : + enableval=$enable_zipfs; tcl_ok=$enableval else - - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - + tcl_ok=yes fi - - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 -$as_echo "$ZIP_PROG" >&6; } - else - # It is not an error if an installed version of Zip can't be located. - ZIP_PROG="" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH" >&5 -$as_echo "No zip found on PATH" >&6; } - fi - - - -# -# Find a native compiler -# -# Put a plausible default for CC_FOR_BUILD in Makefile. -if test -z "$CC_FOR_BUILD"; then - if test "x$cross_compiling" = "xno"; then - CC_FOR_BUILD='$(CC)' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + # Put a plausible default for CC_FOR_BUILD in Makefile. + if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 $as_echo_n "checking for gcc... " >&6; } - if ${ac_cv_path_cc+:} false; then : + if ${ac_cv_path_cc+:} false; then : $as_echo_n "(cached) " >&6 else - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/gcc 2> /dev/null` \ - `ls -r $dir/gcc 2> /dev/null` ; do - if test x"$ac_cv_path_cc" = x ; then - if test -f "$j" ; then - ac_cv_path_cc=$j - break - fi - fi - done - done + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done fi - fi -fi + fi + fi -# Also set EXEEXT_FOR_BUILD. -if test "x$cross_compiling" = "xno"; then - EXEEXT_FOR_BUILD='$(EXEEXT)' - OBJEXT_FOR_BUILD='$(OBJEXT)' -else - OBJEXT_FOR_BUILD='.no' - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 + # Also set EXEEXT_FOR_BUILD. + if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' + else + OBJEXT_FOR_BUILD='.no' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 $as_echo_n "checking for build system executable suffix... " >&6; } if ${bfd_cv_build_exeext+:} false; then : $as_echo_n "(cached) " >&6 else rm -f conftest* - echo 'int main () { return 0; }' > conftest.c - bfd_cv_build_exeext= - ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 - for file in conftest.*; do - case $file in - *.c | *.o | *.obj | *.ilk | *.pdb) ;; - *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 $as_echo "$bfd_cv_build_exeext" >&6; } - EXEEXT_FOR_BUILD="" - test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} -fi - - -if test "$ZIP_PROG" = ""; then - ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' -fi - -# Check whether --enable-zipfs was given. -if test "${enable_zipfs+set}" = set; then : - enableval=$enable_zipfs; tcl_ok=$enableval -else - tcl_ok=yes -fi + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} + fi - if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + # + # Find a native zip implementation + # + SC_PROG_ZIP ZIPFS_BUILD=1 - else + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else ZIPFS_BUILD=0 - fi - # Do checking message here to not mess up interleaved configure output - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 $as_echo_n "checking for building with zipfs... " >&6; } - if test "${ZIPFS_BUILD}" = 1; then - if test "${SHARED_BUILD}" = 0; then - ZIPFS_BUILD=2; +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; $as_echo "#define ZIPFS_BUILD 2" >>confdefs.h - INSTALL_LIBRARIES=install-libraries-zipfs-static - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + INSTALL_LIBRARIES=install-libraries-zipfs-static + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } - else + else $as_echo "#define ZIPFS_BUILD 1" >>confdefs.h \ - INSTALL_LIBRARIES=install-libraries-zipfs-shared - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + INSTALL_LIBRARIES=install-libraries-zipfs-shared + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - INSTALL_LIBRARIES=install-libraries - INSTALL_MSGS=install-msgs fi +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi + diff --git a/unix/configure.ac b/unix/configure.ac index ed85184..0928fc8 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -30,7 +30,6 @@ VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} -TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip #------------------------------------------------------------------------ # Setup configure arguments for bundled packages @@ -793,53 +792,49 @@ fi AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- -# Zipfs support +# Zipfs support - Tip 430 #-------------------------------------------------------------------- - -# -# Find a native zip implementation -# -SC_PROG_ZIP - -# -# Find a native compiler -# -AX_CC_FOR_BUILD - -if test "$ZIP_PROG" = ""; then - ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' -fi - AC_ARG_ENABLE(zipfs, AC_HELP_STRING([--enable-zipfs], [build with Zipfs support (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) - if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + AX_CC_FOR_BUILD + # + # Find a native zip implementation + # + SC_PROG_ZIP ZIPFS_BUILD=1 - else + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else ZIPFS_BUILD=0 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +AC_MSG_CHECKING([for building with zipfs]) +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) + INSTALL_LIBRARIES=install-libraries-zipfs-static + AC_MSG_RESULT([yes]) + else + AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + AC_MSG_RESULT([yes]) fi - # Do checking message here to not mess up interleaved configure output - AC_MSG_CHECKING([for building with zipfs]) - if test "${ZIPFS_BUILD}" = 1; then - if test "${SHARED_BUILD}" = 0; then - ZIPFS_BUILD=2; - AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) - INSTALL_LIBRARIES=install-libraries-zipfs-static - AC_MSG_RESULT([yes]) - else - AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ - INSTALL_LIBRARIES=install-libraries-zipfs-shared - AC_MSG_RESULT([yes]) - fi - else - AC_MSG_RESULT([no]) - INSTALL_LIBRARIES=install-libraries - INSTALL_MSGS=install-msgs - fi - AC_SUBST(ZIPFS_BUILD) - AC_SUBST(INSTALL_LIBRARIES) - AC_SUBST(INSTALL_MSGS) +else +AC_MSG_RESULT([no]) +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi +AC_SUBST(ZIPFS_BUILD) +AC_SUBST(TCL_ZIP_FILE) +AC_SUBST(INSTALL_LIBRARIES) +AC_SUBST(INSTALL_MSGS) #-------------------------------------------------------------------- diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 1806207..9cfb746 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -276,7 +276,6 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE -# TCL_ZIP_FILE #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ @@ -290,7 +289,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ fi # eval is required to do the TCL_DBGX substitution - eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\"" eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" @@ -338,7 +336,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) - AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) @@ -3019,107 +3016,138 @@ fi ]) #------------------------------------------------------------------------ -# SC_PROG_ZIP -# Locate a zip encoder installed on the system path, or none. +# SC_CC_FOR_BUILD +# For cross compiles, locate a C compiler that can generate native binaries. # # Arguments: # none # # Results: # Substitutes the following vars: -# ZIP_PROG +# CC_FOR_BUILD +# EXEEXT_FOR_BUILD #------------------------------------------------------------------------ -AC_DEFUN([SC_PROG_ZIP], [ - AC_MSG_CHECKING([for zip]) - AC_CACHE_VAL(ac_cv_path_zip, [ - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - ]) - - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - AC_MSG_RESULT([$ZIP_PROG]) +dnl Get a default for CC_FOR_BUILD to put into Makefile. +AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile. + if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + AC_MSG_CHECKING([for gcc]) + AC_CACHE_VAL(ac_cv_path_cc, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + ]) + fi + fi + AC_SUBST(CC_FOR_BUILD) + # Also set EXEEXT_FOR_BUILD. + if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' else - # It is not an error if an installed version of Zip can't be located. - ZIP_PROG="" - AC_MSG_RESULT([No zip found on PATH]) + OBJEXT_FOR_BUILD='.no' + AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, + [rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} fi - AC_SUBST(ZIP_PROG) + AC_SUBST(EXEEXT_FOR_BUILD)])dnl + AC_SUBST(OBJEXT_FOR_BUILD)])dnl ]) + #------------------------------------------------------------------------ -# SC_CC_FOR_BUILD -# For cross compiles, locate a C compiler that can generate native binaries. +# SC_ZIPFS_SUPPORT +# Locate a zip encoder installed on the system path, or none. # # Arguments: # none # # Results: # Substitutes the following vars: -# CC_FOR_BUILD -# EXEEXT_FOR_BUILD +# ZIP_PROG +# ZIP_PROG_OPTIONS +# ZIP_PROG_VFSSEARCH +# ZIP_INSTALL_OBJS #------------------------------------------------------------------------ -dnl Get a default for CC_FOR_BUILD to put into Makefile. -AC_DEFUN([AX_CC_FOR_BUILD], -[# Put a plausible default for CC_FOR_BUILD in Makefile. -if test -z "$CC_FOR_BUILD"; then - if test "x$cross_compiling" = "xno"; then - CC_FOR_BUILD='$(CC)' - else - AC_MSG_CHECKING([for gcc]) - AC_CACHE_VAL(ac_cv_path_cc, [ - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/gcc 2> /dev/null` \ - `ls -r $dir/gcc 2> /dev/null` ; do - if test x"$ac_cv_path_cc" = x ; then - if test -f "$j" ; then - ac_cv_path_cc=$j - break - fi - fi - done - done +AC_DEFUN([SC_ZIPFS_SUPPORT], [ + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + AC_MSG_CHECKING([for zip]) + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + AS_IF([$TCLSH_PROG install],[ + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Can use Native Tclsh for Zip encoding]) ]) - fi -fi -AC_SUBST(CC_FOR_BUILD) -# Also set EXEEXT_FOR_BUILD. -if test "x$cross_compiling" = "xno"; then - EXEEXT_FOR_BUILD='$(EXEEXT)' - OBJEXT_FOR_BUILD='$(OBJEXT)' -else - OBJEXT_FOR_BUILD='.no' - AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, - [rm -f conftest* - echo 'int main () { return 0; }' > conftest.c - bfd_cv_build_exeext= - ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 - for file in conftest.*; do - case $file in - *.c | *.o | *.obj | *.ilk | *.pdb) ;; - *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) - EXEEXT_FOR_BUILD="" - test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} -fi -AC_SUBST(EXEEXT_FOR_BUILD)])dnl -AC_SUBST(OBJEXT_FOR_BUILD)])dnl + + if test "x$ZIP_PROG" = "x" ; then + AC_MSG_CHECKING([for zip]) + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="\"-o\"" + ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + AC_MSG_RESULT([No zip found on PATH building minizip]) + fi + fi + AC_SUBST(ZIP_PROG) + AC_SUBST(ZIP_PROG_OPTIONS) + AC_SUBST(ZIP_PROG_VFSSEARCH) + AC_SUBST(ZIP_INSTALL_OBJS) +]) + # Local Variables: # mode: autoconf # End: diff --git a/win/Makefile.in b/win/Makefile.in index 214cf7b..7f4fc70 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -214,6 +214,8 @@ HOST_EXEEXT = @EXEEXT_FOR_BUILD@ HOST_OBJEXT = @OBJEXT_FOR_BUILD@ ZIPFS_BUILD = @ZIPFS_BUILD@ NATIVE_ZIP = @ZIP_PROG@ +ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ +ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ SHARED_BUILD = @SHARED_BUILD@ INSTALL_MSGS = @INSTALL_MSGS@ INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ @@ -236,7 +238,7 @@ MINIZIP_OBJS = \ zutil.$(HOST_OBJEXT) \ minizip.$(HOST_OBJEXT) -ZIP_INSTALL_OBJS = minizip${EXEEXT_FOR_BUILD} +ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ -I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \ @@ -482,7 +484,7 @@ ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} rm -rf ${TCL_VFS_ROOT} mkdir -p ${TCL_VFS_PATH} cp -a ../library/* ${TCL_VFS_PATH} - cd ${TCL_VFS_ROOT} ; ../minizip${EXEEXT_FOR_BUILD} -o ../${TCL_ZIP_FILE} `find . -type f` + cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ diff --git a/win/configure b/win/configure index f65b78a..c99d499 100755 --- a/win/configure +++ b/win/configure @@ -687,7 +687,6 @@ TCL_STATIC_LIB_FLAG TCL_STATIC_LIB_FILE TCL_LIB_FLAG TCL_LIB_FILE -TCL_ZIP_FILE TCL_EXE PKG_CFG_ARGS TCL_PATCH_LEVEL @@ -702,10 +701,10 @@ LDFLAGS_DEFAULT CFLAGS_DEFAULT INSTALL_MSGS INSTALL_LIBRARIES +TCL_ZIP_FILE ZIPFS_BUILD EXEEXT_FOR_BUILD CC_FOR_BUILD -ZIP_PROG ZLIB_OBJS ZLIB_LIBS ZLIB_DLL_FILE @@ -2128,8 +2127,6 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ -TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip - #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ @@ -4844,52 +4841,20 @@ fi #-------------------------------------------------------------------- -# Zipfs support +# Zipfs support - Tip 430 #-------------------------------------------------------------------- - -# -# Find a native zip implementation -# - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 -$as_echo_n "checking for zip... " >&6; } - if ${ac_cv_path_zip+:} false; then : - $as_echo_n "(cached) " >&6 +# Check whether --enable-zipfs was given. +if test "${enable_zipfs+set}" = set; then : + enableval=$enable_zipfs; tcl_ok=$enableval else - - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - + tcl_ok=yes fi - - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 -$as_echo "$ZIP_PROG" >&6; } - else - # It is not an error if an installed version of Zip can't be located. - ZIP_PROG="" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH" >&5 -$as_echo "No zip found on PATH" >&6; } - fi - - - -# -# Find a native compiler -# -# Put a plausible default for CC_FOR_BUILD in Makefile. +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + # Put a plausible default for CC_FOR_BUILD in Makefile. if test -z "$CC_FOR_BUILD"; then if test "x$cross_compiling" = "xno"; then CC_FOR_BUILD='$(CC)' @@ -4948,49 +4913,43 @@ $as_echo "$bfd_cv_build_exeext" >&6; } test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} fi - -if test "$ZIP_PROG" = ""; then - ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' -fi - -# Check whether --enable-zipfs was given. -if test "${enable_zipfs+set}" = set; then : - enableval=$enable_zipfs; tcl_ok=$enableval -else - tcl_ok=yes -fi - - if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + # + # Find a native zip implementation + # + SC_PROG_ZIP ZIPFS_BUILD=1 - else + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else ZIPFS_BUILD=0 - fi - # Do checking message here to not mess up interleaved configure output - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 $as_echo_n "checking for building with zipfs... " >&6; } - if test "${ZIPFS_BUILD}" = 1; then - if test "${SHARED_BUILD}" = 0; then - ZIPFS_BUILD=2; +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; $as_echo "#define ZIPFS_BUILD 2" >>confdefs.h - INSTALL_LIBRARIES=install-libraries-zipfs-static - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + INSTALL_LIBRARIES=install-libraries-zipfs-static + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } - else + else $as_echo "#define ZIPFS_BUILD 1" >>confdefs.h \ - INSTALL_LIBRARIES=install-libraries-zipfs-shared - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + INSTALL_LIBRARIES=install-libraries-zipfs-shared + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - INSTALL_LIBRARIES=install-libraries - INSTALL_MSGS=install-msgs fi +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi + @@ -5388,7 +5347,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d - # empty on win diff --git a/win/configure.ac b/win/configure.ac index cf66fc2..b1f3a52 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -29,8 +29,6 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ -TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip - #------------------------------------------------------------------------ # Empty slate for bundled packages, to avoid stale configuration #------------------------------------------------------------------------ @@ -178,53 +176,49 @@ AC_CHECK_TYPE([uintptr_t], [ #-------------------------------------------------------------------- -# Zipfs support +# Zipfs support - Tip 430 #-------------------------------------------------------------------- - -# -# Find a native zip implementation -# -SC_PROG_ZIP - -# -# Find a native compiler -# -AX_CC_FOR_BUILD - -if test "$ZIP_PROG" = ""; then - ZIP_PROG='./minizip${EXEEXT_FOR_BUILD}' -fi - AC_ARG_ENABLE(zipfs, AC_HELP_STRING([--enable-zipfs], [build with Zipfs support (default: on)]), [tcl_ok=$enableval], [tcl_ok=yes]) - if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + AX_CC_FOR_BUILD + # + # Find a native zip implementation + # + SC_PROG_ZIP ZIPFS_BUILD=1 - else + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else ZIPFS_BUILD=0 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +AC_MSG_CHECKING([for building with zipfs]) +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) + INSTALL_LIBRARIES=install-libraries-zipfs-static + AC_MSG_RESULT([yes]) + else + AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + AC_MSG_RESULT([yes]) fi - # Do checking message here to not mess up interleaved configure output - AC_MSG_CHECKING([for building with zipfs]) - if test "${ZIPFS_BUILD}" = 1; then - if test "${SHARED_BUILD}" = 0; then - ZIPFS_BUILD=2; - AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) - INSTALL_LIBRARIES=install-libraries-zipfs-static - AC_MSG_RESULT([yes]) - else - AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ - INSTALL_LIBRARIES=install-libraries-zipfs-shared - AC_MSG_RESULT([yes]) - fi - else - AC_MSG_RESULT([no]) - INSTALL_LIBRARIES=install-libraries - INSTALL_MSGS=install-msgs - fi - AC_SUBST(ZIPFS_BUILD) - AC_SUBST(INSTALL_LIBRARIES) - AC_SUBST(INSTALL_MSGS) +else +AC_MSG_RESULT([no]) +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi +AC_SUBST(ZIPFS_BUILD) +AC_SUBST(TCL_ZIP_FILE) +AC_SUBST(INSTALL_LIBRARIES) +AC_SUBST(INSTALL_MSGS) #-------------------------------------------------------------------- @@ -423,7 +417,6 @@ AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(PKG_CFG_ARGS) AC_SUBST(TCL_EXE) -AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_STATIC_LIB_FILE) diff --git a/win/tcl.m4 b/win/tcl.m4 index 07be5a4..4d34c7d 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -1302,47 +1302,6 @@ print("manifest needed") AC_SUBST(VC_MANIFEST_EMBED_EXE) ]) - -#------------------------------------------------------------------------ -# SC_PROG_ZIP -# Locate a zip encoder installed on the system path, or none. -# -# Arguments: -# none -# -# Results: -# Substitutes the following vars: -# ZIP_PROG -#------------------------------------------------------------------------ - -AC_DEFUN([SC_PROG_ZIP], [ - AC_MSG_CHECKING([for zip]) - AC_CACHE_VAL(ac_cv_path_zip, [ - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - ]) - - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - AC_MSG_RESULT([$ZIP_PROG]) - else - # It is not an error if an installed version of Zip can't be located. - ZIP_PROG="" - AC_MSG_RESULT([No zip found on PATH]) - fi - AC_SUBST(ZIP_PROG) -]) - #------------------------------------------------------------------------ # SC_CC_FOR_BUILD # For cross compiles, locate a C compiler that can generate native binaries. @@ -1405,3 +1364,74 @@ else fi AC_SUBST(EXEEXT_FOR_BUILD)])dnl AC_SUBST(OBJEXT_FOR_BUILD)])dnl + + + +#------------------------------------------------------------------------ +# SC_ZIPFS_SUPPORT +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +# ZIP_PROG_OPTIONS +# ZIP_PROG_VFSSEARCH +# ZIP_INSTALL_OBJS +#------------------------------------------------------------------------ + +AC_DEFUN([SC_ZIPFS_SUPPORT], [ + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + AC_MSG_CHECKING([for zip]) + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + AS_IF([$TCLSH_PROG install],[ + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Can use Native Tclsh for Zip encoding]) + ]) + + if test "x$ZIP_PROG" = "x" ; then + AC_MSG_CHECKING([for zip]) + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="\"-o\"" + ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + AC_MSG_RESULT([No zip found on PATH building minizip]) + fi + fi + AC_SUBST(ZIP_PROG) + AC_SUBST(ZIP_PROG_OPTIONS) + AC_SUBST(ZIP_PROG_VFSSEARCH) + AC_SUBST(ZIP_INSTALL_OBJS) +]) -- cgit v0.12 From 3640513caf65072e9caf1d7f24856864767c9cca Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Nov 2017 18:08:12 +0000 Subject: Autoconf fixes --- unix/configure | 71 ++++++++++++++++++++++++++++++++++- unix/configure.ac | 2 +- win/configure | 108 +++++++++++++++++++++++++++++++++++++++++++++++++++++- win/configure.ac | 3 +- 4 files changed, 180 insertions(+), 4 deletions(-) diff --git a/unix/configure b/unix/configure index 1c3a206..cbcdd85 100755 --- a/unix/configure +++ b/unix/configure @@ -668,6 +668,10 @@ INSTALL_MSGS INSTALL_LIBRARIES TCL_ZIP_FILE ZIPFS_BUILD +ZIP_INSTALL_OBJS +ZIP_PROG_VFSSEARCH +ZIP_PROG_OPTIONS +ZIP_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD DTRACE @@ -10228,7 +10232,72 @@ $as_echo "$bfd_cv_build_exeext" >&6; } # # Find a native zip implementation # - SC_PROG_ZIP + + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + if $TCLSH_PROG install; then : + + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Can use Native Tclsh for Zip encoding" >&5 +$as_echo "Can use Native Tclsh for Zip encoding" >&6; } + +fi + + if test "x$ZIP_PROG" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 +$as_echo "Found INFO Zip in environment" >&6; } + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="\"-o\"" + ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 +$as_echo "No zip found on PATH building minizip" >&6; } + fi + fi + + + + + ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip else diff --git a/unix/configure.ac b/unix/configure.ac index 0928fc8..d633cce 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -806,7 +806,7 @@ if test "$tcl_ok" = "yes" ; then # # Find a native zip implementation # - SC_PROG_ZIP + SC_ZIPFS_SUPPORT ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip else diff --git a/win/configure b/win/configure index c99d499..9bc07f0 100755 --- a/win/configure +++ b/win/configure @@ -703,6 +703,11 @@ INSTALL_MSGS INSTALL_LIBRARIES TCL_ZIP_FILE ZIPFS_BUILD +ZIP_INSTALL_OBJS +ZIP_PROG_VFSSEARCH +ZIP_PROG_OPTIONS +ZIP_PROG +TCLSH_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD ZLIB_OBJS @@ -4916,7 +4921,108 @@ fi # # Find a native zip implementation # - SC_PROG_ZIP + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 +$as_echo_n "checking for tclsh... " >&6; } + + if ${ac_cv_path_tclsh+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \ + `ls -r $dir/tclsh* 2> /dev/null` ; do + if test x"$ac_cv_path_tclsh" = x ; then + if test -f "$j" ; then + ac_cv_path_tclsh=$j + break + fi + fi + done + done + +fi + + + if test -f "$ac_cv_path_tclsh" ; then + TCLSH_PROG="$ac_cv_path_tclsh" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 +$as_echo "$TCLSH_PROG" >&6; } + else + # It is not an error if an installed version of Tcl can't be located. + TCLSH_PROG="" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 +$as_echo "No tclsh found on PATH" >&6; } + fi + + + + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + if $TCLSH_PROG install; then : + + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Can use Native Tclsh for Zip encoding" >&5 +$as_echo "Can use Native Tclsh for Zip encoding" >&6; } + +fi + + if test "x$ZIP_PROG" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 +$as_echo "Found INFO Zip in environment" >&6; } + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="\"-o\"" + ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 +$as_echo "No zip found on PATH building minizip" >&6; } + fi + fi + + + + + ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip else diff --git a/win/configure.ac b/win/configure.ac index b1f3a52..41bd55c 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -190,7 +190,8 @@ if test "$tcl_ok" = "yes" ; then # # Find a native zip implementation # - SC_PROG_ZIP + SC_PROG_TCLSH + SC_ZIPFS_SUPPORT ZIPFS_BUILD=1 TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip else -- cgit v0.12 From 4a8bb308e8dad6abe65db94dfe0c0ddccdbcbb6c Mon Sep 17 00:00:00 2001 From: tne Date: Mon, 20 Nov 2017 19:21:12 +0000 Subject: Fixes to determing the dll location on Windows using GetModuleFileName() --- generic/tclZipfs.c | 41 +++++++++++++++++++++++++++++++++++++++ win/Makefile.in | 57 +++++++++++++++++++++++++++++------------------------- 2 files changed, 72 insertions(+), 26 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 8c852b2..f02cc06 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -16,6 +16,8 @@ #if !defined(_WIN32) && !defined(_WIN64) #include +#else +#include #endif #include #include @@ -3888,6 +3890,26 @@ TclZipfs_Init(Tcl_Interp *interp) #endif } +#if defined(_WIN32) || defined(_WIN64) +#define LIBRARY_SIZE 64 +static int +ToUtf( + const WCHAR *wSrc, + char *dst) +{ + char *start; + + start = dst; + while (*wSrc != '\0') { + dst += Tcl_UniCharToUtf(*wSrc, dst); + wSrc++; + } + *dst = '\0'; + return (int) (dst - start); +} + +#endif + static int TclZipfs_AppHook_FindTclInit(const char *archive){ Tcl_Obj *vfsinitscript; int found; @@ -3918,6 +3940,12 @@ int TclZipfs_AppHook(int *argc, char ***argv){ */ CONST char *archive; +#if defined(_WIN32) || defined(_WIN64) + HMODULE hModule = TclWinGetTclInstance(); + WCHAR wName[MAX_PATH + LIBRARY_SIZE]; + char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; +#endif + Tcl_FindExecutable(*argv[0]); archive=Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); @@ -4006,10 +4034,23 @@ int TclZipfs_AppHook(int *argc, char ***argv){ } } } +#if defined(_WIN32) || defined(_WIN64) + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, dllname, MAX_PATH); + } else { + ToUtf(wName, dllname); + } + printf("DLL FILE: %s\n",dllname); fflush(stdout); + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { + return TCL_OK; + } +#else /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { return TCL_OK; } +#endif if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return TCL_OK; } diff --git a/win/Makefile.in b/win/Makefile.in index 7f4fc70..6734985 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -560,9 +560,10 @@ tclMain2.${OBJEXT}: tclMain.c # TIP #430, ZipFS Support tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ + -DCFG_RUNTIME_PATH=\"$(bindir_native)\" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ - -DCFG_RUNTIME_PATH="\"$(DLL_INSTALL_DIR)\"" \ + -DCFG_RUNTIME_PATH="\"$(BIN_INSTALL_DIR)\"" \ $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip @DEPARG@ $(CC_OBJNAME) @@ -705,7 +706,15 @@ gentommath_h: "$(TOMMATH_DIR_NATIVE)/tommath.h" \ > "$(GENERIC_DIR_NATIVE)/tclTomMath.h" -install: all install-binaries install-libraries install-doc install-packages +INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) +INSTALL_DOC_TARGETS = install-doc +INSTALL_PACKAGE_TARGETS = install-packages +INSTALL_DEV_TARGETS = install-headers +INSTALL_EXTRA_TARGETS = +INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ + $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) + +install: $(INSTALL_TARGETS) install-binaries: binaries @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ @@ -761,23 +770,9 @@ install-binaries: binaries fi install-libraries-zipfs-shared: libraries - @for i in "$(SCRIPT_INSTALL_DIR)"; \ - do \ - if [ ! -d "$$i" ] ; then \ - echo "Making directory $$i"; \ - $(INSTALL_DATA_DIR) "$$i"; \ - else true; \ - fi; \ - done; - @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"; - @for i in \ - $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \ - do \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ - done; install-libraries-zipfs-static: install-libraries-zipfs-shared - $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" ;\ + $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" install-libraries: libraries install-tzdata install-msgs @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ @@ -797,15 +792,6 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @echo "Installing header files"; - @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ - "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ - "$(GENERIC_DIR)/tclPlatDecls.h" \ - "$(GENERIC_DIR)/tclTomMath.h" \ - "$(GENERIC_DIR)/tclTomMathDecls.h"; \ - do \ - $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ - done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ do \ @@ -848,6 +834,25 @@ install-msgs: install-doc: doc +install-headers: + @for i in "$(INCLUDE_INSTALL_DIR)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; + @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ + $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ + $(GENERIC_DIR)/tclPlatDecls.h \ + $(GENERIC_DIR)/tclTomMath.h \ + $(GENERIC_DIR)/tclTomMathDecls.h ; \ + do \ + $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \ + done; + # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ -- cgit v0.12 From 1f34b918b9bf1c3cc57c59952f006aec619c435c Mon Sep 17 00:00:00 2001 From: tne Date: Mon, 20 Nov 2017 19:35:40 +0000 Subject: Removing debugging printf() statement --- generic/tclZipfs.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index f02cc06..b3e863b 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4040,7 +4040,6 @@ int TclZipfs_AppHook(int *argc, char ***argv){ } else { ToUtf(wName, dllname); } - printf("DLL FILE: %s\n",dllname); fflush(stdout); /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { return TCL_OK; -- cgit v0.12 From 12a14f4954455c5d991ab3e71094f7995b15e8c7 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Nov 2017 21:29:57 +0000 Subject: Updating tcl.m4 in windows to fix a typo --- win/configure | 2 +- win/tcl.m4 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/win/configure b/win/configure index 9bc07f0..846d824 100755 --- a/win/configure +++ b/win/configure @@ -5012,7 +5012,7 @@ $as_echo "Found INFO Zip in environment" >&6; } # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_PROG_VFSSEARCH="'find . -type f'" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 $as_echo "No zip found on PATH building minizip" >&6; } diff --git a/win/tcl.m4 b/win/tcl.m4 index 4d34c7d..3a9ae07 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -1425,7 +1425,7 @@ AC_DEFUN([SC_ZIPFS_SUPPORT], [ # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_PROG_VFSSEARCH="'find . -type f'" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH building minizip]) fi -- cgit v0.12 From d2fc7a6ed510eccea8dd9052d243ed160eb883ba Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Mon, 20 Nov 2017 22:45:35 +0000 Subject: Fixing the quoting for arguments to minizip --- unix/configure | 4 ++-- unix/tcl.m4 | 4 ++-- win/configure | 2 +- win/tcl.m4 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/unix/configure b/unix/configure index cbcdd85..53e0a07 100755 --- a/unix/configure +++ b/unix/configure @@ -10286,8 +10286,8 @@ $as_echo "Found INFO Zip in environment" >&6; } # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_PROG_OPTIONS="-o" + ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 $as_echo "No zip found on PATH building minizip" >&6; } diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 9cfb746..dbc92da 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -3136,8 +3136,8 @@ AC_DEFUN([SC_ZIPFS_SUPPORT], [ # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="\`find . -type f\'" + ZIP_PROG_OPTIONS="-o" + ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH building minizip]) fi diff --git a/win/configure b/win/configure index 846d824..f4d0448 100755 --- a/win/configure +++ b/win/configure @@ -5012,7 +5012,7 @@ $as_echo "Found INFO Zip in environment" >&6; } # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="'find . -type f'" + ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 $as_echo "No zip found on PATH building minizip" >&6; } diff --git a/win/tcl.m4 b/win/tcl.m4 index 3a9ae07..ecfcd52 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -1425,7 +1425,7 @@ AC_DEFUN([SC_ZIPFS_SUPPORT], [ # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="'find . -type f'" + ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH building minizip]) fi -- cgit v0.12 From 3cd8b86e50caa31bf230d5f1b224708f5dda41af Mon Sep 17 00:00:00 2001 From: tne Date: Mon, 20 Nov 2017 23:34:21 +0000 Subject: Change to TclZipfs_AppHook to accomidate Windows --- generic/tcl.decls | 11 +++++++---- generic/tclDecls.h | 5 ----- generic/tclPlatDecls.h | 26 ++++++++++++++++++++------ generic/tclStubInit.c | 7 +++++-- generic/tclZipfs.c | 31 ++++++++++++++++++++++++++++--- 5 files changed, 60 insertions(+), 20 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index e929eaf..03104ba 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2340,9 +2340,7 @@ declare 632 { declare 633 { int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) } -declare 634 { - int TclZipfs_AppHook(int *argc, char ***argv) -} + ############################################################################## # Define the platform specific public Tcl interface. These functions are only @@ -2353,6 +2351,9 @@ interface tclPlat ################################ # Unix specific functions # (none) +declare 0 unix { + int TclZipfs_AppHook(int *argc, char ***argv) +} ################################ # Windows specific functions @@ -2365,7 +2366,9 @@ declare 0 win { declare 1 win { char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) } - +declare 2 win { + int TclZipfs_AppHook(int *argc, TCHAR ***argv) +} ################################ # Mac OS X specific functions diff --git a/generic/tclDecls.h b/generic/tclDecls.h index c41a20b..c5b42d3 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1845,8 +1845,6 @@ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, /* 633 */ EXTERN int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname); -/* 634 */ -EXTERN int TclZipfs_AppHook(int *argc, char ***argv); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2516,7 +2514,6 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */ - int (*tclZipfs_AppHook) (int *argc, char ***argv); /* 634 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3815,8 +3812,6 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclZipfs_Mount) /* 632 */ #define TclZipfs_Unmount \ (tclStubsPtr->tclZipfs_Unmount) /* 633 */ -#define TclZipfs_AppHook \ - (tclStubsPtr->tclZipfs_AppHook) /* 634 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index abc8ee8..e746a6d 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -50,6 +50,10 @@ extern "C" { * Exported function declarations: */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +/* 0 */ +EXTERN int TclZipfs_AppHook(int *argc, char ***argv); +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, @@ -57,12 +61,12 @@ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, /* 1 */ EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); +/* 2 */ +EXTERN int TclZipfs_AppHook(int *argc, TCHAR ***argv); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath); +EXTERN int TclZipfs_AppHook(int *argc, char ***argv); /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, @@ -75,12 +79,16 @@ typedef struct TclPlatStubs { int magic; void *hooks; +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + int (*tclZipfs_AppHook) (int *argc, char ***argv); /* 0 */ +#endif /* UNIX */ #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 */ + int (*tclZipfs_AppHook) (int *argc, TCHAR ***argv); /* 2 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ + int (*tclZipfs_AppHook) (int *argc, char ***argv); /* 0 */ int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ #endif /* MACOSX */ } TclPlatStubs; @@ -97,15 +105,21 @@ extern const TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#define TclZipfs_AppHook \ + (tclPlatStubsPtr->tclZipfs_AppHook) /* 0 */ +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ +#define TclZipfs_AppHook \ + (tclPlatStubsPtr->tclZipfs_AppHook) /* 2 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ +#define TclZipfs_AppHook \ + (tclPlatStubsPtr->tclZipfs_AppHook) /* 0 */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif /* MACOSX */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0702f69..ffa42bf 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -789,12 +789,16 @@ static const TclIntPlatStubs tclIntPlatStubs = { static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + TclZipfs_AppHook, /* 0 */ +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ + TclZipfs_AppHook, /* 2 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ + TclZipfs_AppHook, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ #endif /* MACOSX */ }; @@ -1543,7 +1547,6 @@ const TclStubs tclStubs = { Tcl_OpenTcpServerEx, /* 631 */ TclZipfs_Mount, /* 632 */ TclZipfs_Unmount, /* 633 */ - TclZipfs_AppHook, /* 634 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index b3e863b..e6acc8d 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3933,13 +3933,18 @@ static int TclZipfs_AppHook_FindTclInit(const char *archive){ return TCL_ERROR; } -int TclZipfs_AppHook(int *argc, char ***argv){ +#if defined(_WIN32) || defined(_WIN64) +int TclZipfs_AppHook(int *argc, TCHAR ***argv) +#else +int TclZipfs_AppHook(int *argc, char ***argv) +#endif +{ /* * Tclkit_MainHook -- * Performs the argument munging for the shell */ - CONST char *archive; + char *archive; #if defined(_WIN32) || defined(_WIN64) HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; @@ -4004,13 +4009,33 @@ int TclZipfs_AppHook(int *argc, char ***argv){ return TCL_OK; } } else if (*argc>1) { + Tcl_DString ds; +#if defined(_WIN32) || defined(_WIN64) + strcpy(archive, Tcl_WinTCharToUtf((*argv)[1], -1, &ds)); + Tcl_DStringFree(&ds); +#else archive=(*argv)[1]; +#endif + printf(" arg1 %s\n",archive); fflush(stdout); if(strcmp(archive,"install")==0) { /* If the first argument is mkzip, run the mkzip program */ Tcl_Obj *vfsinitscript; + vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1); Tcl_IncrRefCount(vfsinitscript); - Tcl_SetStartupScript(vfsinitscript,NULL); + printf(" startup script %s\n",Tcl_GetString(vfsinitscript)); fflush(stdout); +#if defined(_WIN32) || defined(_WIN64) + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, dllname, MAX_PATH); + } else { + ToUtf(wName, dllname); + } + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { + Tcl_SetStartupScript(vfsinitscript,NULL); + return TCL_OK; + } +#endif } else { if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { int found; -- cgit v0.12 From 6b40a5dc5afee7752743e154ebff5935e614214f Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Nov 2017 00:36:55 +0000 Subject: Added a new function to the Zipfs: TclZipfs_TclLibrary, which returns a previously discovered /library file system from a zip archive, performs the search to see if the current dll has one (and return that), or NULL if zipfs cannot locate /library. Injected a call to [zipfs tcl_library] (which invokes TclZipfs_TclLibrary) inside if interp.c as the first command to try to locate Tcl_Library (if a preinit script hasn't already pointed one out to us.) --- generic/tcl.decls | 4 +- generic/tclDecls.h | 5 ++ generic/tclInterp.c | 1 + generic/tclStubInit.c | 1 + generic/tclZipfs.c | 136 ++++++++++++++++++++++++++++++++++---------------- 5 files changed, 102 insertions(+), 45 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 03104ba..87beab3 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2340,7 +2340,9 @@ declare 632 { declare 633 { int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) } - +declare 634 { + Tcl_Obj *TclZipfs_TclLibrary(void) +} ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index c5b42d3..8ba9e5c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1845,6 +1845,8 @@ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, /* 633 */ EXTERN int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname); +/* 634 */ +EXTERN Tcl_Obj * TclZipfs_TclLibrary(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2514,6 +2516,7 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */ + Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3812,6 +3815,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclZipfs_Mount) /* 632 */ #define TclZipfs_Unmount \ (tclStubsPtr->tclZipfs_Unmount) /* 633 */ +#define TclZipfs_TclLibrary \ + (tclStubsPtr->tclZipfs_TclLibrary) /* 634 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index d9dfd37..b58aee0 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -402,6 +402,7 @@ Tcl_Init( " set scripts {{set tcl_library}}\n" " } else {\n" " set scripts {}\n" +" lappend scripts {zipfs tcl_library}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" " lappend scripts {\n" diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ffa42bf..abd030a 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1547,6 +1547,7 @@ const TclStubs tclStubs = { Tcl_OpenTcpServerEx, /* 631 */ TclZipfs_Mount, /* 632 */ TclZipfs_Unmount, /* 633 */ + TclZipfs_TclLibrary, /* 634 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index e6acc8d..2e24afe 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -300,6 +300,8 @@ static const unsigned long crc32tab[256] = { static Tcl_Obj *zipfs_literal_fstype=NULL; static Tcl_Obj *zipfs_literal_fsroot=NULL; static Tcl_Obj *zipfs_literal_fsseparator=NULL; +static Tcl_Obj *zipfs_literal_null=NULL; +static Tcl_Obj *zipfs_literal_tcl_library=NULL; /* @@ -2424,6 +2426,40 @@ ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, Unlock(); return TCL_OK; } + +/* + *------------------------------------------------------------------------- + * + * ZipFSTclLibraryObjCmd -- + * + * This procedure is invoked to process the "zipfs::root" command. It + * returns the root that all zipfs file systems are mounted under. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *pResult; + pResult=TclZipfs_TclLibrary(); + if(!pResult) { + if(!zipfs_literal_null) { + zipfs_literal_null=Tcl_NewObj(); + Tcl_IncrRefCount(zipfs_literal_null); + } + pResult=zipfs_literal_null; + Tcl_IncrRefCount(zipfs_literal_null); + } + Tcl_SetObjResult(interp,pResult); + return TCL_OK; +} /* *------------------------------------------------------------------------- @@ -3853,6 +3889,7 @@ TclZipfs_Init(Tcl_Interp *interp) {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1}, {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 1}, + {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -3920,14 +3957,19 @@ static int TclZipfs_AppHook_FindTclInit(const char *archive){ vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/init.tcl",-1); Tcl_IncrRefCount(vfsinitscript); found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); if(found==0) { + zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT,-1); + Tcl_IncrRefCount(zipfs_literal_tcl_library); return TCL_OK; } - Tcl_DecrRefCount(vfsinitscript); vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl",-1); Tcl_IncrRefCount(vfsinitscript); found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); if(found==0) { + zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library",-1); + Tcl_IncrRefCount(zipfs_literal_tcl_library); return TCL_OK; } return TCL_ERROR; @@ -3943,14 +3985,8 @@ int TclZipfs_AppHook(int *argc, char ***argv) * Tclkit_MainHook -- * Performs the argument munging for the shell */ - char *archive; -#if defined(_WIN32) || defined(_WIN64) - HMODULE hModule = TclWinGetTclInstance(); - WCHAR wName[MAX_PATH + LIBRARY_SIZE]; - char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; -#endif - + Tcl_FindExecutable(*argv[0]); archive=Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); @@ -4001,41 +4037,34 @@ int TclZipfs_AppHook(int *argc, char ***argv) Tcl_DecrRefCount(vfsinitscript); } /* Set Tcl Encodings */ - vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); - Tcl_IncrRefCount(vfsinitscript); - found=Tcl_FSAccess(vfsinitscript,F_OK); - Tcl_DecrRefCount(vfsinitscript); - if(found==TCL_OK) { - return TCL_OK; + if(!zipfs_literal_tcl_library) { + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); + if(found==TCL_OK) { + zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library",-1); + Tcl_IncrRefCount(zipfs_literal_tcl_library); + return TCL_OK; + } } } else if (*argc>1) { - Tcl_DString ds; #if defined(_WIN32) || defined(_WIN64) + Tcl_DString ds; strcpy(archive, Tcl_WinTCharToUtf((*argv)[1], -1, &ds)); Tcl_DStringFree(&ds); #else archive=(*argv)[1]; #endif - printf(" arg1 %s\n",archive); fflush(stdout); if(strcmp(archive,"install")==0) { /* If the first argument is mkzip, run the mkzip program */ Tcl_Obj *vfsinitscript; vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1); Tcl_IncrRefCount(vfsinitscript); - printf(" startup script %s\n",Tcl_GetString(vfsinitscript)); fflush(stdout); -#if defined(_WIN32) || defined(_WIN64) - if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { - GetModuleFileNameA(hModule, dllname, MAX_PATH); - } else { - ToUtf(wName, dllname); - } - /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { - Tcl_SetStartupScript(vfsinitscript,NULL); - return TCL_OK; - } -#endif + /* Run this now to ensure the file is present by the time Tcl_Main wants it */ + TclZipfs_TclLibrary(); + return TCL_OK; } else { if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { int found; @@ -4054,31 +4083,50 @@ int TclZipfs_AppHook(int *argc, char ***argv) found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); if(found==TCL_OK) { + zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library",-1); + Tcl_IncrRefCount(zipfs_literal_tcl_library); + zipfs_literal_tcl_library=vfsinitscript; return TCL_OK; } } } } -#if defined(_WIN32) || defined(_WIN64) - if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { - GetModuleFileNameA(hModule, dllname, MAX_PATH); + return TCL_OK; +} + +Tcl_Obj *TclZipfs_TclLibrary(void) { + if(zipfs_literal_tcl_library) { + Tcl_IncrRefCount(zipfs_literal_tcl_library); + return zipfs_literal_tcl_library; } else { - ToUtf(wName, dllname); - } - /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { - return TCL_OK; - } +#if defined(_WIN32) || defined(_WIN64) + HMODULE hModule = TclWinGetTclInstance(); + WCHAR wName[MAX_PATH + LIBRARY_SIZE]; + char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, dllname, MAX_PATH); + } else { + ToUtf(wName, dllname); + } + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { + Tcl_IncrRefCount(zipfs_literal_tcl_library); + return zipfs_literal_tcl_library; + } #else - /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { - return TCL_OK; - } + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { + Tcl_IncrRefCount(zipfs_literal_tcl_library); + return zipfs_literal_tcl_library; + } #endif + } if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { - return TCL_OK; + Tcl_IncrRefCount(zipfs_literal_tcl_library); + return zipfs_literal_tcl_library; } - return TCL_OK; + return NULL; } -- cgit v0.12 From 9ef614086a2b3267669f4fb644ad1a92debb5fb0 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Nov 2017 00:41:04 +0000 Subject: Typo fixes for minizip --- win/configure | 4 ++-- win/tcl.m4 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/win/configure b/win/configure index f4d0448..f0159d1 100755 --- a/win/configure +++ b/win/configure @@ -5011,8 +5011,8 @@ $as_echo "Found INFO Zip in environment" >&6; } # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" + ZIP_PROG_OPTIONS="-o" + ZIP_PROG_VFSSEARCH="\"\`find . -type f\`\"" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 $as_echo "No zip found on PATH building minizip" >&6; } diff --git a/win/tcl.m4 b/win/tcl.m4 index ecfcd52..c56cd09 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -1424,8 +1424,8 @@ AC_DEFUN([SC_ZIPFS_SUPPORT], [ # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="\"-o\"" - ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" + ZIP_PROG_OPTIONS="-o" + ZIP_PROG_VFSSEARCH="\"\`find . -type f\`\"" ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH building minizip]) fi -- cgit v0.12 From d7b40297d2ec40549321631ce061f496a14b4f46 Mon Sep 17 00:00:00 2001 From: tne Date: Tue, 21 Nov 2017 01:14:05 +0000 Subject: Final tweaks to make "./tclsh install" work properly on Windows NOTE: We still seem to be screwing up minizip on MinGW. the `find . -type f` substitution is not working --- generic/tclZipfs.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 2e24afe..a954dd6 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4059,11 +4059,13 @@ int TclZipfs_AppHook(int *argc, char ***argv) if(strcmp(archive,"install")==0) { /* If the first argument is mkzip, run the mkzip program */ Tcl_Obj *vfsinitscript; - - vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1); - Tcl_IncrRefCount(vfsinitscript); /* Run this now to ensure the file is present by the time Tcl_Main wants it */ TclZipfs_TclLibrary(); + vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + if(Tcl_FSAccess(vfsinitscript,F_OK)==0) { + Tcl_SetStartupScript(vfsinitscript,NULL); + } return TCL_OK; } else { if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { -- cgit v0.12 From d8a921174ea67582c89d57f5e1b8d072acfd462c Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Nov 2017 04:07:45 +0000 Subject: Added an implementation of tinydir.h, and spliced it into minizip to allow minizip to recurse directory structures (and get us out of having to feed `find` via autoconf) --- compat/zlib/contrib/minizip/minizip.c | 264 ++++++----- compat/zlib/contrib/minizip/tinydir.h | 816 ++++++++++++++++++++++++++++++++++ unix/configure | 4 +- unix/tcl.m4 | 4 +- win/configure | 4 +- win/tcl.m4 | 4 +- 6 files changed, 975 insertions(+), 121 deletions(-) create mode 100755 compat/zlib/contrib/minizip/tinydir.h diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c index 4288962..b5c67cc 100644 --- a/compat/zlib/contrib/minizip/minizip.c +++ b/compat/zlib/contrib/minizip/minizip.c @@ -12,7 +12,6 @@ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) */ - #if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__)) #ifndef __USE_FILE_OFFSET64 #define __USE_FILE_OFFSET64 @@ -39,8 +38,7 @@ #define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin) #endif - - +#include "tinydir.h" #include #include #include @@ -172,6 +170,7 @@ void do_banner() void do_help() { printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \ + " -r Scan directories recursively\n" \ " -o Overwrite existing file.zip\n" \ " -a Append to existing file.zip\n" \ " -0 Store only\n" \ @@ -243,12 +242,153 @@ int isLargeFile(const char* filename) return largeFile; } +void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { + FILE * fin; + int size_read; + const char *savefilenameinzip; + zip_fileinfo zi; + unsigned long crcFile=0; + int zip64 = 0; + int err=0; + int size_buf=WRITEBUFFERSIZE; + unsigned char buf[WRITEBUFFERSIZE]; + zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour = + zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0; + zi.dosDate = 0; + zi.internal_fa = 0; + zi.external_fa = 0; + filetime(filenameinzip,&zi.tmz_date,&zi.dosDate); + +/* + err = zipOpenNewFileInZip(zf,filenameinzip,&zi, + NULL,0,NULL,0,NULL / * comment * /, + (opt_compress_level != 0) ? Z_DEFLATED : 0, + opt_compress_level); +*/ + if ((password != NULL) && (err==ZIP_OK)) + err = getFileCrc(filenameinzip,buf,size_buf,&crcFile); + + zip64 = isLargeFile(filenameinzip); + + /* The path name saved, should not include a leading slash. */ + /*if it did, windows/xp and dynazip couldn't read the zip file. */ + savefilenameinzip = filenameinzip; + while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' ) + { + savefilenameinzip++; + } + + /*should the zip file contain any path at all?*/ + if( opt_exclude_path ) + { + const char *tmpptr; + const char *lastslash = 0; + for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++) + { + if( *tmpptr == '\\' || *tmpptr == '/') + { + lastslash = tmpptr; + } + } + if( lastslash != NULL ) + { + savefilenameinzip = lastslash+1; // base filename follows last slash. + } + } + + /**/ + err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi, + NULL,0,NULL,0,NULL /* comment*/, + (opt_compress_level != 0) ? Z_DEFLATED : 0, + opt_compress_level,0, + /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */ + -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, + password,crcFile, zip64); + + if (err != ZIP_OK) + printf("error in opening %s in zipfile\n",filenameinzip); + else + { + fin = FOPEN_FUNC(filenameinzip,"rb"); + if (fin==NULL) + { + err=ZIP_ERRNO; + printf("error in opening %s for reading\n",filenameinzip); + } + } + + if (err == ZIP_OK) + do + { + err = ZIP_OK; + size_read = (int)fread(buf,1,size_buf,fin); + if (size_read < size_buf) + if (feof(fin)==0) + { + printf("error in reading %s\n",filenameinzip); + err = ZIP_ERRNO; + } + + if (size_read>0) + { + err = zipWriteInFileInZip (zf,buf,size_read); + if (err<0) + { + printf("error in writing %s in the zipfile\n", + filenameinzip); + } + + } + } while ((err == ZIP_OK) && (size_read>0)); + + if (fin) + fclose(fin); + + if (err<0) + err=ZIP_ERRNO; + else + { + err = zipCloseFileInZip(zf); + if (err!=ZIP_OK) + printf("error in closing %s in the zipfile\n", + filenameinzip); + } +} + + +void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { + tinydir_dir dir; + int i; + char *newname[512]; + + tinydir_open_sorted(&dir, filenameinzip); + + for (i = 0; i < dir.n_files; i++) + { + tinydir_file file; + tinydir_readfile_n(&dir, &file, i); + if(strcmp(file.name,".")==0) continue; + if(strcmp(file.name,"..")==0) continue; + sprintf(newname,"%s/%s",dir.path,file.name); + if (file.is_dir) + { + addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level); + } else { + addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level); + } + } + + tinydir_close(&dir); +} + + int main(argc,argv) int argc; char *argv[]; { int i; - int opt_overwrite=0; + int opt_recursive=0; + int opt_overwrite=1; int opt_compress_level=Z_DEFAULT_COMPRESSION; int opt_exclude_path=0; int zipfilenamearg = 0; @@ -285,7 +425,8 @@ int main(argc,argv) opt_compress_level = c-'0'; if ((c=='j') || (c=='J')) opt_exclude_path = 1; - + if ((c=='r') || (c=='R')) + opt_recursive = 1; if (((c=='p') || (c=='P')) && (i+1='0') || (argv[i][1]<='9'))) && (strlen(argv[i]) == 2))) { - FILE * fin; - int size_read; - const char* filenameinzip = argv[i]; - const char *savefilenameinzip; - zip_fileinfo zi; - unsigned long crcFile=0; - int zip64 = 0; - - zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour = - zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0; - zi.dosDate = 0; - zi.internal_fa = 0; - zi.external_fa = 0; - filetime(filenameinzip,&zi.tmz_date,&zi.dosDate); - -/* - err = zipOpenNewFileInZip(zf,filenameinzip,&zi, - NULL,0,NULL,0,NULL / * comment * /, - (opt_compress_level != 0) ? Z_DEFLATED : 0, - opt_compress_level); -*/ - if ((password != NULL) && (err==ZIP_OK)) - err = getFileCrc(filenameinzip,buf,size_buf,&crcFile); - - zip64 = isLargeFile(filenameinzip); - - /* The path name saved, should not include a leading slash. */ - /*if it did, windows/xp and dynazip couldn't read the zip file. */ - savefilenameinzip = filenameinzip; - while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' ) - { - savefilenameinzip++; - } - - /*should the zip file contain any path at all?*/ - if( opt_exclude_path ) - { - const char *tmpptr; - const char *lastslash = 0; - for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++) - { - if( *tmpptr == '\\' || *tmpptr == '/') - { - lastslash = tmpptr; - } - } - if( lastslash != NULL ) - { - savefilenameinzip = lastslash+1; // base filename follows last slash. - } - } - - /**/ - err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi, - NULL,0,NULL,0,NULL /* comment*/, - (opt_compress_level != 0) ? Z_DEFLATED : 0, - opt_compress_level,0, - /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */ - -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, - password,crcFile, zip64); - - if (err != ZIP_OK) - printf("error in opening %s in zipfile\n",filenameinzip); - else - { - fin = FOPEN_FUNC(filenameinzip,"rb"); - if (fin==NULL) - { - err=ZIP_ERRNO; - printf("error in opening %s for reading\n",filenameinzip); - } - } - - if (err == ZIP_OK) - do - { - err = ZIP_OK; - size_read = (int)fread(buf,1,size_buf,fin); - if (size_read < size_buf) - if (feof(fin)==0) - { - printf("error in reading %s\n",filenameinzip); - err = ZIP_ERRNO; - } - - if (size_read>0) - { - err = zipWriteInFileInZip (zf,buf,size_read); - if (err<0) - { - printf("error in writing %s in the zipfile\n", - filenameinzip); - } - - } - } while ((err == ZIP_OK) && (size_read>0)); - - if (fin) - fclose(fin); - - if (err<0) - err=ZIP_ERRNO; - else - { - err = zipCloseFileInZip(zf); - if (err!=ZIP_OK) - printf("error in closing %s in the zipfile\n", - filenameinzip); + if(opt_recursive) { + addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level); + } else { + addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level); } } } diff --git a/compat/zlib/contrib/minizip/tinydir.h b/compat/zlib/contrib/minizip/tinydir.h new file mode 100755 index 0000000..eb34399 --- /dev/null +++ b/compat/zlib/contrib/minizip/tinydir.h @@ -0,0 +1,816 @@ +/* +Copyright (c) 2013-2017, tinydir authors: +- Cong Xu +- Lautis Sun +- Baudouin Feildel +- Andargor +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*/ +#ifndef TINYDIR_H +#define TINYDIR_H + +#ifdef __cplusplus +extern "C" { +#endif + +#if ((defined _UNICODE) && !(defined UNICODE)) +#define UNICODE +#endif + +#if ((defined UNICODE) && !(defined _UNICODE)) +#define _UNICODE +#endif + +#include +#include +#include +#ifdef _MSC_VER +# define WIN32_LEAN_AND_MEAN +# include +# include +# pragma warning(push) +# pragma warning (disable : 4996) +#else +# include +# include +# include +# include +#endif +#ifdef __MINGW32__ +# include +#endif + + +/* types */ + +/* Windows UNICODE wide character support */ +#if defined _MSC_VER || defined __MINGW32__ +# define _tinydir_char_t TCHAR +# define TINYDIR_STRING(s) _TEXT(s) +# define _tinydir_strlen _tcslen +# define _tinydir_strcpy _tcscpy +# define _tinydir_strcat _tcscat +# define _tinydir_strcmp _tcscmp +# define _tinydir_strrchr _tcsrchr +# define _tinydir_strncmp _tcsncmp +#else +# define _tinydir_char_t char +# define TINYDIR_STRING(s) s +# define _tinydir_strlen strlen +# define _tinydir_strcpy strcpy +# define _tinydir_strcat strcat +# define _tinydir_strcmp strcmp +# define _tinydir_strrchr strrchr +# define _tinydir_strncmp strncmp +#endif + +#if (defined _MSC_VER || defined __MINGW32__) +# include +# define _TINYDIR_PATH_MAX MAX_PATH +#elif defined __linux__ +# include +# define _TINYDIR_PATH_MAX PATH_MAX +#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__)) +# include +# if defined(BSD) +# include +# define _TINYDIR_PATH_MAX PATH_MAX +# endif +#endif + +#ifndef _TINYDIR_PATH_MAX +#define _TINYDIR_PATH_MAX 4096 +#endif + +#ifdef _MSC_VER +/* extra chars for the "\\*" mask */ +# define _TINYDIR_PATH_EXTRA 2 +#else +# define _TINYDIR_PATH_EXTRA 0 +#endif + +#define _TINYDIR_FILENAME_MAX 256 + +#if (defined _MSC_VER || defined __MINGW32__) +#define _TINYDIR_DRIVE_MAX 3 +#endif + +#ifdef _MSC_VER +# define _TINYDIR_FUNC static __inline +#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L +# define _TINYDIR_FUNC static __inline__ +#else +# define _TINYDIR_FUNC static inline +#endif + +/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */ +#ifdef TINYDIR_USE_READDIR_R + +/* readdir_r is a POSIX-only function, and may not be available under various + * environments/settings, e.g. MinGW. Use readdir fallback */ +#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\ + _POSIX_SOURCE +# define _TINYDIR_HAS_READDIR_R +#endif +#if _POSIX_C_SOURCE >= 200112L +# define _TINYDIR_HAS_FPATHCONF +# include +#endif +#if _BSD_SOURCE || _SVID_SOURCE || \ + (_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700) +# define _TINYDIR_HAS_DIRFD +# include +#endif +#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\ + defined _PC_NAME_MAX +# define _TINYDIR_USE_FPATHCONF +#endif +#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\ + !(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX) +# define _TINYDIR_USE_READDIR +#endif + +/* Use readdir by default */ +#else +# define _TINYDIR_USE_READDIR +#endif + +/* MINGW32 has two versions of dirent, ASCII and UNICODE*/ +#ifndef _MSC_VER +#if (defined __MINGW32__) && (defined _UNICODE) +#define _TINYDIR_DIR _WDIR +#define _tinydir_dirent _wdirent +#define _tinydir_opendir _wopendir +#define _tinydir_readdir _wreaddir +#define _tinydir_closedir _wclosedir +#else +#define _TINYDIR_DIR DIR +#define _tinydir_dirent dirent +#define _tinydir_opendir opendir +#define _tinydir_readdir readdir +#define _tinydir_closedir closedir +#endif +#endif + +/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */ +#if defined(_TINYDIR_MALLOC) && defined(_TINYDIR_FREE) +#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE) +#else +#error "Either define both alloc and free or none of them!" +#endif + +#if !defined(_TINYDIR_MALLOC) + #define _TINYDIR_MALLOC(_size) malloc(_size) + #define _TINYDIR_FREE(_ptr) free(_ptr) +#endif /* !defined(_TINYDIR_MALLOC) */ + +typedef struct tinydir_file +{ + _tinydir_char_t path[_TINYDIR_PATH_MAX]; + _tinydir_char_t name[_TINYDIR_FILENAME_MAX]; + _tinydir_char_t *extension; + int is_dir; + int is_reg; + +#ifndef _MSC_VER +#ifdef __MINGW32__ + struct _stat _s; +#else + struct stat _s; +#endif +#endif +} tinydir_file; + +typedef struct tinydir_dir +{ + _tinydir_char_t path[_TINYDIR_PATH_MAX]; + int has_next; + size_t n_files; + + tinydir_file *_files; +#ifdef _MSC_VER + HANDLE _h; + WIN32_FIND_DATA _f; +#else + _TINYDIR_DIR *_d; + struct _tinydir_dirent *_e; +#ifndef _TINYDIR_USE_READDIR + struct _tinydir_dirent *_ep; +#endif +#endif +} tinydir_dir; + + +/* declarations */ + +_TINYDIR_FUNC +int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path); +_TINYDIR_FUNC +int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path); +_TINYDIR_FUNC +void tinydir_close(tinydir_dir *dir); + +_TINYDIR_FUNC +int tinydir_next(tinydir_dir *dir); +_TINYDIR_FUNC +int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file); +_TINYDIR_FUNC +int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i); +_TINYDIR_FUNC +int tinydir_open_subdir_n(tinydir_dir *dir, size_t i); + +_TINYDIR_FUNC +int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path); +_TINYDIR_FUNC +void _tinydir_get_ext(tinydir_file *file); +_TINYDIR_FUNC +int _tinydir_file_cmp(const void *a, const void *b); +#ifndef _MSC_VER +#ifndef _TINYDIR_USE_READDIR +_TINYDIR_FUNC +size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp); +#endif +#endif + + +/* definitions*/ + +_TINYDIR_FUNC +int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path) +{ +#ifndef _MSC_VER +#ifndef _TINYDIR_USE_READDIR + int error; + int size; /* using int size */ +#endif +#else + _tinydir_char_t path_buf[_TINYDIR_PATH_MAX]; +#endif + _tinydir_char_t *pathp; + + if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0) + { + errno = EINVAL; + return -1; + } + if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) + { + errno = ENAMETOOLONG; + return -1; + } + + /* initialise dir */ + dir->_files = NULL; +#ifdef _MSC_VER + dir->_h = INVALID_HANDLE_VALUE; +#else + dir->_d = NULL; +#ifndef _TINYDIR_USE_READDIR + dir->_ep = NULL; +#endif +#endif + tinydir_close(dir); + + _tinydir_strcpy(dir->path, path); + /* Remove trailing slashes */ + pathp = &dir->path[_tinydir_strlen(dir->path) - 1]; + while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/'))) + { + *pathp = TINYDIR_STRING('\0'); + pathp++; + } +#ifdef _MSC_VER + _tinydir_strcpy(path_buf, dir->path); + _tinydir_strcat(path_buf, TINYDIR_STRING("\\*")); +#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP) + dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0); +#else + dir->_h = FindFirstFile(path_buf, &dir->_f); +#endif + if (dir->_h == INVALID_HANDLE_VALUE) + { + errno = ENOENT; +#else + dir->_d = _tinydir_opendir(path); + if (dir->_d == NULL) + { +#endif + goto bail; + } + + /* read first file */ + dir->has_next = 1; +#ifndef _MSC_VER +#ifdef _TINYDIR_USE_READDIR + dir->_e = _tinydir_readdir(dir->_d); +#else + /* allocate dirent buffer for readdir_r */ + size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */ + if (size == -1) return -1; + dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size); + if (dir->_ep == NULL) return -1; + + error = readdir_r(dir->_d, dir->_ep, &dir->_e); + if (error != 0) return -1; +#endif + if (dir->_e == NULL) + { + dir->has_next = 0; + } +#endif + + return 0; + +bail: + tinydir_close(dir); + return -1; +} + +_TINYDIR_FUNC +int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path) +{ + /* Count the number of files first, to pre-allocate the files array */ + size_t n_files = 0; + if (tinydir_open(dir, path) == -1) + { + return -1; + } + while (dir->has_next) + { + n_files++; + if (tinydir_next(dir) == -1) + { + goto bail; + } + } + tinydir_close(dir); + + if (tinydir_open(dir, path) == -1) + { + return -1; + } + + dir->n_files = 0; + dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files); + if (dir->_files == NULL) + { + goto bail; + } + while (dir->has_next) + { + tinydir_file *p_file; + dir->n_files++; + + p_file = &dir->_files[dir->n_files - 1]; + if (tinydir_readfile(dir, p_file) == -1) + { + goto bail; + } + + if (tinydir_next(dir) == -1) + { + goto bail; + } + + /* Just in case the number of files has changed between the first and + second reads, terminate without writing into unallocated memory */ + if (dir->n_files == n_files) + { + break; + } + } + + qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp); + + return 0; + +bail: + tinydir_close(dir); + return -1; +} + +_TINYDIR_FUNC +void tinydir_close(tinydir_dir *dir) +{ + if (dir == NULL) + { + return; + } + + memset(dir->path, 0, sizeof(dir->path)); + dir->has_next = 0; + dir->n_files = 0; + _TINYDIR_FREE(dir->_files); + dir->_files = NULL; +#ifdef _MSC_VER + if (dir->_h != INVALID_HANDLE_VALUE) + { + FindClose(dir->_h); + } + dir->_h = INVALID_HANDLE_VALUE; +#else + if (dir->_d) + { + _tinydir_closedir(dir->_d); + } + dir->_d = NULL; + dir->_e = NULL; +#ifndef _TINYDIR_USE_READDIR + _TINYDIR_FREE(dir->_ep); + dir->_ep = NULL; +#endif +#endif +} + +_TINYDIR_FUNC +int tinydir_next(tinydir_dir *dir) +{ + if (dir == NULL) + { + errno = EINVAL; + return -1; + } + if (!dir->has_next) + { + errno = ENOENT; + return -1; + } + +#ifdef _MSC_VER + if (FindNextFile(dir->_h, &dir->_f) == 0) +#else +#ifdef _TINYDIR_USE_READDIR + dir->_e = _tinydir_readdir(dir->_d); +#else + if (dir->_ep == NULL) + { + return -1; + } + if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0) + { + return -1; + } +#endif + if (dir->_e == NULL) +#endif + { + dir->has_next = 0; +#ifdef _MSC_VER + if (GetLastError() != ERROR_SUCCESS && + GetLastError() != ERROR_NO_MORE_FILES) + { + tinydir_close(dir); + errno = EIO; + return -1; + } +#endif + } + + return 0; +} + +_TINYDIR_FUNC +int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file) +{ + if (dir == NULL || file == NULL) + { + errno = EINVAL; + return -1; + } +#ifdef _MSC_VER + if (dir->_h == INVALID_HANDLE_VALUE) +#else + if (dir->_e == NULL) +#endif + { + errno = ENOENT; + return -1; + } + if (_tinydir_strlen(dir->path) + + _tinydir_strlen( +#ifdef _MSC_VER + dir->_f.cFileName +#else + dir->_e->d_name +#endif + ) + 1 + _TINYDIR_PATH_EXTRA >= + _TINYDIR_PATH_MAX) + { + /* the path for the file will be too long */ + errno = ENAMETOOLONG; + return -1; + } + if (_tinydir_strlen( +#ifdef _MSC_VER + dir->_f.cFileName +#else + dir->_e->d_name +#endif + ) >= _TINYDIR_FILENAME_MAX) + { + errno = ENAMETOOLONG; + return -1; + } + + _tinydir_strcpy(file->path, dir->path); + _tinydir_strcat(file->path, TINYDIR_STRING("/")); + _tinydir_strcpy(file->name, +#ifdef _MSC_VER + dir->_f.cFileName +#else + dir->_e->d_name +#endif + ); + _tinydir_strcat(file->path, file->name); +#ifndef _MSC_VER +#ifdef __MINGW32__ + if (_tstat( +#else + if (stat( +#endif + file->path, &file->_s) == -1) + { + return -1; + } +#endif + _tinydir_get_ext(file); + + file->is_dir = +#ifdef _MSC_VER + !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY); +#else + S_ISDIR(file->_s.st_mode); +#endif + file->is_reg = +#ifdef _MSC_VER + !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) || + ( + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) && + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) && + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) && +#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) && +#endif +#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) && +#endif + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) && + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY)); +#else + S_ISREG(file->_s.st_mode); +#endif + + return 0; +} + +_TINYDIR_FUNC +int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i) +{ + if (dir == NULL || file == NULL) + { + errno = EINVAL; + return -1; + } + if (i >= dir->n_files) + { + errno = ENOENT; + return -1; + } + + memcpy(file, &dir->_files[i], sizeof(tinydir_file)); + _tinydir_get_ext(file); + + return 0; +} + +_TINYDIR_FUNC +int tinydir_open_subdir_n(tinydir_dir *dir, size_t i) +{ + _tinydir_char_t path[_TINYDIR_PATH_MAX]; + if (dir == NULL) + { + errno = EINVAL; + return -1; + } + if (i >= dir->n_files || !dir->_files[i].is_dir) + { + errno = ENOENT; + return -1; + } + + _tinydir_strcpy(path, dir->_files[i].path); + tinydir_close(dir); + if (tinydir_open_sorted(dir, path) == -1) + { + return -1; + } + + return 0; +} + +/* Open a single file given its path */ +_TINYDIR_FUNC +int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path) +{ + tinydir_dir dir; + int result = 0; + int found = 0; + _tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX]; + _tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX]; + _tinydir_char_t *dir_name; + _tinydir_char_t *base_name; +#if (defined _MSC_VER || defined __MINGW32__) + _tinydir_char_t drive_buf[_TINYDIR_PATH_MAX]; + _tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX]; +#endif + + if (file == NULL || path == NULL || _tinydir_strlen(path) == 0) + { + errno = EINVAL; + return -1; + } + if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) + { + errno = ENAMETOOLONG; + return -1; + } + + /* Get the parent path */ +#if (defined _MSC_VER || defined __MINGW32__) +#if ((defined _MSC_VER) && (_MSC_VER >= 1400)) + _tsplitpath_s( + path, + drive_buf, _TINYDIR_DRIVE_MAX, + dir_name_buf, _TINYDIR_FILENAME_MAX, + file_name_buf, _TINYDIR_FILENAME_MAX, + ext_buf, _TINYDIR_FILENAME_MAX); +#else + _tsplitpath( + path, + drive_buf, + dir_name_buf, + file_name_buf, + ext_buf); +#endif + +/* _splitpath_s not work fine with only filename and widechar support */ +#ifdef _UNICODE + if (drive_buf[0] == L'\xFEFE') + drive_buf[0] = '\0'; + if (dir_name_buf[0] == L'\xFEFE') + dir_name_buf[0] = '\0'; +#endif + + if (errno) + { + errno = EINVAL; + return -1; + } + /* Emulate the behavior of dirname by returning "." for dir name if it's + empty */ + if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0') + { + _tinydir_strcpy(dir_name_buf, TINYDIR_STRING(".")); + } + /* Concatenate the drive letter and dir name to form full dir name */ + _tinydir_strcat(drive_buf, dir_name_buf); + dir_name = drive_buf; + /* Concatenate the file name and extension to form base name */ + _tinydir_strcat(file_name_buf, ext_buf); + base_name = file_name_buf; +#else + _tinydir_strcpy(dir_name_buf, path); + dir_name = dirname(dir_name_buf); + _tinydir_strcpy(file_name_buf, path); + base_name =basename(file_name_buf); +#endif + + /* Open the parent directory */ + if (tinydir_open(&dir, dir_name) == -1) + { + return -1; + } + + /* Read through the parent directory and look for the file */ + while (dir.has_next) + { + if (tinydir_readfile(&dir, file) == -1) + { + result = -1; + goto bail; + } + if (_tinydir_strcmp(file->name, base_name) == 0) + { + /* File found */ + found = 1; + break; + } + tinydir_next(&dir); + } + if (!found) + { + result = -1; + errno = ENOENT; + } + +bail: + tinydir_close(&dir); + return result; +} + +_TINYDIR_FUNC +void _tinydir_get_ext(tinydir_file *file) +{ + _tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.')); + if (period == NULL) + { + file->extension = &(file->name[_tinydir_strlen(file->name)]); + } + else + { + file->extension = period + 1; + } +} + +_TINYDIR_FUNC +int _tinydir_file_cmp(const void *a, const void *b) +{ + const tinydir_file *fa = (const tinydir_file *)a; + const tinydir_file *fb = (const tinydir_file *)b; + if (fa->is_dir != fb->is_dir) + { + return -(fa->is_dir - fb->is_dir); + } + return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX); +} + +#ifndef _MSC_VER +#ifndef _TINYDIR_USE_READDIR +/* +The following authored by Ben Hutchings +from https://womble.decadent.org.uk/readdir_r-advisory.html +*/ +/* Calculate the required buffer size (in bytes) for directory * +* entries read from the given directory handle. Return -1 if this * +* this cannot be done. * +* * +* This code does not trust values of NAME_MAX that are less than * +* 255, since some systems (including at least HP-UX) incorrectly * +* define it to be a smaller value. */ +_TINYDIR_FUNC +size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp) +{ + long name_max; + size_t name_end; + /* parameter may be unused */ + (void)dirp; + +#if defined _TINYDIR_USE_FPATHCONF + name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX); + if (name_max == -1) +#if defined(NAME_MAX) + name_max = (NAME_MAX > 255) ? NAME_MAX : 255; +#else + return (size_t)(-1); +#endif +#elif defined(NAME_MAX) + name_max = (NAME_MAX > 255) ? NAME_MAX : 255; +#else +#error "buffer size for readdir_r cannot be determined" +#endif + name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1; + return (name_end > sizeof(struct _tinydir_dirent) ? + name_end : sizeof(struct _tinydir_dirent)); +} +#endif +#endif + +#ifdef __cplusplus +} +#endif + +# if defined (_MSC_VER) +# pragma warning(pop) +# endif + +#endif diff --git a/unix/configure b/unix/configure index 53e0a07..08c97e9 100755 --- a/unix/configure +++ b/unix/configure @@ -10286,8 +10286,8 @@ $as_echo "Found INFO Zip in environment" >&6; } # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o" - ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 $as_echo "No zip found on PATH building minizip" >&6; } diff --git a/unix/tcl.m4 b/unix/tcl.m4 index dbc92da..81c0601 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -3136,8 +3136,8 @@ AC_DEFUN([SC_ZIPFS_SUPPORT], [ # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o" - ZIP_PROG_VFSSEARCH="\"`find . -type f`\"" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH building minizip]) fi diff --git a/win/configure b/win/configure index f0159d1..bc851bc 100755 --- a/win/configure +++ b/win/configure @@ -5011,8 +5011,8 @@ $as_echo "Found INFO Zip in environment" >&6; } # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o" - ZIP_PROG_VFSSEARCH="\"\`find . -type f\`\"" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 $as_echo "No zip found on PATH building minizip" >&6; } diff --git a/win/tcl.m4 b/win/tcl.m4 index c56cd09..4f5b562 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -1424,8 +1424,8 @@ AC_DEFUN([SC_ZIPFS_SUPPORT], [ # It is not an error if an installed version of Zip can't be located. # We can use the locally distributed minizip instead ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o" - ZIP_PROG_VFSSEARCH="\"\`find . -type f\`\"" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" AC_MSG_RESULT([No zip found on PATH building minizip]) fi -- cgit v0.12 From 334149646f5c9c764a5fd5c7c0c9eaee1d90c04e Mon Sep 17 00:00:00 2001 From: tne Date: Tue, 21 Nov 2017 04:26:37 +0000 Subject: Fixes to "make clean" to do a better job of cleaning up zip files and vfs directories Fixed a type that was keeping minizip from building --- unix/Makefile.in | 24 ++---------------------- win/Makefile.in | 26 ++++---------------------- 2 files changed, 6 insertions(+), 44 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 98c5865..d6152a6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -720,7 +720,7 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: clean-packages rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ - minizip${EXEEXT_FOR_BUILD} *.${HOST_OBJEXT} + minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs cd dltest ; $(MAKE) clean distclean: distclean-packages clean @@ -1864,29 +1864,9 @@ zutil.$(HOST_OBJEXT): minizip.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c -minizip${EXEEXT_FOR_BUILD}: $(MINIZIP_OBJS) +minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) $(HOST_CC) -o $@ $(MINIZIP_OBJS) -tclvfs.zip: minizip${EXEEXT_FOR_BUILD} - rm -rf $(TCL_VFS_ROOT) - mkdir -p $(TCL_VFS_PATH) - @for i in "$(TCL_VFS_PATH)"; \ - do \ - if [ ! -d "$$i" ] ; then \ - echo "Making directory $$i"; \ - $(INSTALL_DATA_DIR) "$$i"; \ - else true; \ - fi; \ - done; - cp -a ../library/* $(TCL_VFS_PATH) - (cd $TCL_VFS ROOT ; ./minizip${EXEEXT_FOR_BUILD} -o ../tclvfs.zip `find . -type f`) - -zipsetupstub.$(HOST_OBJEXT): $(COMPAT_DIR)/zipsetupstub.c - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(COMPAT_DIR)/zipsetupstub.c - -zipsetupstub${EXEEXT_FOR_BUILD}: zipsetupstub.$(HOST_OBJEXT) - $(HOST_CC) -o $@ zipsetupstub.$(HOST_OBJEXT) - #-------------------------------------------------------------------------- # Bundled Package targets #-------------------------------------------------------------------------- diff --git a/win/Makefile.in b/win/Makefile.in index 6734985..49f0bfb 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -663,29 +663,9 @@ zutil.$(HOST_OBJEXT): minizip.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c -minizip${EXEEXT_FOR_BUILD}: $(MINIZIP_OBJS) +minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) $(HOST_CC) -o $@ $(MINIZIP_OBJS) -tclvfs.zip: minizip${EXEEXT_FOR_BUILD} - rm -rf $(TCL_VFS_ROOT) - mkdir -p $(TCL_VFS_PATH) - @for i in "$(TCL_VFS_PATH)"; \ - do \ - if [ ! -d "$$i" ] ; then \ - echo "Making directory $$i"; \ - $(INSTALL_DATA_DIR) "$$i"; \ - else true; \ - fi; \ - done; - cp -a ../library/* $(TCL_VFS_PATH) - (cd $TCL_VFS ROOT ; ./minizip${EXEEXT_FOR_BUILD} -o ../tclvfs.zip `find . -type f`) - -zipsetupstub.$(HOST_OBJEXT): $(COMPAT_DIR)/zipsetupstub.c - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(COMPAT_DIR)/zipsetupstub.c - -zipsetupstub${EXEEXT_FOR_BUILD}: zipsetupstub.$(HOST_OBJEXT) - $(HOST_CC) -o $@ zipsetupstub.$(HOST_OBJEXT) - # The following target generates the file generic/tclDate.c from the yacc # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is # not available in all environments. The name of the .c file is different than @@ -916,7 +896,9 @@ clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb - minizip${EXEEXT_FOR_BUILD} *.${HOST_OBJEXT} + $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} + $(RM) *.zip + $(RMDIR) *.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ -- cgit v0.12 From 011dd7b0f6b3f7eae43f139e2c0b654387718fd8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Nov 2017 09:13:08 +0000 Subject: Revert [d874801c57]: putting back "string bytelength". It turns out to be too complicated to take along with the other deprecations in TIP #485 --- doc/string.n | 4 ++-- generic/tclCmdMZ.c | 4 ---- library/init.tcl | 4 ++-- tests/info.test | 4 ++-- tests/regexp.test | 4 ++-- tests/regexpComp.test | 4 ++-- 6 files changed, 10 insertions(+), 14 deletions(-) diff --git a/doc/string.n b/doc/string.n index 730f49e..00ce85c 100644 --- a/doc/string.n +++ b/doc/string.n @@ -386,8 +386,8 @@ store the representation is of very low value (except to C extension code, which has direct access for the purpose of memory management, etc.) .PP -\fICompatibility note:\fR this subcommand will be gone in -Tcl 9.0. It is better to use the +\fICompatibility note:\fR it is likely that this subcommand will be +withdrawn in a future version of Tcl. It is better to use the \fBencoding convertto\fR command to convert a string to a known encoding and then apply \fBstring length\fR to that. .PP diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 14ea6ad..67fbc94 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2893,7 +2893,6 @@ StringCatCmd( * *---------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 static int StringBytesCmd( ClientData dummy, /* Not used. */ @@ -2912,7 +2911,6 @@ StringBytesCmd( Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); return TCL_OK; } -#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ /* *---------------------------------------------------------------------- @@ -3370,9 +3368,7 @@ TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, -#endif {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, diff --git a/library/init.tcl b/library/init.tcl index a3ee05f..13a4300 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -279,9 +279,9 @@ proc unknown args { set errInfo [dict get $opts -errorinfo] set errCode [dict get $opts -errorcode] set cinfo $args - if {[string length $cinfo] > 150} { + if {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 150] - while {[string length $cinfo] > 150} { + while {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 end-1] } append cinfo ... diff --git a/tests/info.test b/tests/info.test index ac4b98c..fd89b47 100644 --- a/tests/info.test +++ b/tests/info.test @@ -103,8 +103,8 @@ test info-2.5 {info body option, returning bytecompiled bodies} -body { # causing an empty string to be returned [Bug #545644] test info-2.6 {info body option, returning list bodies} { proc foo args [list subst bar] - list [string length [info body foo]] \ - [foo; string length [info body foo]] + list [string bytelength [info body foo]] \ + [foo; string bytelength [info body foo]] } {9 9} proc testinfocmdcount {} { diff --git a/tests/regexp.test b/tests/regexp.test index 62cadd3..7367af7 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -760,8 +760,8 @@ test regexp-20.1 {regsub shared object shimmering} { set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d - list $d [string length $d] -} [list abcdefghijklmnopqurstuvwxyz0123456789 37] + list $d [string length $d] [string bytelength $d] +} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexp-20.2 {regsub shared object shimmering with -about} { eval regexp -about abc } {0 {}} diff --git a/tests/regexpComp.test b/tests/regexpComp.test index dc7b909..fbf8012 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -798,9 +798,9 @@ test regexpComp-20.1 {regsub shared object shimmering} { set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d - list $d [string length $d] + list $d [string length $d] [string bytelength $d] } -} [list abcdefghijklmnopqurstuvwxyz0123456789 37] +} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexpComp-20.2 {regsub shared object shimmering with -about} { evalInProc { eval regexp -about abc -- cgit v0.12 From 119652bd95761672adbaaae020c3c30141104a19 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Nov 2017 09:48:36 +0000 Subject: deprecate VOID/CHAR/SHORT/LONG (windows-only) as well. --- generic/tcl.h | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index e054c19..e85988f 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -299,6 +299,7 @@ extern "C" { * VOID. This block is skipped under Cygwin and Mingw. */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) #ifndef VOID #define VOID void @@ -314,23 +315,16 @@ typedef long LONG; */ #ifndef __VXWORKS__ -# ifndef NO_VOID -# define VOID void -# else -# define VOID char -# endif +# define VOID void #endif +#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ /* * Miscellaneous declarations. */ #ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif + typedef void *ClientData; # define _CLIENTDATA #endif -- cgit v0.12 From 35adf8c728b9c0592670777b6beada9fdd6efa70 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Nov 2017 14:21:48 +0000 Subject: Removing the pool of literal values within the internals of tclZipfs.c. Replaced with a single pointer to a const string once discovery has sorted out where tcl_library is to be loaded from. Fixed a goof in the build system if tcl is compiled outside of the source directory --- generic/tclZipfs.c | 76 ++++++++++++++---------------------------------------- unix/Makefile.in | 2 +- unix/tcl.pc.in | 2 ++ win/Makefile.in | 2 +- 4 files changed, 23 insertions(+), 59 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index a954dd6..03170a1 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -297,11 +297,7 @@ static const unsigned long crc32tab[256] = { 0x2d02ef8d, }; -static Tcl_Obj *zipfs_literal_fstype=NULL; -static Tcl_Obj *zipfs_literal_fsroot=NULL; -static Tcl_Obj *zipfs_literal_fsseparator=NULL; -static Tcl_Obj *zipfs_literal_null=NULL; -static Tcl_Obj *zipfs_literal_tcl_library=NULL; +const char *zipfs_literal_tcl_library=NULL; /* @@ -1440,13 +1436,7 @@ static int ZipFSRootObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - if(!zipfs_literal_fsroot) { - zipfs_literal_fsroot=Tcl_NewStringObj(ZIPFS_VOLUME, -1); - Tcl_IncrRefCount(zipfs_literal_fsroot); - } - Tcl_IncrRefCount(zipfs_literal_fsroot); - Tcl_SetObjResult(interp,zipfs_literal_fsroot); - return TCL_OK; + return Tcl_NewStringObj(ZIPFS_VOLUME, -1); } /* @@ -2450,12 +2440,7 @@ ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp, Tcl_Obj *pResult; pResult=TclZipfs_TclLibrary(); if(!pResult) { - if(!zipfs_literal_null) { - zipfs_literal_null=Tcl_NewObj(); - Tcl_IncrRefCount(zipfs_literal_null); - } - pResult=zipfs_literal_null; - Tcl_IncrRefCount(zipfs_literal_null); + pResult=Tcl_NewObj(); } Tcl_SetObjResult(interp,pResult); return TCL_OK; @@ -3252,12 +3237,7 @@ Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) static Tcl_Obj * Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) { - if(!zipfs_literal_fsseparator) { - zipfs_literal_fsseparator=Tcl_NewStringObj("/", -1); - Tcl_IncrRefCount(zipfs_literal_fsseparator); - } - Tcl_IncrRefCount(zipfs_literal_fsseparator); - return zipfs_literal_fsseparator; + return Tcl_NewStringObj("/", -1); } /* @@ -3518,12 +3498,7 @@ endloop: */ static Tcl_Obj * Zip_FSListVolumesProc(void) { - if(!zipfs_literal_fsroot) { - zipfs_literal_fsroot=Tcl_NewStringObj(ZIPFS_VOLUME, -1); - Tcl_IncrRefCount(zipfs_literal_fsroot); - } - Tcl_IncrRefCount(zipfs_literal_fsroot); - return zipfs_literal_fsroot; + return Tcl_NewStringObj(ZIPFS_VOLUME, -1); } /* @@ -3670,12 +3645,7 @@ Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, static Tcl_Obj * Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) { - if(!zipfs_literal_fstype) { - zipfs_literal_fstype=Tcl_NewStringObj("zip", -1); - Tcl_IncrRefCount(zipfs_literal_fstype); - } - Tcl_IncrRefCount(zipfs_literal_fstype); - return zipfs_literal_fstype; + return Tcl_NewStringObj("zip", -1); } @@ -3959,8 +3929,7 @@ static int TclZipfs_AppHook_FindTclInit(const char *archive){ found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); if(found==0) { - zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT,-1); - Tcl_IncrRefCount(zipfs_literal_tcl_library); + zipfs_literal_tcl_library=ZIPFS_ZIP_MOUNT; return TCL_OK; } vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl",-1); @@ -3968,8 +3937,7 @@ static int TclZipfs_AppHook_FindTclInit(const char *archive){ found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); if(found==0) { - zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library",-1); - Tcl_IncrRefCount(zipfs_literal_tcl_library); + zipfs_literal_tcl_library=ZIPFS_ZIP_MOUNT "/tcl_library"; return TCL_OK; } return TCL_ERROR; @@ -4020,7 +3988,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) " {" ZIPFS_ZIP_MOUNT "/tk_library}\n" " {" ZIPFS_VOLUME "lib/tk/tk_library}\n" "} {\n" -" if {[file exists [file join $path init.tcl]]} continue\n" +" if {![file exists [file join $path init.tcl]]} continue\n" " set ::tk_library $path\n" " break\n" "}\n" @@ -4043,8 +4011,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); if(found==TCL_OK) { - zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library",-1); - Tcl_IncrRefCount(zipfs_literal_tcl_library); + zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library"; return TCL_OK; } } @@ -4085,9 +4052,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); if(found==TCL_OK) { - zipfs_literal_tcl_library=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library",-1); - Tcl_IncrRefCount(zipfs_literal_tcl_library); - zipfs_literal_tcl_library=vfsinitscript; + zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library"; return TCL_OK; } } @@ -4097,10 +4062,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) } Tcl_Obj *TclZipfs_TclLibrary(void) { - if(zipfs_literal_tcl_library) { - Tcl_IncrRefCount(zipfs_literal_tcl_library); - return zipfs_literal_tcl_library; - } else { + if(!zipfs_literal_tcl_library) { #if defined(_WIN32) || defined(_WIN64) HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; @@ -4113,20 +4075,20 @@ Tcl_Obj *TclZipfs_TclLibrary(void) { } /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { - Tcl_IncrRefCount(zipfs_literal_tcl_library); - return zipfs_literal_tcl_library; + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #else /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { - Tcl_IncrRefCount(zipfs_literal_tcl_library); - return zipfs_literal_tcl_library; + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #endif + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } } - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { - Tcl_IncrRefCount(zipfs_literal_tcl_library); - return zipfs_literal_tcl_library; + if(zipfs_literal_tcl_library) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } return NULL; } diff --git a/unix/Makefile.in b/unix/Makefile.in index d6152a6..db98646 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -675,7 +675,7 @@ tclzipfile: ${TCL_ZIP_FILE} ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} rm -rf ${TCL_VFS_ROOT} mkdir -p ${TCL_VFS_PATH} - cp -a ../library/* ${TCL_VFS_PATH} + cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH} cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} # The following target is configured by autoconf to generate either a shared diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in index 846cb11..ca932d2 100644 --- a/unix/tcl.pc.in +++ b/unix/tcl.pc.in @@ -4,6 +4,8 @@ prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ +libfile=@TCL_LIB_FILE@ +zipfile=@TCL_ZIP_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. diff --git a/win/Makefile.in b/win/Makefile.in index 49f0bfb..768178d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -483,7 +483,7 @@ tclzipfile: ${TCL_ZIP_FILE} ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} rm -rf ${TCL_VFS_ROOT} mkdir -p ${TCL_VFS_PATH} - cp -a ../library/* ${TCL_VFS_PATH} + $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH} cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) -- cgit v0.12 From 9215c2610ca2f4938aa0947bcbd1ecd19a8e5009 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Nov 2017 14:59:04 +0000 Subject: Drop Windows CE support, since it doesn't appear to work anyway. --- generic/tclIntPlatDecls.h | 2 ++ generic/tclStubInit.c | 2 -- win/tclWin32Dll.c | 24 ++++++++---------------- win/tclWinInit.c | 12 ++---------- win/tclWinInt.h | 13 ------------- win/tclWinPipe.c | 45 ++++++++++++++------------------------------- 6 files changed, 26 insertions(+), 72 deletions(-) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index ac06787..5003323 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -559,6 +559,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; # define TclWinGetServByName getservbyname # define TclWinGetSockOpt getsockopt # define TclWinSetSockOpt setsockopt +# undef TclWinGetPlatformId +# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */ #else # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index b185f04..465dacc 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -118,8 +118,6 @@ TclpIsAtty(int fd) static int TclWinGetPlatformId() { - /* Don't bother to determine the real platform on cygwin, - * because VER_PLATFORM_WIN32_NT is the only supported platform */ return 2; /* VER_PLATFORM_WIN32_NT */; } diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 84c7a97..e482869 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -23,7 +23,6 @@ */ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ -static int platformId; /* Running under NT, or 95/98? */ /* * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it @@ -186,18 +185,14 @@ TclWinInit( hInstance = hInst; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); GetVersionExW(&os); - platformId = os.dwPlatformId; /* - * We no longer support Win32s or Win9x, so just in case someone manages - * to get a runtime there, make sure they know that. + * We no longer support Win32s or Win9x or Windows CE, so just in case + * someone manages to get a runtime there, make sure they know that. */ - if (platformId == VER_PLATFORM_WIN32s) { - Tcl_Panic("Win32s is not a supported platform"); - } - if (platformId == VER_PLATFORM_WIN32_WINDOWS) { - Tcl_Panic("Windows 9x is not a supported platform"); + if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) { + Tcl_Panic("Windows NT is the only supported platform"); } TclWinResetInterfaces(); @@ -212,22 +207,19 @@ TclWinInit( * conditional code. * * Results: - * The return value is one of: - * VER_PLATFORM_WIN32s Win32s on Windows 3.1 (not supported) - * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported) - * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP - * VER_PLATFORM_WIN32_CE Win32 on Windows CE + * The return value is: + * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP, 7, 8, 8.1, 10 * * Side effects: * None. * *---------------------------------------------------------------------- */ - +#undef TclWinGetPlatformId int TclWinGetPlatformId(void) { - return platformId; + return VER_PLATFORM_WIN32_NT; } /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 98c7ed5..ec5582c 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -84,15 +84,10 @@ TclWinProcs tclWinProcs; /* * The following arrays contain the human readable strings for the Windows - * platform and processor values. + * processor values. */ -#define NUMPLATFORMS 4 -static const char *const platforms[NUMPLATFORMS] = { - "Win32s", "Windows 95", "Windows NT", "Windows CE" -}; - #define NUMPROCESSORS 11 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", @@ -568,10 +563,7 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", TCL_GLOBAL_ONLY); - if (osInfo.dwPlatformId < NUMPLATFORMS) { - Tcl_SetVar2(interp, "tcl_platform", "os", - platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); - } + Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 43799d0..d72cc43 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -40,19 +40,6 @@ typedef struct TclWinProcs { MODULE_SCOPE TclWinProcs tclWinProcs; -/* - * Some versions of Borland C have a define for the OSVERSIONINFO for - * Win32s and for NT, but not for Windows 95. - * Define VER_PLATFORM_WIN32_CE for those without newer headers. - */ - -#ifndef VER_PLATFORM_WIN32_WINDOWS -#define VER_PLATFORM_WIN32_WINDOWS 1 -#endif -#ifndef VER_PLATFORM_WIN32_CE -#define VER_PLATFORM_WIN32_CE 3 -#endif - #ifdef _WIN64 # define TCL_I_MODIFIER "I" #else diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4b372a5..b4812ee 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1095,40 +1095,23 @@ TclpCreateProcess( * detached processes. The GUI window will still pop up to the foreground. */ - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - if (HasConsole()) { + if (HasConsole()) { createFlags = 0; - } else if (applType == APPL_DOS) { - /* - * Under NT, 16-bit DOS applications will not run unless they can - * be attached to a console. If we are running without a console, - * run the 16-bit program as an normal process inside of a hidden - * console application, and then run that hidden console as a - * detached process. - */ + } else if (applType == APPL_DOS) { + /* + * Under NT, 16-bit DOS applications will not run unless they can + * be attached to a console. If we are running without a console, + * run the 16-bit program as an normal process inside of a hidden + * console application, and then run that hidden console as a + * detached process. + */ - startInfo.wShowWindow = SW_HIDE; - startInfo.dwFlags |= STARTF_USESHOWWINDOW; - createFlags = CREATE_NEW_CONSOLE; - TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); - } else { - createFlags = DETACHED_PROCESS; - } + startInfo.wShowWindow = SW_HIDE; + startInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = CREATE_NEW_CONSOLE; + TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); } else { - if (HasConsole()) { - createFlags = 0; - } else { - createFlags = DETACHED_PROCESS; - } - - if (applType == APPL_DOS) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "DOS application process not supported on this platform", - -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP", - NULL); - goto end; - } + createFlags = DETACHED_PROCESS; } /* -- cgit v0.12 From 8225859a93e2e55934b39855a9f4f736555bc474 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Nov 2017 16:49:24 +0000 Subject: Eliminated the need for a preinit script in Tip 430's AppHook. tcl_findLibrary now knows to scan the dll offered up by [info loaded] to see if an attached zipfile could possibly contain the files the extension is looking for. --- generic/tclZipfs.c | 41 ++++++++--------------------------------- library/auto.tcl | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 33 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 03170a1..fa5b1a3 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -1013,7 +1013,6 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, Tcl_HashEntry *hPtr; Tcl_DString ds, fpBuf; unsigned char *q; - ReadLock(); if (!ZipFS.initialized) { if (interp != NULL) { @@ -1436,7 +1435,8 @@ static int ZipFSRootObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - return Tcl_NewStringObj(ZIPFS_VOLUME, -1); + Tcl_SetObjResult(interp,Tcl_NewStringObj(ZIPFS_VOLUME, -1)); + return TCL_OK; } /* @@ -3920,6 +3920,9 @@ ToUtf( static int TclZipfs_AppHook_FindTclInit(const char *archive){ Tcl_Obj *vfsinitscript; int found; + if(zipfs_literal_tcl_library) { + return TCL_ERROR; + } if(TclZipfs_Mount(NULL, archive, ZIPFS_ZIP_MOUNT, NULL)) { /* Either the file doesn't exist or it is not a zip archive */ return TCL_ERROR; @@ -3963,36 +3966,6 @@ int TclZipfs_AppHook(int *argc, char ***argv) ** and failing that, look for a file name CFG_RUNTIME_ZIPFILE adjacent to the ** executable */ - TclSetPreInitScript( -"foreach {path} {\n" -" {" ZIPFS_APP_MOUNT "/tcl_library}\n" -" {" ZIPFS_ZIP_MOUNT "/tcl_library}\n" -"} {\n" -" if {![file exists [file join $path init.tcl]]} continue\n" -" set ::tcl_library $path\n" -" break\n" -"}\n" -"if {![info exists ::tcl_library] || $::tcl_library eq {}} {\n" -" set zipfile [file join [file dirname [info nameofexecutable]] " CFG_RUNTIME_ZIPFILE "]\n" -" if {[file exists $zipfile]} {\n" -" zipfs mount $zipfile {" ZIPFS_ZIP_MOUNT "}\n" -" if {[file exists [file join {" ZIPFS_ZIP_MOUNT "} init.tcl]]} \{\n" -" set ::tcl_library {" ZIPFS_ZIP_MOUNT "}\n" -" } else {\n" -" zipfs unmount {" ZIPFS_ZIP_MOUNT "}\n" -" }\n" -" }\n" -"}\n" -"foreach {path} {\n" -" {" ZIPFS_APP_MOUNT "/tk_library}\n" -" {" ZIPFS_ZIP_MOUNT "/tk_library}\n" -" {" ZIPFS_VOLUME "lib/tk/tk_library}\n" -"} {\n" -" if {![file exists [file join $path init.tcl]]} continue\n" -" set ::tk_library $path\n" -" break\n" -"}\n" - ); if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { int found; Tcl_Obj *vfsinitscript; @@ -4062,7 +4035,9 @@ int TclZipfs_AppHook(int *argc, char ***argv) } Tcl_Obj *TclZipfs_TclLibrary(void) { - if(!zipfs_literal_tcl_library) { + if(zipfs_literal_tcl_library) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } else { #if defined(_WIN32) || defined(_WIN64) HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; diff --git a/library/auto.tcl b/library/auto.tcl index a7a8979..d8f9d88 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -74,6 +74,54 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { lappend dirs $env($enVarName) } + catch { + set found 0 + set root [zipfs root] + set mountpoint [file join $root lib [string tolower $basename]] + lappend dirs [file join $root app ${basename}_library] + lappend dirs [file join $root lib $mountpoint ${basename}_library] + lappend dirs [file join $root lib $mountpoint] + if {![zipfs exists [file join $root app ${basename}_library]] && ![zipfs exists $mountpoint]} { + set found 0 + foreach pkgdat [info loaded] { + lassign $pkgdat dllfile dllpkg + if {[string tolower $dllpkg] ne [string tolower $basename]} continue + if {$dllfile eq {}} { + # Loaded statically + break + } + set found 1 + zipfs mount $dllfile $mountpoint + break + } + if {!$found} { + set paths {} + lappend paths [file join $root app] + lappend paths [::${basename}::pkgconfig get libdir,runtime] + lappend paths [::${basename}::pkgconfig get bindir,runtime] + if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} { + set zipfile [string tolower "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"] + } + foreach path $paths { + set archive [file join $path $zipfile] + if {![file exists $archive]} continue + zipfs mount $archive $mountpoint + if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} { + lappend dirs [file join $mountpoint ${basename}_library] + set found 1 + break + } elseif {[zipfs exists [file join $mountpoint $initScript]]} { + lappend dirs [file join $mountpoint $initScript] + set found 1 + break + } else { + catch {zipfs unmount $archive} + } + } + } + } + } + # 2. In the package script directory registered within the # configuration of the package itself. -- cgit v0.12 From d997aa477de14bc3128e4e5ac08713f7c40d647c Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 21 Nov 2017 18:57:31 +0000 Subject: Added additional functions to the "install" command in tclsh --- library/install.tcl | 231 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 231 insertions(+) diff --git a/library/install.tcl b/library/install.tcl index f126b37..e62226e 100644 --- a/library/install.tcl +++ b/library/install.tcl @@ -5,9 +5,240 @@ if {[llength $argv] < 2} { exit 0 } +namespace eval ::practcl {} +### +# Installer tools +### +proc ::practcl::_isdirectory name { + return [file isdirectory $name] +} +### +# Return true if the pkgindex file contains +# any statement other than "package ifneeded" +# and/or if any package ifneeded loads a DLL +### +proc ::practcl::_pkgindex_directory {path} { + set buffer {} + set pkgidxfile [file join $path pkgIndex.tcl] + if {![file exists $pkgidxfile]} { + # No pkgIndex file, read the source + foreach file [glob -nocomplain $path/*.tm] { + set file [file normalize $file] + set fname [file rootname [file tail $file]] + ### + # We used to be able to ... Assume the package is correct in the filename + # No hunt for a "package provides" + ### + set package [lindex [split $fname -] 0] + set version [lindex [split $fname -] 1] + ### + # Read the file, and override assumptions as needed + ### + set fin [open $file r] + set dat [read $fin] + close $fin + # Look for a teapot style Package statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 9] != "# Package " } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + } + foreach file [glob -nocomplain $path/*.tcl] { + if { [file tail $file] == "version_info.tcl" } continue + set fin [open $file r] + set dat [read $fin] + close $fin + if {![regexp "package provide" $dat]} continue + set fname [file rootname [file tail $file]] + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + if {[string index $package 0] in "\$ \[ @"} continue + if {[string index $version 0] in "\$ \[ @"} continue + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + break + } + } + return $buffer + } + set fin [open $pkgidxfile r] + set dat [read $fin] + close $fin + set trace 0 + #if {[file tail $path] eq "tool"} { + # set trace 1 + #} + set thisline {} + foreach line [split $dat \n] { + append thisline $line \n + if {![info complete $thisline]} continue + set line [string trim $line] + if {[string length $line]==0} { + set thisline {} ; continue + } + if {[string index $line 0] eq "#"} { + set thisline {} ; continue + } + if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} { + if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"} + set thisline {} ; continue + } + if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} { + if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" } + set thisline {} ; continue + } + if {![regexp "package.*ifneeded" $thisline]} { + # This package index contains arbitrary code + # source instead of trying to add it to the master + # package index + if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" } + return {source [file join $dir pkgIndex.tcl]} + } + append buffer $thisline \n + set thisline {} + } + if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]} + return $buffer +} + + +proc ::practcl::_pkgindex_path_subdir {path} { + set result {} + foreach subpath [glob -nocomplain [file join $path *]] { + if {[file isdirectory $subpath]} { + lappend result $subpath {*}[_pkgindex_path_subdir $subpath] + } + } + return $result +} +### +# Index all paths given as though they will end up in the same +# virtual file system +### +proc ::practcl::pkgindex_path args { + set stack {} + set buffer { +lappend ::PATHSTACK $dir + } + foreach base $args { + set base [file normalize $base] + set paths {} + foreach dir [glob -nocomplain [file join $base *]] { + if {[file tail $dir] eq "teapot"} continue + lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir] + } + set i [string length $base] + # Build a list of all of the paths + if {[llength $paths]} { + foreach path $paths { + if {$path eq $base} continue + set path_indexed($path) 0 + } + } else { + puts [list WARNING: NO PATHS FOUND IN $base] + } + set path_indexed($base) 1 + set path_indexed([file join $base boot tcl]) 1 + foreach teapath [glob -nocomplain [file join $base teapot *]] { + set pkg [file tail $teapath] + append buffer [list set pkg $pkg] + append buffer { +set pkginstall [file join $::g(HOME) teapot $pkg] +if {![file exists $pkginstall]} { + installDir [file join $dir teapot $pkg] $pkginstall +} +} + } + foreach path $paths { + if {$path_indexed($path)} continue + set thisdir [file_relative $base $path] + set idxbuf [::practcl::_pkgindex_directory $path] + if {[string length $idxbuf]} { + incr path_indexed($path) + append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n + append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n + } + } + } + append buffer { +set dir [lindex $::PATHSTACK end] +set ::PATHSTACK [lrange $::PATHSTACK 0 end-1] +} + return $buffer +} + +### +# topic: 64319f4600fb63c82b2258d908f9d066 +# description: Script to build the VFS file system +### +proc ::practcl::installDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]] + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + installDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +proc ::practcl::copyDir {d1 d2 {toplevel 1}} { + #if {$toplevel} { + # puts [list ::practcl::copyDir $d1 -> $d2] + #} + #file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] 0 + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + } + } +} + switch [lindex $argv 1] { mkzip { zipfs mkzip {*}[lrange $argv 2 end] } + mkzip { + zipfs mkimg {*}[lrange $argv 2 end] + } + default { + ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end] + } } exit 0 -- cgit v0.12 From 2d811a0adff9b3a837a8bd2111d6f88742c9f5d5 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 23 Nov 2017 11:55:03 +0000 Subject: Fixing a goof, Zipfs was looking for the Dll where the installer put the file, which is not necessarily where the file will be found at runtime. --- generic/tclZipfs.c | 7 +++++-- unix/Makefile.in | 3 ++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index fa5b1a3..2d475f0 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4054,11 +4054,14 @@ Tcl_Obj *TclZipfs_TclLibrary(void) { } #else /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #endif - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_PATH "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SRCDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } } diff --git a/unix/Makefile.in b/unix/Makefile.in index db98646..3229934 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1409,7 +1409,8 @@ tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c $(CC) -c $(CC_SWITCHES) \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ - -DCFG_RUNTIME_PATH="\"$(DLL_INSTALL_DIR)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) -- cgit v0.12 From dd0e9cf6b16cf0a4331b972cb7fac3786644587d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Nov 2017 12:04:33 +0000 Subject: Remove more pre-XP stuff. --- generic/tclStubInit.c | 14 ++--- win/configure | 138 ++------------------------------------------------ win/tcl.m4 | 108 ++------------------------------------- win/tclWin32Dll.c | 24 --------- 4 files changed, 13 insertions(+), 271 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1c11c61..808f5d3 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -105,6 +105,13 @@ static const char *TclGetStartupScriptFileName(void) static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } +#undef TclWinGetPlatformId +#define TclWinGetPlatformId winGetPlatformId +static int +TclWinGetPlatformId() +{ + return 2; /* VER_PLATFORM_WIN32_NT */; +} #endif # define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt # define TclBNInitBignumFromWideInt TclInitBignumFromWideInt @@ -132,13 +139,6 @@ TclpIsAtty(int fd) return isatty(fd); } -#define TclWinGetPlatformId winGetPlatformId -static int -TclWinGetPlatformId() -{ - return 2; /* VER_PLATFORM_WIN32_NT */; -} - void *TclWinGetTclInstance() { void *hInstance = NULL; diff --git a/win/configure b/win/configure index fdd3adb..0ef82a5 100755 --- a/win/configure +++ b/win/configure @@ -706,7 +706,6 @@ CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG DL_LIBS -CELIB_DIR CYGPATH TCL_THREADS SET_MAKE @@ -768,8 +767,6 @@ enable_threads with_encoding enable_shared enable_64bit -enable_wince -with_celib enable_symbols enable_embedded_manifest ' @@ -1392,7 +1389,6 @@ Optional Features: --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) - --enable-wince enable Win/CE support (where applicable) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) @@ -1401,7 +1397,6 @@ Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values - --with-celib=DIR use Windows/CE support library from DIR Some influential environment variables: CC C compiler command @@ -3811,33 +3806,6 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 $as_echo "$do64bit" >&6; } - # Cross-compiling options for Windows/CE builds - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Windows/CE build is requested" >&5 -$as_echo_n "checking if Windows/CE build is requested... " >&6; } - # Check whether --enable-wince was given. -if test "${enable_wince+set}" = set; then : - enableval=$enable_wince; doWince=$enableval -else - doWince=no -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doWince" >&5 -$as_echo "$doWince" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows/CE celib directory" >&5 -$as_echo_n "checking for Windows/CE celib directory... " >&6; } - -# Check whether --with-celib was given. -if test "${with_celib+set}" = set; then : - withval=$with_celib; CELIB_DIR=$withval -else - CELIB_DIR=NO_CELIB -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CELIB_DIR" >&5 -$as_echo "$CELIB_DIR" >&6; } - # Set some defaults (may get changed below) EXTRA_CFLAGS="" @@ -4112,7 +4080,7 @@ $as_echo_n "checking compiler flags... " >&6; } SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" + LIBS_GUI="-luxtheme -lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -4336,107 +4304,7 @@ fi LINKBIN="link" fi - if test "$doWince" != "no" ; then - # Set defaults for common evc4/PPC2003 setup - # Currently Tcl requires 300+, possibly 420+ for sockets - CEVERSION=420; # could be 211 300 301 400 420 ... - TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... - ARCH=ARM; # could be ARM MIPS X86EM ... - PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" - if test "$doWince" != "yes"; then - # If !yes then the user specified something - # Reset ARCH to allow user to skip specifying it - ARCH= - eval `echo $doWince | awk -F "," '{ \ - if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \ - if ($1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ - if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \ - if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \ - if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \ - }'` - if test "x${ARCH}" = "x" ; then - ARCH=$TARGETCPU; - fi - fi - OSVERSION=WCE$CEVERSION; - if test "x${WCEROOT}" = "x" ; then - WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" - if test ! -d "${WCEROOT}" ; then - WCEROOT="C:/Program Files/Microsoft eMbedded Tools" - fi - fi - if test "x${SDKROOT}" = "x" ; then - SDKROOT="C:/Program Files/Windows CE Tools" - if test ! -d "${SDKROOT}" ; then - SDKROOT="C:/Windows CE Tools" - fi - fi - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. - WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` - SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` - CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` - if test ! -d "${CELIB_DIR}/inc"; then - as_fn_error $? "Invalid celib directory \"${CELIB_DIR}\"" "$LINENO" 5 - fi - if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ - -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then - as_fn_error $? "could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" "$LINENO" 5 - else - CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" - if test -d "${CEINCLUDE}/${TARGETCPU}" ; then - CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" - fi - CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" - fi - fi - - if test "$doWince" != "no" ; then - CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" - if test "${TARGETCPU}" = "X86"; then - CC="${CEBINROOT}/cl.exe" - else - CC="${CEBINROOT}/cl${ARCH}.exe" - fi - CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" - RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" - arch=`echo ${ARCH} | awk '{print tolower($0)}'` - defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS" - for i in $defs ; do - cat >>confdefs.h <<_ACEOF -#define $i 1 -_ACEOF - - done -# if test "${ARCH}" = "X86EM"; then -# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION) -# fi - cat >>confdefs.h <<_ACEOF -#define _WIN32_WCE $CEVERSION -_ACEOF - - cat >>confdefs.h <<_ACEOF -#define UNDER_CE $CEVERSION -_ACEOF - - CFLAGS_DEBUG="-nologo -Zi -Od" - CFLAGS_OPTIMIZE="-nologo -O2" - lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` - lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" - LINKBIN="\"${CEBINROOT}/link.exe\"" - - if test "${CEVERSION}" -lt 400 ; then - LIBS="coredll.lib corelibc.lib winsock.lib" - else - LIBS="coredll.lib corelibc.lib ws2.lib" - fi - # celib currently stuck at wce300 status - #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib" - LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" - LIBS_GUI="commctrl.lib commdlg.lib" - else - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" - fi + LIBS_GUI="gdi32.lib uxtheme.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' @@ -4467,7 +4335,7 @@ _ACEOF # Specify linker flags depending on the type of app being # built -- Console vs. Window. - if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then + if test "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} else diff --git a/win/tcl.m4 b/win/tcl.m4 index b4fbcce..075cc47 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -544,17 +544,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no]) AC_MSG_RESULT($do64bit) - # Cross-compiling options for Windows/CE builds - - AC_MSG_CHECKING([if Windows/CE build is requested]) - AC_ARG_ENABLE(wince,[ --enable-wince enable Win/CE support (where applicable)], [doWince=$enableval], [doWince=no]) - AC_MSG_RESULT($doWince) - - AC_MSG_CHECKING([for Windows/CE celib directory]) - AC_ARG_WITH(celib,[ --with-celib=DIR use Windows/CE support library from DIR], - CELIB_DIR=$withval, CELIB_DIR=NO_CELIB) - AC_MSG_RESULT([$CELIB_DIR]) - # Set some defaults (may get changed below) EXTRA_CFLAGS="" AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) @@ -675,7 +664,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_LD_LIBS='${LIBS}' LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" + LIBS_GUI="-luxtheme -lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -871,98 +860,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LINKBIN="link" fi - if test "$doWince" != "no" ; then - # Set defaults for common evc4/PPC2003 setup - # Currently Tcl requires 300+, possibly 420+ for sockets - CEVERSION=420; # could be 211 300 301 400 420 ... - TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... - ARCH=ARM; # could be ARM MIPS X86EM ... - PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" - if test "$doWince" != "yes"; then - # If !yes then the user specified something - # Reset ARCH to allow user to skip specifying it - ARCH= - eval `echo $doWince | awk -F "," '{ \ - if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \ - if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ - if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \ - if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \ - if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \ - }'` - if test "x${ARCH}" = "x" ; then - ARCH=$TARGETCPU; - fi - fi - OSVERSION=WCE$CEVERSION; - if test "x${WCEROOT}" = "x" ; then - WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" - if test ! -d "${WCEROOT}" ; then - WCEROOT="C:/Program Files/Microsoft eMbedded Tools" - fi - fi - if test "x${SDKROOT}" = "x" ; then - SDKROOT="C:/Program Files/Windows CE Tools" - if test ! -d "${SDKROOT}" ; then - SDKROOT="C:/Windows CE Tools" - fi - fi - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. - WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` - SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` - CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` - if test ! -d "${CELIB_DIR}/inc"; then - AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"]) - fi - if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ - -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then - AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]]) - else - CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" - if test -d "${CEINCLUDE}/${TARGETCPU}" ; then - CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" - fi - CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" - fi - fi - - if test "$doWince" != "no" ; then - CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" - if test "${TARGETCPU}" = "X86"; then - CC="${CEBINROOT}/cl.exe" - else - CC="${CEBINROOT}/cl${ARCH}.exe" - fi - CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" - RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" - arch=`echo ${ARCH} | awk '{print tolower([$]0)}'` - defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS" - for i in $defs ; do - AC_DEFINE_UNQUOTED($i) - done -# if test "${ARCH}" = "X86EM"; then -# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION) -# fi - AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION) - AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION) - CFLAGS_DEBUG="-nologo -Zi -Od" - CFLAGS_OPTIMIZE="-nologo -O2" - lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` - lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" - LINKBIN="\"${CEBINROOT}/link.exe\"" - AC_SUBST(CELIB_DIR) - if test "${CEVERSION}" -lt 400 ; then - LIBS="coredll.lib corelibc.lib winsock.lib" - else - LIBS="coredll.lib corelibc.lib ws2.lib" - fi - # celib currently stuck at wce300 status - #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib" - LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" - LIBS_GUI="commctrl.lib commdlg.lib" - else - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" - fi + LIBS_GUI="gdi32.lib uxtheme.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" SHLIB_LD_LIBS='${LIBS}' @@ -993,7 +891,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Specify linker flags depending on the type of app being # built -- Console vs. Window. - if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then + if test "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} else diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 74e1d00..95b8193 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -199,30 +199,6 @@ TclWinInit( } /* - *---------------------------------------------------------------------- - * - * TclWinGetPlatformId -- - * - * Determines whether running under NT, 95, or Win32s, to allow runtime - * conditional code. - * - * Results: - * The return value is: - * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP, 7, 8, 8.1, 10 - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -#undef TclWinGetPlatformId -int -TclWinGetPlatformId(void) -{ - return VER_PLATFORM_WIN32_NT; -} - -/* *------------------------------------------------------------------------- * * TclWinNoBackslash -- -- cgit v0.12 From 160a58238a314e252d6155d20c097f56f1e7738e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Nov 2017 12:21:35 +0000 Subject: If compiled with -DTCL_NO_DEPRECATED, remove stub entry for TclWinGetPlatformId() --- generic/tclStubInit.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 808f5d3..355cb90 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -69,6 +69,7 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclWinGetSockOpt 0 # define TclWinSetSockOpt 0 # define TclWinNToHS 0 +# define TclWinGetPlatformId 0 # define TclBNInitBignumFromWideUInt 0 # define TclBNInitBignumFromWideInt 0 # define TclBNInitBignumFromLong 0 @@ -101,17 +102,22 @@ static const char *TclGetStartupScriptFileName(void) #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS +#undef TclWinGetPlatformId +#ifndef TCL_NO_DEPRECATED #define TclWinNToHS winNToHS static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } -#undef TclWinGetPlatformId #define TclWinGetPlatformId winGetPlatformId static int TclWinGetPlatformId() { return 2; /* VER_PLATFORM_WIN32_NT */; } +#else +#define TclWinNToHS 0 +#define TclWinGetPlatformId 0 +#endif #endif # define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt # define TclBNInitBignumFromWideInt TclInitBignumFromWideInt -- cgit v0.12 From 2fcfa34fcf2d769d0421000f57d8601a3a712322 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 24 Nov 2017 10:32:10 +0000 Subject: Restoring whitespace to tclZipfs.c to improve legibility. --- generic/tclZipfs.c | 2927 +++++++++++++++++++++++++--------------------------- 1 file changed, 1426 insertions(+), 1501 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 2d475f0..b9d09f1 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -98,6 +98,10 @@ #define ZIP_PASSWORD_END_SIG 0x5a5a4b50 +/* Macro to report errors only if an interp is present */ +#define ZIPFS_ERROR(interp,errstr) \ + if(interp != NULL) Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); + /* * Macros to read and write 16 and 32 bit integers from/to ZIP archives. */ @@ -328,7 +332,7 @@ ReadLock(void) while (ZipFS.lock < 0) { ZipFS.waiters++; Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); - ZipFS.waiters--; + ZipFS.waiters--; } ZipFS.lock++; Tcl_MutexUnlock(&ZipFSMutex); @@ -341,7 +345,7 @@ WriteLock(void) while (ZipFS.lock != 0) { ZipFS.waiters++; Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); - ZipFS.waiters--; + ZipFS.waiters--; } ZipFS.lock = -1; Tcl_MutexUnlock(&ZipFSMutex); @@ -352,12 +356,12 @@ Unlock(void) { Tcl_MutexLock(&ZipFSMutex); if (ZipFS.lock > 0) { - --ZipFS.lock; + --ZipFS.lock; } else if (ZipFS.lock < 0) { - ZipFS.lock = 0; + ZipFS.lock = 0; } if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) { - Tcl_ConditionNotify(&ZipFSCond); + Tcl_ConditionNotify(&ZipFSCond); } Tcl_MutexUnlock(&ZipFSMutex); } @@ -396,8 +400,8 @@ DosTimeDate(int dosDate, int dosTime) tm.tm_sec = (dosTime & 0x1f) << 1; ret = mktime(&tm); if (ret == (time_t) -1) { - /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */ - ret = (time_t) 315532800; + /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */ + ret = (time_t) 315532800; } return ret; } @@ -481,10 +485,10 @@ CountSlashes(const char *string) const char *p = string; while (*p != '\0') { - if (*p == '/') { - count++; - } - p++; + if (*p == '/') { + count++; + } + p++; } return count; } @@ -515,131 +519,136 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA int i, j, c, isunc = 0, isvfs=0, n=0; #if HAS_DRIVES int zipfspath=1; - if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) && - (tail[1] == ':')) { - tail += 2; - zipfspath=0; + if ( + (tail[0] != '\0') + && (strchr(drvletters, tail[0]) != NULL) + && (tail[1] == ':') + ) { + tail += 2; + zipfspath=0; } /* UNC style path */ if (tail[0] == '\\') { - root = ""; - ++tail; - zipfspath=0; + root = ""; + ++tail; + zipfspath=0; } if (tail[0] == '\\') { - root = "/"; - ++tail; - zipfspath=0; + root = "/"; + ++tail; + zipfspath=0; } if(zipfspath) { #endif - /* UNC style path */ - if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) { - isvfs=1; - } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) { - isvfs=2; - } - if(isvfs!=1) { - if ((root[0] == '/') && (root[1] == '/')) { - isunc = 1; - } - } + /* UNC style path */ + if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) { + isvfs=1; + } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) { + isvfs=2; + } + if(isvfs!=1) { + if ((root[0] == '/') && (root[1] == '/')) { + isunc = 1; + } + } #if HAS_DRIVES } #endif if(isvfs!=2) { - if (tail[0] == '/') { - if(isvfs!=1) { - root = ""; - } - ++tail; - isunc = 0; - } - if (tail[0] == '/') { - if(isvfs!=1) { - root = "/"; - } - ++tail; - isunc = 1; - } + if (tail[0] == '/') { + if(isvfs!=1) { + root = ""; + } + ++tail; + isunc = 0; + } + if (tail[0] == '/') { + if(isvfs!=1) { + root = "/"; + } + ++tail; + isunc = 1; + } } i = strlen(root); j = strlen(tail); if(isvfs==1) { - if(i>ZIPFS_VOLUME_LEN) { - Tcl_DStringSetLength(dsPtr, i + j + 1); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - path[i++] = '/'; - memcpy(path + i, tail, j); - } else { - Tcl_DStringSetLength(dsPtr, i + j); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - memcpy(path + i, tail, j); - } + if(i>ZIPFS_VOLUME_LEN) { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + memcpy(path + i, tail, j); + } } else if(isvfs==2) { - Tcl_DStringSetLength(dsPtr, j); - path = Tcl_DStringValue(dsPtr); - memcpy(path, tail, j); + Tcl_DStringSetLength(dsPtr, j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, tail, j); } else { - if (ZIPFSPATH) { - Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); - path = Tcl_DStringValue(dsPtr); - memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN); - memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j); - } else { - Tcl_DStringSetLength(dsPtr, i + j + 1); - path = Tcl_DStringValue(dsPtr); - memcpy(path, root, i); - path[i++] = '/'; - memcpy(path + i, tail, j); - } + if (ZIPFSPATH) { + Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); + path = Tcl_DStringValue(dsPtr); + memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN); + memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } } #if HAS_DRIVES for (i = 0; path[i] != '\0'; i++) { - if (path[i] == '\\') { - path[i] = '/'; - } + if (path[i] == '\\') { + path[i] = '/'; + } } #endif if(ZIPFSPATH) { - n=ZIPFS_VOLUME_LEN; + n=ZIPFS_VOLUME_LEN; } else { - n=0; + n=0; } for (i = j = n; (c = path[i]) != '\0'; i++) { - if (c == '/') { - int c2 = path[i + 1]; - if (c2 == '/') { - continue; - } - if (c2 == '.') { - int c3 = path[i + 2]; - if ((c3 == '/') || (c3 == '\0')) { - i++; - continue; - } - if ((c3 == '.') && - ((path[i + 3] == '/') || (path [i + 3] == '\0'))) { - i += 2; - while ((j > 0) && (path[j - 1] != '/')) { - j--; - } - if (j > isunc) { - --j; - while ((j > 1 + isunc) && (path[j - 2] == '/')) { - j--; - } - } - continue; - } - } - } - path[j++] = c; + if (c == '/') { + int c2 = path[i + 1]; + if (c2 == '/') { + continue; + } + if (c2 == '.') { + int c3 = path[i + 2]; + if ((c3 == '/') || (c3 == '\0')) { + i++; + continue; + } + if ( + (c3 == '.') + && ((path[i + 3] == '/') || (path [i + 3] == '\0')) + ) { + i += 2; + while ((j > 0) && (path[j - 1] != '/')) { + j--; + } + if (j > isunc) { + --j; + while ((j > 1 + isunc) && (path[j - 2] == '/')) { + j--; + } + } + continue; + } + } + } + path[j++] = c; } if (j == 0) { - path[j++] = '/'; + path[j++] = '/'; } path[j] = 0; Tcl_DStringSetLength(dsPtr, j); @@ -709,13 +718,12 @@ ZipFSLookupMount(char *filename) int match = 0; hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (strcmp(zf->mntpt, filename) == 0) { - match = 1; - break; - } - } - hPtr = Tcl_NextHashEntry(&search); + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) == NULL) continue; + if (strcmp(zf->mntpt, filename) == 0) { + match = 1; + break; + } + hPtr = Tcl_NextHashEntry(&search); } return match; } @@ -743,21 +751,21 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) { #if defined(_WIN32) || defined(_WIN64) if ((zf->data != NULL) && (zf->tofree == NULL)) { - UnmapViewOfFile(zf->data); - zf->data = NULL; + UnmapViewOfFile(zf->data); + zf->data = NULL; } if (zf->mh != INVALID_HANDLE_VALUE) { - CloseHandle(zf->mh); + CloseHandle(zf->mh); } #else if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) { - munmap(zf->data, zf->length); - zf->data = MAP_FAILED; + munmap(zf->data, zf->length); + zf->data = MAP_FAILED; } #endif if (zf->tofree != NULL) { - Tcl_Free((char *) zf->tofree); - zf->tofree = NULL; + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; } Tcl_Close(interp, zf->chan); zf->chan = NULL; @@ -807,176 +815,138 @@ ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, zf->pwbuf[0] = 0; zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0); if (zf->chan == NULL) { - return TCL_ERROR; + return TCL_ERROR; } if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { - if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") - != TCL_OK) { - goto error; - } - if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") - != TCL_OK) { - goto error; - } - zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal file size", -1)); - } - goto error; - } - Tcl_Seek(zf->chan, 0, SEEK_SET); - zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); - if (zf->tofree == NULL) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); - if (i != zf->length) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file read error", -1)); - } - goto error; - } - Tcl_Close(interp, zf->chan); - zf->chan = NULL; + if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") != TCL_OK) { + goto error; + } + if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") != TCL_OK) { + goto error; + } + zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); + if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) { + ZIPFS_ERROR(interp,"illegal file size"); + goto error; + } + Tcl_Seek(zf->chan, 0, SEEK_SET); + zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); + if (zf->tofree == NULL) { + ZIPFS_ERROR(interp,"out of memory") + goto error; + } + i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); + if (i != zf->length) { + ZIPFS_ERROR(interp,"file read error"); + goto error; + } + Tcl_Close(interp, zf->chan); + zf->chan = NULL; } else { #if defined(_WIN32) || defined(_WIN64) - zf->length = GetFileSize((HANDLE) handle, 0); - if ((zf->length == INVALID_FILE_SIZE) || - (zf->length < ZIP_CENTRAL_END_LEN)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid file size", -1)); - } - goto error; - } - zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0, - zf->length, 0); - if (zf->mh == INVALID_HANDLE_VALUE) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file mapping failed", -1)); - } - goto error; - } - zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length); - if (zf->data == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file mapping failed", -1)); - } - goto error; - } + zf->length = GetFileSize((HANDLE) handle, 0); + if ( + (zf->length == INVALID_FILE_SIZE) || + (zf->length < ZIP_CENTRAL_END_LEN) + ) { + ZIPFS_ERROR(interp,"invalid file size"); + goto error; + } + zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0, + zf->length, 0); + if (zf->mh == INVALID_HANDLE_VALUE) { + ZIPFS_ERROR(interp,"file mapping failed"); + goto error; + } + zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length); + if (zf->data == NULL) { + ZIPFS_ERROR(interp,"file mapping failed"); + goto error; + } #else - zf->length = lseek((int) (long) handle, 0, SEEK_END); - if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid file size", -1)); - } - goto error; - } - lseek((int) (long) handle, 0, SEEK_SET); - zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, - MAP_FILE | MAP_PRIVATE, - (int) (long) handle, 0); - if (zf->data == MAP_FAILED) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file mapping failed", -1)); - } - goto error; - } + zf->length = lseek((int) (long) handle, 0, SEEK_END); + if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) { + ZIPFS_ERROR(interp,"invalid file size"); + goto error; + } + lseek((int) (long) handle, 0, SEEK_SET); + zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, + MAP_FILE | MAP_PRIVATE, + (int) (long) handle, 0); + if (zf->data == MAP_FAILED) { + ZIPFS_ERROR(interp,"file mapping failed"); + goto error; + } #endif } p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; while (p >= zf->data) { - if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { - if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { - break; - } - p -= ZIP_SIG_LEN; - } else { - --p; - } + if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { + if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { + break; + } + p -= ZIP_SIG_LEN; + } else { + --p; + } } if (p < zf->data) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong end signature", -1)); - } - goto error; + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"wrong end signature"); + goto error; } zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); if (zf->nfiles == 0) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("empty archive", -1)); - } - goto error; + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"empty archive"); + goto error; } q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); - if ((p < zf->data) || (p > (zf->data + zf->length)) || - (q < zf->data) || (q > (zf->data + zf->length))) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("archive directory not found", -1)); - } - goto error; + if ( + (p < zf->data) || (p > (zf->data + zf->length)) || + (q < zf->data) || (q > (zf->data + zf->length)) + ) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"archive directory not found"); + goto error; } zf->baseoffs = zf->baseoffsp = p - q; zf->centoffs = p - zf->data; q = p; for (i = 0; i < zf->nfiles; i++) { - int pathlen, comlen, extra; + int pathlen, comlen, extra; - if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong header length", -1)); - } - goto error; - } - if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong header signature", -1)); - } - goto error; - } - pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); - comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); - extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); - q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { + ZIPFS_ERROR(interp,"wrong header length"); + goto error; + } + if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { + ZIPFS_ERROR(interp,"wrong header signature"); + goto error; + } + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; } q = zf->data + zf->baseoffs; - if ((zf->baseoffs >= 6) && - (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { - i = q[-5]; - if (q - 5 - i > zf->data) { - zf->pwbuf[0] = i; - memcpy(zf->pwbuf + 1, q - 5 - i, i); - zf->baseoffsp -= i ? (5 + i) : 0; - } + if ((zf->baseoffs >= 6) && (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { + i = q[-5]; + if (q - 5 - i > zf->data) { + zf->pwbuf[0] = i; + memcpy(zf->pwbuf + 1, q - 5 - i, i); + zf->baseoffsp -= i ? (5 + i) : 0; + } } return TCL_OK; @@ -1004,9 +974,11 @@ error: */ int -TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, - const char *passwd) -{ +TclZipfs_Mount( + Tcl_Interp *interp, const char *zipname, + const char *mntpt, + const char *passwd +) { int i, pwlen, isNew; ZipFile *zf, zf0; ZipEntry *z; @@ -1015,49 +987,45 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, unsigned char *q; ReadLock(); if (!ZipFS.initialized) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("not initialized", -1)); - } - Unlock(); - return TCL_ERROR; + ZIPFS_ERROR(interp,"not initialized"); + Unlock(); + return TCL_ERROR; } if (zipname == NULL) { - Tcl_HashSearch search; - int ret = TCL_OK; - - i = 0; - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (interp != NULL) { - Tcl_AppendElement(interp, zf->mntpt); - Tcl_AppendElement(interp, zf->name); - } - ++i; - } - hPtr = Tcl_NextHashEntry(&search); - } - if (interp == NULL) { - ret = (i > 0) ? TCL_OK : TCL_BREAK; - } - Unlock(); - return ret; + Tcl_HashSearch search; + int ret = TCL_OK; + + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; } if (mntpt == NULL) { - if (interp == NULL) { - Unlock(); - return TCL_OK; - } - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); - if (hPtr != NULL) { - if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); - } - } - Unlock(); - return TCL_OK; + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } + } + Unlock(); + return TCL_OK; } Unlock(); pwlen = 0; @@ -1072,7 +1040,7 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, } } if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } /* * Mount point can come from Tcl_GetNameOfExecutable() @@ -1082,236 +1050,235 @@ TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, WriteLock(); hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew); if (!isNew) { - zf = (ZipFile *) Tcl_GetHashValue(hPtr); - if (interp != NULL) { - Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? - zf->mntpt : "/", "\"", (char *) NULL); - } - Unlock(); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (interp != NULL) { + Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? + zf->mntpt : "/", "\"", (char *) NULL); + } + Unlock(); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; } if (strcmp(mntpt, "/") == 0) { - mntpt = ""; + mntpt = ""; } zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); if (zf == NULL) { - if (interp != NULL) { - Tcl_AppendResult(interp, "out of memory", (char *) NULL); - } - Unlock(); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; - } - *zf = zf0; - zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); - strcpy(zf->mntpt, mntpt); - zf->mntptlen = strlen(zf->mntpt); - zf->entries = NULL; - zf->topents = NULL; - zf->nopen = 0; - Tcl_SetHashValue(hPtr, (ClientData) zf); - if ((zf->pwbuf[0] == 0) && pwlen) { - int k = 0; - i = pwlen; - zf->pwbuf[k++] = i; - while (i > 0) { - zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | - pwrot[(passwd[i - 1] >> 4) & 0x0f]; - k++; - i--; - } - zf->pwbuf[k] = '\0'; + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + Unlock(); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + *zf = zf0; + zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + strcpy(zf->mntpt, mntpt); + zf->mntptlen = strlen(zf->mntpt); + zf->entries = NULL; + zf->topents = NULL; + zf->nopen = 0; + Tcl_SetHashValue(hPtr, (ClientData) zf); + if ((zf->pwbuf[0] == 0) && pwlen) { + int k = 0; + i = pwlen; + zf->pwbuf[k++] = i; + while (i > 0) { + zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | + pwrot[(passwd[i - 1] >> 4) & 0x0f]; + k++; + i--; + } + zf->pwbuf[k] = '\0'; } if (mntpt[0] != '\0') { - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = CountSlashes(mntpt); - z->zipfile = zf; - z->isdir = 1; - z->isenc = 0; - z->offset = zf->baseoffs; - z->crc32 = 0; - z->timestamp = 0; - z->nbyte = z->nbytecompr = 0; - z->cmeth = ZIP_COMPMETH_STORED; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); - if (!isNew) { - /* skip it */ - Tcl_Free((char *) z); - } else { - Tcl_SetHashValue(hPtr, (ClientData) z); - z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - z->next = zf->entries; - zf->entries = z; - } + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(mntpt); + z->zipfile = zf; + z->isdir = 1; + z->isenc = 0; + z->offset = zf->baseoffs; + z->crc32 = 0; + z->timestamp = 0; + z->nbyte = z->nbytecompr = 0; + z->cmeth = ZIP_COMPMETH_STORED; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); + if (!isNew) { + /* skip it */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + } } q = zf->data + zf->centoffs; Tcl_DStringInit(&fpBuf); Tcl_DStringInit(&ds); for (i = 0; i < zf->nfiles; i++) { - int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; - unsigned char *lq, *gq = NULL; - char *fullpath, *path; - - pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); - comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); - extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); - path = Tcl_DStringValue(&ds); - if ((pathlen > 0) && (path[pathlen - 1] == '/')) { - Tcl_DStringSetLength(&ds, pathlen - 1); - path = Tcl_DStringValue(&ds); - isdir = 1; - } - if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { - goto nextent; - } - lq = zf->data + zf->baseoffs + - zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); - if ((lq < zf->data) || (lq > (zf->data + zf->length))) { - goto nextent; - } - nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); - if (!isdir && (nbcompr == 0) && - (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) && - (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) { - gq = q; - nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); - } - offs = (lq - zf->data) - + ZIP_LOCAL_HEADER_LEN - + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) - + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); - if ((offs + nbcompr) > zf->length) { - goto nextent; - } - if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { + int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; + unsigned char *lq, *gq = NULL; + char *fullpath, *path; + + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); + path = Tcl_DStringValue(&ds); + if ((pathlen > 0) && (path[pathlen - 1] == '/')) { + Tcl_DStringSetLength(&ds, pathlen - 1); + path = Tcl_DStringValue(&ds); + isdir = 1; + } + if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { + goto nextent; + } + lq = zf->data + zf->baseoffs + zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); + if ((lq < zf->data) || (lq > (zf->data + zf->length))) { + goto nextent; + } + nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); + if ( + !isdir && (nbcompr == 0) + && (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) + && (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0) + ) { + gq = q; + nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); + } + offs = (lq - zf->data) + + ZIP_LOCAL_HEADER_LEN + + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) + + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); + if ((offs + nbcompr) > zf->length) { + goto nextent; + } + if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { #ifdef ANDROID - /* - * When mounting the ZIP archive on the root directory try - * to remap top level regular files of the archive to - * /assets/.root/... since this directory should not be - * in a valid APK due to the leading dot in the file name - * component. This trick should make the files - * AndroidManifest.xml, resources.arsc, and classes.dex - * visible to Tcl. - */ - Tcl_DString ds2; - - Tcl_DStringInit(&ds2); - Tcl_DStringAppend(&ds2, "assets/.root/", -1); - Tcl_DStringAppend(&ds2, path, -1); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2)); - if (hPtr != NULL) { - /* should not happen but skip it anyway */ - Tcl_DStringFree(&ds2); - goto nextent; - } - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), - Tcl_DStringLength(&ds2)); - path = Tcl_DStringValue(&ds); - Tcl_DStringFree(&ds2); + /* + * When mounting the ZIP archive on the root directory try + * to remap top level regular files of the archive to + * /assets/.root/... since this directory should not be + * in a valid APK due to the leading dot in the file name + * component. This trick should make the files + * AndroidManifest.xml, resources.arsc, and classes.dex + * visible to Tcl. + */ + Tcl_DString ds2; + + Tcl_DStringInit(&ds2); + Tcl_DStringAppend(&ds2, "assets/.root/", -1); + Tcl_DStringAppend(&ds2, path, -1); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2)); + if (hPtr != NULL) { + /* should not happen but skip it anyway */ + Tcl_DStringFree(&ds2); + goto nextent; + } + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), Tcl_DStringLength(&ds2)); + path = Tcl_DStringValue(&ds); + Tcl_DStringFree(&ds2); #else - /* - * Regular files skipped when mounting on root. - */ - goto nextent; + /* + * Regular files skipped when mounting on root. + */ + goto nextent; #endif - } - Tcl_DStringSetLength(&fpBuf, 0); - fullpath = CanonicalPath(mntpt, path, &fpBuf, 1); - z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); - z->name = NULL; - z->tnext = NULL; - z->depth = CountSlashes(fullpath); - z->zipfile = zf; - z->isdir = isdir; - z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) - && (nbcompr > 12); - z->offset = offs; - if (gq != NULL) { - z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); - dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); - dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); - z->timestamp = DosTimeDate(dosDate, dosTime); - z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); - z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); - } else { - z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); - dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); - dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); - z->timestamp = DosTimeDate(dosDate, dosTime); - z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); - z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); - } - z->nbytecompr = nbcompr; - z->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); - if (!isNew) { - /* should not happen but skip it anyway */ - Tcl_Free((char *) z); - } else { - Tcl_SetHashValue(hPtr, (ClientData) z); - z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - z->next = zf->entries; - zf->entries = z; - if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { - z->tnext = zf->topents; - zf->topents = z; - } - if (!z->isdir && (z->depth > 1)) { - char *dir, *end; - ZipEntry *zd; - - Tcl_DStringSetLength(&ds, strlen(z->name) + 8); - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, z->name, -1); - dir = Tcl_DStringValue(&ds); - end = strrchr(dir, '/'); - while ((end != NULL) && (end != dir)) { - Tcl_DStringSetLength(&ds, end - dir); - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); - if (hPtr != NULL) { - break; - } - zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); - zd->name = NULL; - zd->tnext = NULL; - zd->depth = CountSlashes(dir); - zd->zipfile = zf; - zd->isdir = 1; - zd->isenc = 0; - zd->offset = z->offset; - zd->crc32 = 0; - zd->timestamp = z->timestamp; - zd->nbyte = zd->nbytecompr = 0; - zd->cmeth = ZIP_COMPMETH_STORED; - zd->data = NULL; - hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); - if (!isNew) { - /* should not happen but skip it anyway */ - Tcl_Free((char *) zd); - } else { - Tcl_SetHashValue(hPtr, (ClientData) zd); - zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); - zd->next = zf->entries; - zf->entries = zd; - if ((mntpt[0] == '\0') && (zd->depth == 1)) { - zd->tnext = zf->topents; - zf->topents = zd; - } - } - end = strrchr(dir, '/'); - } - } - } + } + Tcl_DStringSetLength(&fpBuf, 0); + fullpath = CanonicalPath(mntpt, path, &fpBuf, 1); + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(fullpath); + z->zipfile = zf; + z->isdir = isdir; + z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) && (nbcompr > 12); + z->offset = offs; + if (gq != NULL) { + z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); + dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); + dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); + } else { + z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); + dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); + dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); + } + z->nbytecompr = nbcompr; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { + z->tnext = zf->topents; + zf->topents = z; + } + if (!z->isdir && (z->depth > 1)) { + char *dir, *end; + ZipEntry *zd; + + Tcl_DStringSetLength(&ds, strlen(z->name) + 8); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, z->name, -1); + dir = Tcl_DStringValue(&ds); + end = strrchr(dir, '/'); + while ((end != NULL) && (end != dir)) { + Tcl_DStringSetLength(&ds, end - dir); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); + if (hPtr != NULL) { + break; + } + zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); + zd->name = NULL; + zd->tnext = NULL; + zd->depth = CountSlashes(dir); + zd->zipfile = zf; + zd->isdir = 1; + zd->isenc = 0; + zd->offset = z->offset; + zd->crc32 = 0; + zd->timestamp = z->timestamp; + zd->nbyte = zd->nbytecompr = 0; + zd->cmeth = ZIP_COMPMETH_STORED; + zd->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) zd); + } else { + Tcl_SetHashValue(hPtr, (ClientData) zd); + zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + zd->next = zf->entries; + zf->entries = zd; + if ((mntpt[0] == '\0') && (zd->depth == 1)) { + zd->tnext = zf->topents; + zf->topents = zd; + } + } + end = strrchr(dir, '/'); + } + } + } nextent: - q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; } Unlock(); Tcl_DStringFree(&fpBuf); @@ -1345,34 +1312,30 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) int ret = TCL_OK, unmounted = 0; WriteLock(); - if (!ZipFS.initialized) { - goto done; - } + if (!ZipFS.initialized) goto done; + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); - if (hPtr == NULL) { + /* don't report error */ - goto done; - } + if (hPtr == NULL) goto done; + zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->nopen > 0) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("filesystem is busy", -1)); - } - ret = TCL_ERROR; - goto done; + ZIPFS_ERROR(interp,"filesystem is busy"); + ret = TCL_ERROR; + goto done; } Tcl_DeleteHashEntry(hPtr); for (z = zf->entries; z; z = znext) { - znext = z->next; - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); - if (hPtr) { - Tcl_DeleteHashEntry(hPtr); - } - if (z->data != NULL) { - Tcl_Free((char *) z->data); - } - Tcl_Free((char *) z); + znext = z->next; + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + Tcl_Free((char *) z); } ZipFSCloseArchive(interp, zf); Tcl_Free((char *) zf); @@ -1380,7 +1343,7 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) done: Unlock(); if (unmounted) { - Tcl_FSMountsChanged(NULL); + Tcl_FSMountsChanged(NULL); } return ret; } @@ -1402,13 +1365,13 @@ done: */ static int -ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSMountObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { if (objc > 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "?zipfile? ?mountpoint? ?password?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, + "?zipfile? ?mountpoint? ?password?"); + return TCL_ERROR; } return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, (objc > 2) ? Tcl_GetString(objv[2]) : NULL, @@ -1432,9 +1395,9 @@ ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSRootObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSRootObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { Tcl_SetObjResult(interp,Tcl_NewStringObj(ZIPFS_VOLUME, -1)); return TCL_OK; } @@ -1456,12 +1419,12 @@ ZipFSRootObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSUnmountObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); + return TCL_ERROR; } return TclZipfs_Unmount(interp, Tcl_GetString(objv[1])); } @@ -1484,32 +1447,31 @@ ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSMkKeyObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSMkKeyObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { int len, i = 0; char *pw, pwbuf[264]; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "password"); - return TCL_ERROR; + return TCL_ERROR; } pw = Tcl_GetString(objv[1]); len = strlen(pw); if (len == 0) { - return TCL_OK; + return TCL_OK; } if ((len > 255) || (strchr(pw, 0xff) != NULL)) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; } while (len > 0) { - int ch = pw[len - 1]; + int ch = pw[len - 1]; - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - i++; - len--; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; } pwbuf[i] = i; ++i; @@ -1543,10 +1505,11 @@ ZipFSMkKeyObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipAddFile(Tcl_Interp *interp, const char *path, const char *name, - Tcl_Channel out, const char *passwd, - char *buf, int bufsize, Tcl_HashTable *fileHash) -{ +ZipAddFile( + Tcl_Interp *interp, const char *path, const char *name, + Tcl_Channel out, const char *passwd, + char *buf, int bufsize, Tcl_HashTable *fileHash +) { Tcl_Channel in; Tcl_HashEntry *hPtr; ZipEntry *z; @@ -1559,67 +1522,66 @@ ZipAddFile(Tcl_Interp *interp, const char *path, const char *name, zpath = name; while (zpath != NULL && zpath[0] == '/') { - zpath++; + zpath++; } if ((zpath == NULL) || (zpath[0] == '\0')) { - return TCL_OK; + return TCL_OK; } zpathlen = strlen(zpath); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { - Tcl_AppendResult(interp, "path too long for \"", path, "\"", - (char *) NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, "path too long for \"", path, "\"", (char *) NULL); + return TCL_ERROR; } in = Tcl_OpenFileChannel(interp, path, "r", 0); - if ((in == NULL) || - (Tcl_SetChannelOption(interp, in, "-translation", "binary") - != TCL_OK) || - (Tcl_SetChannelOption(interp, in, "-encoding", "binary") - != TCL_OK)) { + if ( + (in == NULL) + || (Tcl_SetChannelOption(interp, in, "-translation", "binary") != TCL_OK) + || (Tcl_SetChannelOption(interp, in, "-encoding", "binary") != TCL_OK) + ) { #if defined(_WIN32) || defined(_WIN64) - /* hopefully a directory */ - if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { - Tcl_Close(interp, in); - return TCL_OK; - } + /* hopefully a directory */ + if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } #endif - Tcl_Close(interp, in); - return TCL_ERROR; + Tcl_Close(interp, in); + return TCL_ERROR; } else { - Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); - Tcl_StatBuf statBuf; + Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); + Tcl_StatBuf statBuf; - Tcl_IncrRefCount(pathObj); - if (Tcl_FSStat(pathObj, &statBuf) != -1) { - mtime = statBuf.st_mtime; - } - Tcl_DecrRefCount(pathObj); + Tcl_IncrRefCount(pathObj); + if (Tcl_FSStat(pathObj, &statBuf) != -1) { + mtime = statBuf.st_mtime; + } + Tcl_DecrRefCount(pathObj); } Tcl_ResetResult(interp); crc = 0; nbyte = nbytecompr = 0; while ((len = Tcl_Read(in, buf, bufsize)) > 0) { - crc = crc32(crc, (unsigned char *) buf, len); - nbyte += len; + crc = crc32(crc, (unsigned char *) buf, len); + nbyte += len; } if (len == -1) { - if (nbyte == 0) { - if (strcmp("illegal operation on a directory", - Tcl_PosixError(interp)) == 0) { - Tcl_Close(interp, in); - return TCL_OK; - } - } - Tcl_AppendResult(interp, "read error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; + if (nbyte == 0) { + if (strcmp("illegal operation on a directory", + Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } + } + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; } if (Tcl_Seek(in, 0, SEEK_SET) == -1) { - Tcl_AppendResult(interp, "seek error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; + Tcl_AppendResult(interp, "seek error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; } pos[0] = Tcl_Tell(out); memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); @@ -1632,56 +1594,55 @@ wrerr: return TCL_ERROR; } if ((len + pos[0]) & 3) { - char abuf[8]; - - /* - * Align payload to next 4-byte boundary using a dummy extra - * entry similar to the zipalign tool from Android's SDK. - */ - align = 4 + ((len + pos[0]) & 3); - zip_write_short(abuf, 0xffff); - zip_write_short(abuf + 2, align - 4); - zip_write_int(abuf + 4, 0x03020100); - if (Tcl_Write(out, abuf, align) != align) { - goto wrerr; - } + char abuf[8]; + + /* + * Align payload to next 4-byte boundary using a dummy extra + * entry similar to the zipalign tool from Android's SDK. + */ + align = 4 + ((len + pos[0]) & 3); + zip_write_short(abuf, 0xffff); + zip_write_short(abuf + 2, align - 4); + zip_write_int(abuf + 4, 0x03020100); + if (Tcl_Write(out, abuf, align) != align) { + goto wrerr; + } } if (passwd != NULL) { - int i, ch, tmp; - unsigned char kvbuf[24]; - Tcl_Obj *ret; - - init_keys(passwd, keys, crc32tab); - for (i = 0; i < 12 - 2; i++) { - if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) { - Tcl_AppendResult(interp, "PRNG error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - ret = Tcl_GetObjResult(interp); - if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) { - Tcl_Close(interp, in); - return TCL_ERROR; - } - kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); - } - Tcl_ResetResult(interp); - init_keys(passwd, keys, crc32tab); - for (i = 0; i < 12 - 2; i++) { - kvbuf[i] = (unsigned char) zencode(keys, crc32tab, - kvbuf[i + 12], tmp); - } - kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); - kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); - len = Tcl_Write(out, (char *) kvbuf, 12); - memset(kvbuf, 0, 24); - if (len != 12) { - Tcl_AppendResult(interp, "write error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - memcpy(keys0, keys, sizeof (keys0)); - nbytecompr += 12; + int i, ch, tmp; + unsigned char kvbuf[24]; + Tcl_Obj *ret; + + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) { + Tcl_AppendResult(interp, "PRNG error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + ret = Tcl_GetObjResult(interp); + if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) { + Tcl_Close(interp, in); + return TCL_ERROR; + } + kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); + } + Tcl_ResetResult(interp); + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + kvbuf[i] = (unsigned char) zencode(keys, crc32tab, kvbuf[i + 12], tmp); + } + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); + len = Tcl_Write(out, (char *) kvbuf, 12); + memset(kvbuf, 0, 24); + if (len != 12) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + memcpy(keys0, keys, sizeof (keys0)); + nbytecompr += 12; } Tcl_Flush(out); pos[2] = Tcl_Tell(out); @@ -1690,12 +1651,11 @@ wrerr: stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; - if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) - != Z_OK) { - Tcl_AppendResult(interp, "compression init error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; + if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) { + Tcl_AppendResult(interp, "compression init error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; } do { len = Tcl_Read(in, buf, bufsize); @@ -1714,25 +1674,25 @@ wrerr: stream.next_out = (unsigned char *) obuf; len = deflate(&stream, flush); if (len == Z_STREAM_ERROR) { - Tcl_AppendResult(interp, "deflate error on \"", path, "\"", - (char *) NULL); - deflateEnd(&stream); - Tcl_Close(interp, in); - return TCL_ERROR; + Tcl_AppendResult(interp, "deflate error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; } olen = sizeof (obuf) - stream.avail_out; if (passwd != NULL) { - int i, tmp; + int i, tmp; - for (i = 0; i < olen; i++) { - obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); - } + for (i = 0; i < olen; i++) { + obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); + } } if (olen && (Tcl_Write(out, obuf, olen) != olen)) { - Tcl_AppendResult(interp, "write error", (char *) NULL); - deflateEnd(&stream); - Tcl_Close(interp, in); - return TCL_ERROR; + Tcl_AppendResult(interp, "write error", (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; } nbytecompr += olen; } while (stream.avail_out == 0); @@ -1741,48 +1701,48 @@ wrerr: Tcl_Flush(out); pos[1] = Tcl_Tell(out); if (nbyte - nbytecompr <= 0) { - /* - * Compressed file larger than input, - * write it again uncompressed. - */ - if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { - goto seekErr; - } - if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { + /* + * Compressed file larger than input, + * write it again uncompressed. + */ + if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { + goto seekErr; + } + if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { seekErr: - Tcl_Close(interp, in); - Tcl_AppendResult(interp, "seek error", (char *) NULL); - return TCL_ERROR; - } - nbytecompr = (passwd != NULL) ? 12 : 0; - while (1) { - len = Tcl_Read(in, buf, bufsize); - if (len == -1) { - Tcl_AppendResult(interp, "read error on \"", path, "\"", - (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } else if (len == 0) { - break; - } - if (passwd != NULL) { - int i, tmp; + Tcl_Close(interp, in); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + nbytecompr = (passwd != NULL) ? 12 : 0; + while (1) { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } else if (len == 0) { + break; + } + if (passwd != NULL) { + int i, tmp; - for (i = 0; i < len; i++) { - buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); - } - } - if (Tcl_Write(out, buf, len) != len) { - Tcl_AppendResult(interp, "write error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; - } - nbytecompr += len; - } - cmeth = ZIP_COMPMETH_STORED; - Tcl_Flush(out); - pos[1] = Tcl_Tell(out); - Tcl_TruncateChannel(out, pos[1]); + for (i = 0; i < len; i++) { + buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); + } + } + if (Tcl_Write(out, buf, len) != len) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += len; + } + cmeth = ZIP_COMPMETH_STORED; + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + Tcl_TruncateChannel(out, pos[1]); } Tcl_Close(interp, in); @@ -1802,14 +1762,14 @@ seekErr: z->data = NULL; hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "non-unique path name \"", path, "\"", - (char *) NULL); - Tcl_Free((char *) z); - return TCL_ERROR; + Tcl_AppendResult(interp, "non-unique path name \"", path, "\"", + (char *) NULL); + Tcl_Free((char *) z); + return TCL_ERROR; } else { - Tcl_SetHashValue(hPtr, (ClientData) z); - z->name = Tcl_GetHashKey(fileHash, hPtr); - z->next = NULL; + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(fileHash, hPtr); + z->next = NULL; } /* @@ -1827,23 +1787,23 @@ seekErr: zip_write_short(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen); zip_write_short(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); if ((int) Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { - Tcl_DeleteHashEntry(hPtr); - Tcl_Free((char *) z); - Tcl_AppendResult(interp, "seek error", (char *) NULL); - return TCL_ERROR; + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; } if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { - Tcl_DeleteHashEntry(hPtr); - Tcl_Free((char *) z); - Tcl_AppendResult(interp, "write error", (char *) NULL); - return TCL_ERROR; + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "write error", (char *) NULL); + return TCL_ERROR; } Tcl_Flush(out); if ((int) Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { - Tcl_DeleteHashEntry(hPtr); - Tcl_Free((char *) z); - Tcl_AppendResult(interp, "seek error", (char *) NULL); - return TCL_ERROR; + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; } return TCL_OK; } @@ -1868,9 +1828,9 @@ seekErr: */ static int -ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, - int isImg, int isList, int objc, Tcl_Obj *const objv[]) -{ +ZipFSMkZipOrImgObjCmd( + ClientData clientData, Tcl_Interp *interp,int isImg, int isList, int objc, Tcl_Obj *const objv[] +) { Tcl_Channel out; int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3]; Tcl_Obj **lobjv, *list = NULL; @@ -1881,161 +1841,160 @@ ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096]; if (isList) { - if ((objc < 3) || (objc > (isImg ? 5 : 4))) { - Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile inlist ?password infile?" : - "outfile inlist ?password?"); - return TCL_ERROR; - } + if ((objc < 3) || (objc > (isImg ? 5 : 4))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile inlist ?password infile?" : + "outfile inlist ?password?"); + return TCL_ERROR; + } } else { - if ((objc < 3) || (objc > (isImg ? 6 : 5))) { - Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile indir ?strip? ?password? ?infile?" : - "outfile indir ?strip? ?password?"); - return TCL_ERROR; - } + if ((objc < 3) || (objc > (isImg ? 6 : 5))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile indir ?strip? ?password? ?infile?" : + "outfile indir ?strip? ?password?"); + return TCL_ERROR; + } } pwbuf[0] = 0; if (objc > (isList ? 3 : 4)) { - pw = Tcl_GetString(objv[isList ? 3 : 4]); - pwlen = strlen(pw); - if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); - return TCL_ERROR; - } + pw = Tcl_GetString(objv[isList ? 3 : 4]); + pwlen = strlen(pw); + if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; + } } if (isList) { - list = objv[2]; - Tcl_IncrRefCount(list); + list = objv[2]; + Tcl_IncrRefCount(list); } else { - Tcl_Obj *cmd[3]; - - cmd[1] = Tcl_NewStringObj("::zipfs::find", -1); - cmd[2] = objv[2]; - cmd[0] = Tcl_NewListObj(2, cmd + 1); - Tcl_IncrRefCount(cmd[0]); - if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { - Tcl_DecrRefCount(cmd[0]); - return TCL_ERROR; - } - Tcl_DecrRefCount(cmd[0]); - list = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(list); + Tcl_Obj *cmd[3]; + + cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1); + cmd[2] = objv[2]; + cmd[0] = Tcl_NewListObj(2, cmd + 1); + Tcl_IncrRefCount(cmd[0]); + if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { + Tcl_DecrRefCount(cmd[0]); + return TCL_ERROR; + } + Tcl_DecrRefCount(cmd[0]); + list = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(list); } if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { - Tcl_DecrRefCount(list); - return TCL_ERROR; + Tcl_DecrRefCount(list); + return TCL_ERROR; } if (isList && (lobjc % 2)) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, - Tcl_NewStringObj("need even number of elements", -1)); - return TCL_ERROR; + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("need even number of elements", -1)); + return TCL_ERROR; } if (lobjc == 0) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); - return TCL_ERROR; + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); + return TCL_ERROR; } out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755); - if ((out == NULL) || - (Tcl_SetChannelOption(interp, out, "-translation", "binary") - != TCL_OK) || - (Tcl_SetChannelOption(interp, out, "-encoding", "binary") - != TCL_OK)) { - Tcl_DecrRefCount(list); - Tcl_Close(interp, out); - return TCL_ERROR; - } - if (isImg) { - ZipFile zf0; - const char *imgName; - - if (isList) { - imgName = (objc > 4) ? Tcl_GetString(objv[4]) : - Tcl_GetNameOfExecutable(); - } else { - imgName = (objc > 5) ? Tcl_GetString(objv[5]) : - Tcl_GetNameOfExecutable(); - } - if (ZipFSOpenArchive(interp, imgName, 0, &zf0) != TCL_OK) { - Tcl_DecrRefCount(list); - Tcl_Close(interp, out); - return TCL_ERROR; - } - if ((pw != NULL) && pwlen) { - i = 0; - len = pwlen; - while (len > 0) { - int ch = pw[len - 1]; - - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - i++; - len--; - } - pwbuf[i] = i; - ++i; - pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); - pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); - pwbuf[i] = '\0'; - } - i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); - if (i != zf0.baseoffsp) { + if ( + (out == NULL) + || (Tcl_SetChannelOption(interp, out, "-translation", "binary") != TCL_OK) + || (Tcl_SetChannelOption(interp, out, "-encoding", "binary") != TCL_OK) + ) { Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); Tcl_Close(interp, out); - ZipFSCloseArchive(interp, &zf0); return TCL_ERROR; - } - ZipFSCloseArchive(interp, &zf0); - len = strlen(pwbuf); - if (len > 0) { - i = Tcl_Write(out, pwbuf, len); - if (i != len) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - Tcl_Close(interp, out); - return TCL_ERROR; - } - } - memset(pwbuf, 0, sizeof (pwbuf)); - Tcl_Flush(out); + } + if (isImg) { + ZipFile zf0; + const char *imgName; + + if (isList) { + imgName = (objc > 4) ? Tcl_GetString(objv[4]) : + Tcl_GetNameOfExecutable(); + } else { + imgName = (objc > 5) ? Tcl_GetString(objv[5]) : + Tcl_GetNameOfExecutable(); + } + if (ZipFSOpenArchive(interp, imgName, 0, &zf0) != TCL_OK) { + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + if ((pw != NULL) && pwlen) { + i = 0; + len = pwlen; + while (len > 0) { + int ch = pw[len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + } + i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); + if (i != zf0.baseoffsp) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + ZipFSCloseArchive(interp, &zf0); + return TCL_ERROR; + } + ZipFSCloseArchive(interp, &zf0); + len = strlen(pwbuf); + if (len > 0) { + i = Tcl_Write(out, pwbuf, len); + if (i != len) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + return TCL_ERROR; + } + } + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_Flush(out); } Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); pos[0] = Tcl_Tell(out); if (!isList && (objc > 3)) { - strip = Tcl_GetString(objv[3]); - slen = strlen(strip); + strip = Tcl_GetString(objv[3]); + slen = strlen(strip); } for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { - const char *path, *name; + const char *path, *name; - path = Tcl_GetString(lobjv[i]); - if (isList) { - name = Tcl_GetString(lobjv[i + 1]); - } else { - name = path; - if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { - continue; - } - name += slen; - } - } - while (name[0] == '/') { - ++name; - } - if (name[0] == '\0') { - continue; - } - if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), - &fileHash) != TCL_OK) { - goto done; - } + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; + } + } + while (name[0] == '/') { + ++name; + } + if (name[0] == '\0') { + continue; + } + if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), &fileHash) != TCL_OK) { + goto done; + } } pos[1] = Tcl_Tell(out); count = 0; @@ -2048,11 +2007,11 @@ ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, } else { name = path; if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { - continue; - } - name += slen; + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; } } while (name[0] == '/') { @@ -2084,9 +2043,10 @@ ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); - if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != - ZIP_CENTRAL_HEADER_LEN) || - (Tcl_Write(out, z->name, len) != len)) { + if ( + (Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) + || (Tcl_Write(out, z->name, len) != len) + ) { Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); goto done; } @@ -2103,24 +2063,24 @@ ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]); zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - goto done; + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + goto done; } Tcl_Flush(out); ret = TCL_OK; done: if (ret == TCL_OK) { - ret = Tcl_Close(interp, out); + ret = Tcl_Close(interp, out); } else { - Tcl_Close(interp, out); + Tcl_Close(interp, out); } Tcl_DecrRefCount(list); hPtr = Tcl_FirstHashEntry(&fileHash, &search); while (hPtr != NULL) { - z = (ZipEntry *) Tcl_GetHashValue(hPtr); - Tcl_Free((char *) z); - Tcl_DeleteHashEntry(hPtr); - hPtr = Tcl_FirstHashEntry(&fileHash, &search); + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + Tcl_Free((char *) z); + Tcl_DeleteHashEntry(hPtr); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); } Tcl_DeleteHashTable(&fileHash); return ret; @@ -2144,16 +2104,16 @@ done: */ static int -ZipFSMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSMkZipObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv); } static int -ZipFSLMkZipObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSLMkZipObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv); } @@ -2207,34 +2167,34 @@ ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSCanonicalObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSCanonicalObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { char *mntpoint=NULL; char *filename=NULL; char *result; Tcl_DString dPath; if (objc != 2 && objc != 3 && objc!=4) { - Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?"); + return TCL_ERROR; } Tcl_DStringInit(&dPath); if(objc==2) { - filename = Tcl_GetString(objv[1]); - result=CanonicalPath("",filename,&dPath,1); + filename = Tcl_GetString(objv[1]); + result=CanonicalPath("",filename,&dPath,1); } else if (objc==3) { - mntpoint = Tcl_GetString(objv[1]); - filename = Tcl_GetString(objv[2]); - result=CanonicalPath(mntpoint,filename,&dPath,1); + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,1); } else { - int zipfs=0; - if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) { - return TCL_ERROR; - } - mntpoint = Tcl_GetString(objv[1]); - filename = Tcl_GetString(objv[2]); - result=CanonicalPath(mntpoint,filename,&dPath,zipfs); + int zipfs=0; + if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) { + return TCL_ERROR; + } + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,zipfs); } Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1)); return TCL_OK; @@ -2259,9 +2219,9 @@ ZipFSCanonicalObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSExistsObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { char *filename; int exists; Tcl_DString ds; @@ -2306,27 +2266,27 @@ ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSInfoObjCmd( + ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[] +) { char *filename; ZipEntry *z; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "filename"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; } filename = Tcl_GetStringFromObj(objv[1], 0); ReadLock(); z = ZipFSLookup(filename); if (z != NULL) { - Tcl_Obj *result = Tcl_GetObjResult(interp); + Tcl_Obj *result = Tcl_GetObjResult(interp); - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->zipfile->name, -1)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset)); + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->zipfile->name, -1)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset)); } Unlock(); return TCL_OK; @@ -2351,9 +2311,9 @@ ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp, */ static int -ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) -{ +ZipFSListObjCmd( + ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[] +) { char *pattern = NULL; Tcl_RegExp regexp = NULL; Tcl_HashEntry *hPtr; @@ -2361,57 +2321,61 @@ ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp, Tcl_Obj *result = Tcl_GetObjResult(interp); if (objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); + return TCL_ERROR; } if (objc == 3) { - int n; - char *what = Tcl_GetStringFromObj(objv[1], &n); - - if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { - pattern = Tcl_GetString(objv[2]); - } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { - regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); - if (regexp == NULL) { - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "unknown option \"", what, - "\"", (char *) NULL); - return TCL_ERROR; - } + int n; + char *what = Tcl_GetStringFromObj(objv[1], &n); + + if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { + pattern = Tcl_GetString(objv[2]); + } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { + regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + if (regexp == NULL) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "unknown option \"", what,"\"", (char *) NULL); + return TCL_ERROR; + } } else if (objc == 2) { - pattern = Tcl_GetStringFromObj(objv[1], 0); + pattern = Tcl_GetStringFromObj(objv[1], 0); } ReadLock(); if (pattern != NULL) { - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if (Tcl_StringMatch(z->name, pattern)) { - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, -1)); - } - } + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if (Tcl_StringMatch(z->name, pattern)) { + Tcl_ListObjAppendElement(interp, result,Tcl_NewStringObj(z->name, -1)); + } + } } else if (regexp != NULL) { - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, -1)); - } - } + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { + Tcl_ListObjAppendElement(interp, result,Tcl_NewStringObj(z->name, -1)); + } + } } else { - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, -1)); - } + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); + } } Unlock(); return TCL_OK; @@ -2438,6 +2402,7 @@ ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *pResult; + pResult=TclZipfs_TclLibrary(); if(!pResult) { pResult=Tcl_NewObj(); @@ -2468,34 +2433,33 @@ ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) ZipChannel *info = (ZipChannel *) instanceData; if (info->iscompr && (info->ubuf != NULL)) { - Tcl_Free((char *) info->ubuf); - info->ubuf = NULL; + Tcl_Free((char *) info->ubuf); + info->ubuf = NULL; } if (info->isenc) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); } if (info->iswr) { - ZipEntry *z = info->zipentry; - unsigned char *newdata; - - newdata = (unsigned char *) - Tcl_AttemptRealloc((char *) info->ubuf, info->nread); - if (newdata != NULL) { - if (z->data != NULL) { - Tcl_Free((char *) z->data); - } - z->data = newdata; - z->nbyte = z->nbytecompr = info->nbyte; - z->cmeth = ZIP_COMPMETH_STORED; - z->timestamp = time(NULL); - z->isdir = 0; - z->isenc = 0; - z->offset = 0; - z->crc32 = 0; - } else { - Tcl_Free((char *) info->ubuf); - } + ZipEntry *z = info->zipentry; + unsigned char *newdata; + + newdata = (unsigned char *) Tcl_AttemptRealloc((char *) info->ubuf, info->nread); + if (newdata != NULL) { + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + z->data = newdata; + z->nbyte = z->nbytecompr = info->nbyte; + z->cmeth = ZIP_COMPMETH_STORED; + z->timestamp = time(NULL); + z->isdir = 0; + z->isenc = 0; + z->offset = 0; + z->crc32 = 0; + } else { + Tcl_Free((char *) info->ubuf); + } } WriteLock(); info->zipfile->nopen--; @@ -2527,26 +2491,26 @@ ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) unsigned long nextpos; if (info->isdir) { - *errloc = EISDIR; - return -1; + *errloc = EISDIR; + return -1; } nextpos = info->nread + toRead; if (nextpos > info->nbyte) { - toRead = info->nbyte - info->nread; - nextpos = info->nbyte; + toRead = info->nbyte - info->nread; + nextpos = info->nbyte; } if (toRead == 0) { - return 0; + return 0; } if (info->isenc) { - int i, ch; + int i, ch; - for (i = 0; i < toRead; i++) { - ch = info->ubuf[i + info->nread]; - buf[i] = zdecode(info->keys, crc32tab, ch); - } + for (i = 0; i < toRead; i++) { + ch = info->ubuf[i + info->nread]; + buf[i] = zdecode(info->keys, crc32tab, ch); + } } else { - memcpy(buf, info->ubuf + info->nread, toRead); + memcpy(buf, info->ubuf + info->nread, toRead); } info->nread = nextpos; *errloc = 0; @@ -2577,21 +2541,21 @@ ZipChannelWrite(ClientData instanceData, const char *buf, unsigned long nextpos; if (!info->iswr) { - *errloc = EINVAL; - return -1; + *errloc = EINVAL; + return -1; } nextpos = info->nread + toWrite; if (nextpos > info->nmax) { - toWrite = info->nmax - info->nread; - nextpos = info->nmax; + toWrite = info->nmax - info->nread; + nextpos = info->nmax; } if (toWrite == 0) { - return 0; + return 0; } memcpy(info->ubuf + info->nread, buf, toWrite); info->nread = nextpos; if (info->nread > info->nbyte) { - info->nbyte = info->nread; + info->nbyte = info->nread; } *errloc = 0; return toWrite; @@ -2619,37 +2583,37 @@ ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) ZipChannel *info = (ZipChannel *) instanceData; if (info->isdir) { - *errloc = EINVAL; - return -1; + *errloc = EINVAL; + return -1; } switch (mode) { - case SEEK_CUR: - offset += info->nread; - break; - case SEEK_END: - offset += info->nbyte; - break; - case SEEK_SET: - break; - default: - *errloc = EINVAL; - return -1; + case SEEK_CUR: + offset += info->nread; + break; + case SEEK_END: + offset += info->nbyte; + break; + case SEEK_SET: + break; + default: + *errloc = EINVAL; + return -1; } if (offset < 0) { - *errloc = EINVAL; - return -1; - } - if (info->iswr) { - if ((unsigned long) offset > info->nmax) { *errloc = EINVAL; return -1; - } - if ((unsigned long) offset > info->nbyte) { - info->nbyte = offset; - } + } + if (info->iswr) { + if ((unsigned long) offset > info->nmax) { + *errloc = EINVAL; + return -1; + } + if ((unsigned long) offset > info->nbyte) { + info->nbyte = offset; + } } else if ((unsigned long) offset > info->nbyte) { - *errloc = EINVAL; - return -1; + *errloc = EINVAL; + return -1; } info->nread = (unsigned long) offset; return info->nread; @@ -2695,9 +2659,9 @@ ZipChannelWatchChannel(ClientData instanceData, int mask) */ static int -ZipChannelGetFile(ClientData instanceData, int direction, - ClientData *handlePtr) -{ +ZipChannelGetFile( + ClientData instanceData, int direction,ClientData *handlePtr +) { return TCL_ERROR; } @@ -2761,295 +2725,268 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) int i, ch, trunc, wr, flags = 0; char cname[128]; - if ((mode & O_APPEND) || - ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); - } - return NULL; + if ( + (mode & O_APPEND) + || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR))) + ) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); + } + return NULL; } WriteLock(); z = ZipFSLookup(filename); if (z == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); - Tcl_AppendResult(interp, " \"", filename, "\"", NULL); - } - goto error; + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + Tcl_AppendResult(interp, " \"", filename, "\"", NULL); + } + goto error; } trunc = (mode & O_TRUNC) != 0; wr = (mode & (O_WRONLY | O_RDWR)) != 0; - if ((z->cmeth != ZIP_COMPMETH_STORED) && - (z->cmeth != ZIP_COMPMETH_DEFLATED)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("unsupported compression method", -1)); - } - goto error; + if ((z->cmeth != ZIP_COMPMETH_STORED) && (z->cmeth != ZIP_COMPMETH_DEFLATED)) { + ZIPFS_ERROR(interp,"unsupported compression method"); + goto error; } if (wr && z->isdir) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("unsupported file type", -1)); - } - goto error; + ZIPFS_ERROR(interp,"unsupported file type"); + goto error; } if (!trunc) { - flags |= TCL_READABLE; - if (z->isenc && (z->zipfile->pwbuf[0] == 0)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("decryption failed", -1)); - } - goto error; - } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) { - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("file too large", -1)); - } - goto error; - } + flags |= TCL_READABLE; + if (z->isenc && (z->zipfile->pwbuf[0] == 0)) { + ZIPFS_ERROR(interp,"decryption failed"); + goto error; + } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) { + ZIPFS_ERROR(interp,"file too large"); + goto error; + } } else { - flags = TCL_WRITABLE; + flags = TCL_WRITABLE; } info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info)); if (info == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); - } - goto error; + ZIPFS_ERROR(interp,"out of memory"); + goto error; } info->zipfile = z->zipfile; info->zipentry = z; info->nread = 0; if (wr) { - flags |= TCL_WRITABLE; - info->iswr = 1; - info->isdir = 0; - info->nmax = ZipFS.wrmax; - info->iscompr = 0; - info->isenc = 0; - info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax); - if (info->ubuf == NULL) { + flags |= TCL_WRITABLE; + info->iswr = 1; + info->isdir = 0; + info->nmax = ZipFS.wrmax; + info->iscompr = 0; + info->isenc = 0; + info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax); + if (info->ubuf == NULL) { merror0: - if (info->ubuf != NULL) { - Tcl_Free((char *) info->ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - memset(info->ubuf, 0, info->nmax); - if (trunc) { - info->nbyte = 0; - } else { - if (z->data != NULL) { - unsigned int j = z->nbyte; + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + ZIPFS_ERROR(interp,"out of memory"); + goto error; + } + memset(info->ubuf, 0, info->nmax); + if (trunc) { + info->nbyte = 0; + } else { + if (z->data != NULL) { + unsigned int j = z->nbyte; - if (j > info->nmax) { - j = info->nmax; - } - memcpy(info->ubuf, z->data, j); - info->nbyte = j; - } else { - unsigned char *zbuf = z->zipfile->data + z->offset; - - if (z->isenc) { - int len = z->zipfile->pwbuf[0]; - char pwbuf[260]; - - for (i = 0; i < len; i++) { - ch = z->zipfile->pwbuf[len - i]; - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - } - pwbuf[i] = '\0'; - init_keys(pwbuf, info->keys, crc32tab); - memset(pwbuf, 0, sizeof (pwbuf)); - for (i = 0; i < 12; i++) { - ch = info->ubuf[i]; - zdecode(info->keys, crc32tab, ch); - } - zbuf += i; - } - if (z->cmeth == ZIP_COMPMETH_DEFLATED) { - z_stream stream; - int err; - unsigned char *cbuf = NULL; - - memset(&stream, 0, sizeof (stream)); - stream.zalloc = Z_NULL; - stream.zfree = Z_NULL; - stream.opaque = Z_NULL; - stream.avail_in = z->nbytecompr; - if (z->isenc) { - unsigned int j; - - stream.avail_in -= 12; - cbuf = (unsigned char *) - Tcl_AttemptAlloc(stream.avail_in); - if (cbuf == NULL) { - goto merror0; - } - for (j = 0; j < stream.avail_in; j++) { - ch = info->ubuf[j]; - cbuf[j] = zdecode(info->keys, crc32tab, ch); - } - stream.next_in = cbuf; - } else { - stream.next_in = zbuf; - } - stream.next_out = info->ubuf; - stream.avail_out = info->nmax; - if (inflateInit2(&stream, -15) != Z_OK) { - goto cerror0; - } - err = inflate(&stream, Z_SYNC_FLUSH); - inflateEnd(&stream); - if ((err == Z_STREAM_END) || - ((err == Z_OK) && (stream.avail_in == 0))) { - if (cbuf != NULL) { - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) cbuf); - } - goto wrapchan; - } + if (j > info->nmax) { + j = info->nmax; + } + memcpy(info->ubuf, z->data, j); + info->nbyte = j; + } else { + unsigned char *zbuf = z->zipfile->data + z->offset; + + if (z->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + zbuf += i; + } + if (z->cmeth == ZIP_COMPMETH_DEFLATED) { + z_stream stream; + int err; + unsigned char *cbuf = NULL; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (z->isenc) { + unsigned int j; + + stream.avail_in -= 12; + cbuf = (unsigned char *) + Tcl_AttemptAlloc(stream.avail_in); + if (cbuf == NULL) { + goto merror0; + } + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + cbuf[j] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = cbuf; + } else { + stream.next_in = zbuf; + } + stream.next_out = info->ubuf; + stream.avail_out = info->nmax; + if (inflateInit2(&stream, -15) != Z_OK) goto cerror0; + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + goto wrapchan; + } cerror0: - if (cbuf != NULL) { - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) cbuf); - } - if (info->ubuf != NULL) { - Tcl_Free((char *) info->ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("decompression error", -1)); - } - goto error; - } else if (z->isenc) { - for (i = 0; i < z->nbyte - 12; i++) { - ch = zbuf[i]; - info->ubuf[i] = zdecode(info->keys, crc32tab, ch); - } - } else { - memcpy(info->ubuf, zbuf, z->nbyte); - } - memset(info->keys, 0, sizeof (info->keys)); - goto wrapchan; - } - } + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + ZIPFS_ERROR(interp,"decompression error"); + goto error; + } else if (z->isenc) { + for (i = 0; i < z->nbyte - 12; i++) { + ch = zbuf[i]; + info->ubuf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(info->ubuf, zbuf, z->nbyte); + } + memset(info->keys, 0, sizeof (info->keys)); + goto wrapchan; + } + } } else if (z->data != NULL) { - flags |= TCL_READABLE; - info->iswr = 0; - info->iscompr = 0; - info->isdir = 0; - info->isenc = 0; - info->nbyte = z->nbyte; - info->nmax = 0; - info->ubuf = z->data; + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = 0; + info->isdir = 0; + info->isenc = 0; + info->nbyte = z->nbyte; + info->nmax = 0; + info->ubuf = z->data; } else { - flags |= TCL_READABLE; - info->iswr = 0; - info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED; - info->ubuf = z->zipfile->data + z->offset; - info->isdir = z->isdir; - info->isenc = z->isenc; - info->nbyte = z->nbyte; - info->nmax = 0; - if (info->isenc) { - int len = z->zipfile->pwbuf[0]; - char pwbuf[260]; - - for (i = 0; i < len; i++) { - ch = z->zipfile->pwbuf[len - i]; - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - } - pwbuf[i] = '\0'; - init_keys(pwbuf, info->keys, crc32tab); - memset(pwbuf, 0, sizeof (pwbuf)); - for (i = 0; i < 12; i++) { - ch = info->ubuf[i]; - zdecode(info->keys, crc32tab, ch); - } - info->ubuf += i; - } - if (info->iscompr) { - z_stream stream; - int err; - unsigned char *ubuf = NULL; - unsigned int j; - - memset(&stream, 0, sizeof (stream)); - stream.zalloc = Z_NULL; - stream.zfree = Z_NULL; - stream.opaque = Z_NULL; - stream.avail_in = z->nbytecompr; - if (info->isenc) { - stream.avail_in -= 12; - ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); - if (ubuf == NULL) { - info->ubuf = NULL; - goto merror; - } - for (j = 0; j < stream.avail_in; j++) { - ch = info->ubuf[j]; - ubuf[j] = zdecode(info->keys, crc32tab, ch); - } - stream.next_in = ubuf; - } else { - stream.next_in = info->ubuf; - } - stream.next_out = info->ubuf = - (unsigned char *) Tcl_AttemptAlloc(info->nbyte); - if (info->ubuf == NULL) { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED; + info->ubuf = z->zipfile->data + z->offset; + info->isdir = z->isdir; + info->isenc = z->isenc; + info->nbyte = z->nbyte; + info->nmax = 0; + if (info->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + info->ubuf += i; + } + if (info->iscompr) { + z_stream stream; + int err; + unsigned char *ubuf = NULL; + unsigned int j; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (info->isenc) { + stream.avail_in -= 12; + ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); + if (ubuf == NULL) { + info->ubuf = NULL; + goto merror; + } + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + ubuf[j] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = ubuf; + } else { + stream.next_in = info->ubuf; + } + stream.next_out = info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nbyte); + if (info->ubuf == NULL) { merror: - if (ubuf != NULL) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("out of memory", -1)); - } - goto error; - } - stream.avail_out = info->nbyte; - if (inflateInit2(&stream, -15) != Z_OK) { - goto cerror; - } - err = inflate(&stream, Z_SYNC_FLUSH); - inflateEnd(&stream); - if ((err == Z_STREAM_END) || - ((err == Z_OK) && (stream.avail_in == 0))) { - if (ubuf != NULL) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) ubuf); - } - goto wrapchan; - } + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } + stream.avail_out = info->nbyte; + if (inflateInit2(&stream, -15) != Z_OK) { + goto cerror; + } + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + goto wrapchan; + } cerror: - if (ubuf != NULL) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); - Tcl_Free((char *) ubuf); - } - if (info->ubuf != NULL) { - Tcl_Free((char *) info->ubuf); - } - Tcl_Free((char *) info); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("decompression error", -1)); - } - goto error; - } + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + ZIPFS_ERROR(interp,"decompression error"); + goto error; + } } wrapchan: sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, ZipFS.idCount++); @@ -3087,14 +3024,13 @@ ZipEntryStat(char *path, Tcl_StatBuf *buf) ReadLock(); z = ZipFSLookup(path); - if (z == NULL) { - goto done; - } + if (z == NULL) goto done; + memset(buf, 0, sizeof (Tcl_StatBuf)); if (z->isdir) { - buf->st_mode = S_IFDIR | 0555; + buf->st_mode = S_IFDIR | 0555; } else { - buf->st_mode = S_IFREG | 0555; + buf->st_mode = S_IFREG | 0555; } buf->st_size = z->nbyte; buf->st_mtime = z->timestamp; @@ -3128,9 +3064,7 @@ ZipEntryAccess(char *path, int mode) { ZipEntry *z; - if (mode & 3) { - return -1; - } + if (mode & 3) return -1; ReadLock(); z = ZipFSLookup(path); Unlock(); @@ -3154,11 +3088,8 @@ Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions) { int len; - if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return NULL; - - return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), - mode, permissions); + return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, permissions); } /* @@ -3182,9 +3113,7 @@ static int Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) { int len; - if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; - return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); } @@ -3209,9 +3138,7 @@ static int Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) { int len; - if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; - return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); } @@ -3273,7 +3200,7 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; if (types != NULL) { - dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; + dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; } /* the prefix that gets prepended to results */ @@ -3286,14 +3213,14 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, Tcl_DStringAppend(&dsPref, prefix, prefixLen); if (strcmp(prefix, path) == 0) { - prefix = NULL; + prefix = NULL; } else { - strip = len + 1; + strip = len + 1; } if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, "/", 1); - prefixLen++; - prefix = Tcl_DStringValue(&dsPref); + Tcl_DStringAppend(&dsPref, "/", 1); + prefixLen++; + prefix = Tcl_DStringValue(&dsPref); } ReadLock(); if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { @@ -3311,42 +3238,47 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->mntptlen == 0) { - ZipEntry *z = zf->topents; - while (z != NULL) { - int lenz = strlen(z->name); - if ((lenz > len + 1) && - (strncmp(z->name, path, len) == 0) && - (z->name[len] == '/') && - (CountSlashes(z->name) == l) && - Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name, lenz); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name, lenz)); - } - } - z = z->tnext; - } - } else if ((zf->mntptlen > len + 1) && - (strncmp(zf->mntpt, path, len) == 0) && - (zf->mntpt[len] == '/') && - (CountSlashes(zf->mntpt) == l) && - Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); - } + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + if ( + (lenz > len + 1) + && (strncmp(z->name, path, len) == 0) + && (z->name[len] == '/') + && (CountSlashes(z->name) == l) + && Tcl_StringCaseMatch(z->name + len + 1, pattern, 0) + ) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, lenz); + Tcl_ListObjAppendElement( + NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref)) + ); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name, lenz)); + } + } + z = z->tnext; + } + } else if ( + (zf->mntptlen > len + 1) + && (strncmp(zf->mntpt, path, len) == 0) + && (zf->mntpt[len] == '/') + && (CountSlashes(zf->mntpt) == l) + && Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0) + ) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } } hPtr = Tcl_NextHashEntry(&search); } @@ -3378,33 +3310,38 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, pat = Tcl_Alloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { - --len; + --len; } if ((len > 1) || (pat[0] != '/')) { - pat[len] = '/'; - ++len; + pat[len] = '/'; + ++len; } memcpy(pat + len, pattern, l + 1); scnt = CountSlashes(pat); - for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - if ((dirOnly >= 0) && - ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) { - continue; - } - if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name + strip, -1); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name + strip, -1)); - } - } + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + if ( + (dirOnly >= 0) && ((dirOnly && !z->isdir) || (!dirOnly && z->isdir)) + ) { + continue; + } + if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name + strip, -1); + Tcl_ListObjAppendElement( + NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref)) + ); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name + strip, -1)); + } + } } Tcl_Free(pat); end: @@ -3443,7 +3380,7 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) path = Tcl_GetStringFromObj(pathPtr, &len); if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) { - return -1; + return -1; } len = strlen(path); @@ -3451,30 +3388,31 @@ Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) ReadLock(); hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); if (hPtr != NULL) { - ret = TCL_OK; - goto endloop; + ret = TCL_OK; + goto endloop; } hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); while (hPtr != NULL) { - zf = (ZipFile *) Tcl_GetHashValue(hPtr); - if (zf->mntptlen == 0) { - ZipEntry *z = zf->topents; - while (z != NULL) { - int lenz = strlen(z->name); - - if ((len >= lenz) && - (strncmp(path, z->name, lenz) == 0)) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + if ( + (len >= lenz) && (strncmp(path, z->name, lenz) == 0) + ) { + ret = TCL_OK; + goto endloop; + } + z = z->tnext; + } + } else if ( + (len >= zf->mntptlen) && (strncmp(path, zf->mntpt, zf->mntptlen) == 0) + ) { ret = TCL_OK; goto endloop; - } - z = z->tnext; } - } else if ((len >= zf->mntptlen) && - (strncmp(path, zf->mntpt, zf->mntptlen) == 0)) { - ret = TCL_OK; - goto endloop; - } - hPtr = Tcl_NextHashEntry(&search); + hPtr = Tcl_NextHashEntry(&search); } endloop: Unlock(); @@ -3530,7 +3468,6 @@ Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) "-permissions", NULL, }; - return attrs; } @@ -3563,40 +3500,35 @@ Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, ZipEntry *z; if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; - path = Tcl_GetStringFromObj(pathPtr, &len); ReadLock(); z = ZipFSLookup(path); if (z == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); - } - ret = TCL_ERROR; - goto done; + ZIPFS_ERROR(interp,"file not found"); + ret = TCL_ERROR; + goto done; } switch (index) { - case 0: - *objPtrRef = Tcl_NewIntObj(z->nbyte); - goto done; - case 1: - *objPtrRef= Tcl_NewIntObj(z->nbytecompr); - goto done; - case 2: - *objPtrRef= Tcl_NewLongObj(z->offset); - goto done; - case 3: - *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1); - goto done; - case 4: - *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); - goto done; - case 5: - *objPtrRef= Tcl_NewStringObj("0555", -1); - goto done; - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown attribute", -1)); - } + case 0: + *objPtrRef = Tcl_NewIntObj(z->nbyte); + goto done; + case 1: + *objPtrRef= Tcl_NewIntObj(z->nbytecompr); + goto done; + case 2: + *objPtrRef= Tcl_NewLongObj(z->offset); + goto done; + case 3: + *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1); + goto done; + case 4: + *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); + goto done; + case 5: + *objPtrRef= Tcl_NewStringObj("0555", -1); + goto done; + } + ZIPFS_ERROR(interp,"unknown attribute"); ret = TCL_ERROR; done: Unlock(); @@ -3621,11 +3553,10 @@ done: */ static int -Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, - Tcl_Obj *objPtr) +Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); } return TCL_ERROR; } @@ -3685,7 +3616,7 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; if (loadFileProc != NULL) { - return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } Tcl_SetErrno(ENOENT); return -1; @@ -3694,67 +3625,66 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, int ret = -1; if (Tcl_FSAccess(path, R_OK) == 0) { - /* - * EXDEV should trigger loading by copying to temp store. - */ - Tcl_SetErrno(EXDEV); - return ret; + /* + * EXDEV should trigger loading by copying to temp store. + */ + Tcl_SetErrno(EXDEV); + return ret; } else { - Tcl_Obj *objs[2] = { NULL, NULL }; - - objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); - if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { - const char *execName = Tcl_GetNameOfExecutable(); - - /* - * Shared object is not in ZIP but its path prefix is, - * thus try to load from directory where the executable - * came from. - */ - TclDecrRefCount(objs[1]); - objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); - /* - * Get directory name of executable manually to deal - * with cases where [file dirname [info nameofexecutable]] - * is equal to [info nameofexecutable] due to VFS effects. - */ - if (execName != NULL) { - const char *p = strrchr(execName, '/'); - - if (p > execName + 1) { - --p; - objs[0] = Tcl_NewStringObj(execName, p - execName); - } - } - if (objs[0] == NULL) { - objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), - TCL_PATH_DIRNAME); - } - if (objs[0] != NULL) { - altPath = TclJoinPath(2, objs); - if (altPath != NULL) { - Tcl_IncrRefCount(altPath); - if (Tcl_FSAccess(altPath, R_OK) == 0) { - path = altPath; - } - } - } - } - if (objs[0] != NULL) { - Tcl_DecrRefCount(objs[0]); - } - if (objs[1] != NULL) { - Tcl_DecrRefCount(objs[1]); - } + Tcl_Obj *objs[2] = { NULL, NULL }; + + objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); + if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { + const char *execName = Tcl_GetNameOfExecutable(); + + /* + * Shared object is not in ZIP but its path prefix is, + * thus try to load from directory where the executable + * came from. + */ + TclDecrRefCount(objs[1]); + objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); + /* + * Get directory name of executable manually to deal + * with cases where [file dirname [info nameofexecutable]] + * is equal to [info nameofexecutable] due to VFS effects. + */ + if (execName != NULL) { + const char *p = strrchr(execName, '/'); + + if (p > execName + 1) { + --p; + objs[0] = Tcl_NewStringObj(execName, p - execName); + } + } + if (objs[0] == NULL) { + objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),TCL_PATH_DIRNAME); + } + if (objs[0] != NULL) { + altPath = TclJoinPath(2, objs); + if (altPath != NULL) { + Tcl_IncrRefCount(altPath); + if (Tcl_FSAccess(altPath, R_OK) == 0) { + path = altPath; + } + } + } + } + if (objs[0] != NULL) { + Tcl_DecrRefCount(objs[0]); + } + if (objs[1] != NULL) { + Tcl_DecrRefCount(objs[1]); + } } loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; if (loadFileProc != NULL) { - ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { - Tcl_SetErrno(ENOENT); + Tcl_SetErrno(ENOENT); } if (altPath != NULL) { - Tcl_DecrRefCount(altPath); + Tcl_DecrRefCount(altPath); } return ret; #endif @@ -3864,8 +3794,8 @@ TclZipfs_Init(Tcl_Interp *interp) {NULL, NULL, NULL, NULL, NULL, 0} }; static const char findproc[] = - "namespace eval zipfs {}\n" - "proc ::zipfs::find dir {\n" + "namespace eval ::tcl::zipfs::zipfs {}\n" + "proc ::tcl::zipfs::find dir {\n" " set result {}\n" " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n" " return $result\n" @@ -3876,23 +3806,20 @@ TclZipfs_Init(Tcl_Interp *interp) " }\n" " set file [file join $dir $file]\n" " lappend result $file\n" - " foreach file [::zipfs::find $file] {\n" + " foreach file [::tcl::zipfs::find $file] {\n" " lappend result $file\n" " }\n" " }\n" " return [lsort $result]\n" "}\n"; Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); - Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax, - TCL_LINK_INT); + Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,TCL_LINK_INT); TclMakeEnsemble(interp, "zipfs", initMap); Tcl_PkgProvide(interp, "zipfs", "2.0"); } return TCL_OK; #else - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("no zlib available", -1)); - } + ZIPFS_ERROR(interp,"no zlib available"); return TCL_ERROR; #endif } @@ -3963,8 +3890,6 @@ int TclZipfs_AppHook(int *argc, char ***argv) TclZipfs_Init(NULL); /* ** Look for init.tcl in one of the locations mounted later in this function - ** and failing that, look for a file name CFG_RUNTIME_ZIPFILE adjacent to the - ** executable */ if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { int found; @@ -4061,7 +3986,7 @@ Tcl_Obj *TclZipfs_TclLibrary(void) { if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SRCDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } } -- cgit v0.12 From b3ff8cc20cdc84f12b4b9a571092a340c591f216 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 24 Nov 2017 11:21:55 +0000 Subject: Pulling changes from Androwish --- generic/tclZipfs.c | 1098 +++++++++++++++++++++++++++++----------------------- 1 file changed, 610 insertions(+), 488 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index b9d09f1..668eee0 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -1,8 +1,8 @@ /* * tclZipfs.c -- * - * Implementation of the ZIP filesystem used in TIP 430 - * Adapted from the implentation for AndroWish. + * Implementation of the ZIP filesystem used in TIP 430 + * Adapted from the implentation for AndroWish. * * Coptright (c) 2016-2017 Sean Woods * Copyright (c) 2013-2015 Christian Werner @@ -26,6 +26,10 @@ #include #include +#ifndef MAP_FILE +#define MAP_FILE 0 +#endif + #ifdef HAVE_ZLIB #include "zlib.h" #include "crypt.h" @@ -106,15 +110,15 @@ * Macros to read and write 16 and 32 bit integers from/to ZIP archives. */ -#define zip_read_int(p) \ +#define zip_read_int(p) \ ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24)) -#define zip_read_short(p) \ +#define zip_read_short(p) \ ((p)[0] | ((p)[1] << 8)) -#define zip_write_int(p, v) \ - (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ +#define zip_write_int(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff; -#define zip_write_short(p, v) \ +#define zip_write_short(p, v) \ (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; /* @@ -163,7 +167,7 @@ typedef struct ZipFile { struct ZipEntry *entries; /* List of files in archive */ struct ZipEntry *topents; /* List of top-level dirs in archive */ #if HAS_DRIVES - int mntdrv; /* Drive letter of mount point */ + int mntdrv; /* Drive letter of mount point */ #endif int mntptlen; /* Length of mount point */ char mntpt[1]; /* Mount point */ @@ -180,8 +184,8 @@ typedef struct ZipEntry { int nbyte; /* Uncompressed size of the virtual file */ int nbytecompr; /* Compressed size of the virtual file */ int cmeth; /* Compress method */ - int isdir; /* Set to 1 if directory */ - int depth; /* Number of slashes in path. */ + int isdir; /* Set to 1 if directory, or -1 if root */ + int depth; /* Number of slashes in path. */ int crc32; /* CRC-32 */ int timestamp; /* Modification time */ int isenc; /* True if data is encrypted */ @@ -202,7 +206,7 @@ typedef struct ZipChannel { unsigned long nread; /* Pos of next byte to be read from the channel */ unsigned char *ubuf; /* Pointer to the uncompressed data */ int iscompr; /* True if data is compressed */ - int isdir; /* Set to 1 if directory */ + int isdir; /* Set to 1 if directory, or -1 if root */ int isenc; /* True if data is encrypted */ int iswr; /* True if open for writing */ unsigned long keys[3]; /* Key for decryption */ @@ -222,13 +226,13 @@ typedef struct ZipChannel { */ static struct { - int initialized; /* True when initialized */ - int lock; /* RW lock, see below */ - int waiters; /* RW lock, see below */ - int wrmax; /* Maximum write size of a file */ - int idCount; /* Counter for channel names */ - Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ - Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ + int initialized; /* True when initialized */ + int lock; /* RW lock, see below */ + int waiters; /* RW lock, see below */ + int wrmax; /* Maximum write size of a file */ + int idCount; /* Counter for channel names */ + Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ + Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ } ZipFS = { 0, 0, 0, 0, 0, }; @@ -309,12 +313,12 @@ const char *zipfs_literal_tcl_library=NULL; * * ReadLock, WriteLock, Unlock -- * - * POSIX like rwlock functions to support multiple readers - * and single writer on internal structs. + * POSIX like rwlock functions to support multiple readers + * and single writer on internal structs. * - * Limitations: - * - a read lock cannot be promoted to a write lock - * - a write lock may not be nested + * Limitations: + * - a read lock cannot be promoted to a write lock + * - a write lock may not be nested * *------------------------------------------------------------------------- */ @@ -330,9 +334,9 @@ ReadLock(void) { Tcl_MutexLock(&ZipFSMutex); while (ZipFS.lock < 0) { - ZipFS.waiters++; - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); - ZipFS.waiters--; + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; } ZipFS.lock++; Tcl_MutexUnlock(&ZipFSMutex); @@ -343,9 +347,9 @@ WriteLock(void) { Tcl_MutexLock(&ZipFSMutex); while (ZipFS.lock != 0) { - ZipFS.waiters++; - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); - ZipFS.waiters--; + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; } ZipFS.lock = -1; Tcl_MutexUnlock(&ZipFSMutex); @@ -356,21 +360,21 @@ Unlock(void) { Tcl_MutexLock(&ZipFSMutex); if (ZipFS.lock > 0) { - --ZipFS.lock; + --ZipFS.lock; } else if (ZipFS.lock < 0) { - ZipFS.lock = 0; + ZipFS.lock = 0; } if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) { - Tcl_ConditionNotify(&ZipFSCond); + Tcl_ConditionNotify(&ZipFSCond); } Tcl_MutexUnlock(&ZipFSMutex); } #else -#define ReadLock() do {} while (0) -#define WriteLock() do {} while (0) -#define Unlock() do {} while (0) +#define ReadLock() do {} while (0) +#define WriteLock() do {} while (0) +#define Unlock() do {} while (0) #endif @@ -379,8 +383,8 @@ Unlock(void) * * DosTimeDate, ToDosTime, ToDosDate -- * - * Functions to perform conversions between DOS time stamps - * and POSIX time_t. + * Functions to perform conversions between DOS time stamps + * and POSIX time_t. * *------------------------------------------------------------------------- */ @@ -467,13 +471,13 @@ ToDosDate(time_t when) * * CountSlashes -- * - * This function counts the number of slashes in a pathname string. + * This function counts the number of slashes in a pathname string. * * Results: - * Number of slashes found in string. + * Number of slashes found in string. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -498,15 +502,15 @@ CountSlashes(const char *string) * * CanonicalPath -- * - * This function computes the canonical path from a directory - * and file name components into the specified Tcl_DString. + * This function computes the canonical path from a directory + * and file name components into the specified Tcl_DString. * * Results: - * Returns the pointer to the canonical path contained in the - * specified Tcl_DString. + * Returns the pointer to the canonical path contained in the + * specified Tcl_DString. * * Side effects: - * Modifies the specified Tcl_DString. + * Modifies the specified Tcl_DString. * *------------------------------------------------------------------------- */ @@ -611,9 +615,9 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA } #endif if(ZIPFSPATH) { - n=ZIPFS_VOLUME_LEN; + n=ZIPFS_VOLUME_LEN; } else { - n=0; + n=0; } for (i = j = n; (c = path[i]) != '\0'; i++) { if (c == '/') { @@ -648,7 +652,7 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA path[j++] = c; } if (j == 0) { - path[j++] = '/'; + path[j++] = '/'; } path[j] = 0; Tcl_DStringSetLength(dsPtr, j); @@ -663,16 +667,16 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA * * ZipFSLookup -- * - * This function returns the ZIP entry struct corresponding to - * the ZIP archive member of the given file name. + * This function returns the ZIP entry struct corresponding to + * the ZIP archive member of the given file name. * * Results: - * Returns the pointer to ZIP entry struct or NULL if the - * the given file name could not be found in the global list - * of ZIP archive members. + * Returns the pointer to ZIP entry struct or NULL if the + * the given file name could not be found in the global list + * of ZIP archive members. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -697,14 +701,14 @@ ZipFSLookup(char *filename) * * ZipFSLookupMount -- * - * This function returns an indication if the given file name - * corresponds to a mounted ZIP archive file. + * This function returns an indication if the given file name + * corresponds to a mounted ZIP archive file. * * Results: - * Returns true, if the given file name is a mounted ZIP archive file. + * Returns true, if the given file name is a mounted ZIP archive file. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -734,14 +738,14 @@ ZipFSLookupMount(char *filename) * * ZipFSCloseArchive -- * - * This function closes a mounted ZIP archive file. + * This function closes a mounted ZIP archive file. * * Results: - * None. + * None. * * Side effects: - * A memory mapped ZIP archive is unmapped, allocated memory is - * released. + * A memory mapped ZIP archive is unmapped, allocated memory is + * released. * *------------------------------------------------------------------------- */ @@ -755,20 +759,22 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) zf->data = NULL; } if (zf->mh != INVALID_HANDLE_VALUE) { - CloseHandle(zf->mh); + CloseHandle(zf->mh); } #else if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) { - munmap(zf->data, zf->length); - zf->data = MAP_FAILED; + munmap(zf->data, zf->length); + zf->data = MAP_FAILED; } #endif if (zf->tofree != NULL) { - Tcl_Free((char *) zf->tofree); - zf->tofree = NULL; + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; + } + if(zf->chan != NULL) { + Tcl_Close(interp, zf->chan); + zf->chan = NULL; } - Tcl_Close(interp, zf->chan); - zf->chan = NULL; } /* @@ -776,27 +782,27 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) * * ZipFSOpenArchive -- * - * This function opens a ZIP archive file for reading. An attempt - * is made to memory map that file. Otherwise it is read into - * an allocated memory buffer. The ZIP archive header is verified - * and must be valid for the function to succeed. When "needZip" - * is zero an embedded ZIP archive in an executable file is accepted. + * This function opens a ZIP archive file for reading. An attempt + * is made to memory map that file. Otherwise it is read into + * an allocated memory buffer. The ZIP archive header is verified + * and must be valid for the function to succeed. When "needZip" + * is zero an embedded ZIP archive in an executable file is accepted. * * Results: - * TCL_OK on success, TCL_ERROR otherwise with an error message - * placed into the given "interp" if it is not NULL. + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. * * Side effects: - * ZIP archive is memory mapped or read into allocated memory, - * the given ZipFile struct is filled with information about - * the ZIP archive file. + * ZIP archive is memory mapped or read into allocated memory, + * the given ZipFile struct is filled with information about + * the ZIP archive file. * *------------------------------------------------------------------------- */ static int ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, - ZipFile *zf) + ZipFile *zf) { int i; ClientData handle; @@ -815,7 +821,7 @@ ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, zf->pwbuf[0] = 0; zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0); if (zf->chan == NULL) { - return TCL_ERROR; + return TCL_ERROR; } if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") != TCL_OK) { @@ -905,20 +911,20 @@ ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, return TCL_OK; } ZIPFS_ERROR(interp,"empty archive"); - goto error; + goto error; } q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); if ( (p < zf->data) || (p > (zf->data + zf->length)) || - (q < zf->data) || (q > (zf->data + zf->length)) - ) { + (q < zf->data) || (q > (zf->data + zf->length)) + ) { if (!needZip) { zf->baseoffs = zf->baseoffsp = zf->length; return TCL_OK; } - ZIPFS_ERROR(interp,"archive directory not found"); - goto error; + ZIPFS_ERROR(interp,"archive directory not found"); + goto error; } zf->baseoffs = zf->baseoffsp = p - q; zf->centoffs = p - zf->data; @@ -961,14 +967,14 @@ error: * TclZipfs_Mount -- * * This procedure is invoked to mount a given ZIP archive file on - * a given mountpoint with optional ZIP password. + * a given mountpoint with optional ZIP password. * * Results: * A standard Tcl result. * * Side effects: * A ZIP archive file is read, analyzed and mounted, resources are - * allocated. + * allocated. * *------------------------------------------------------------------------- */ @@ -977,7 +983,7 @@ int TclZipfs_Mount( Tcl_Interp *interp, const char *zipname, const char *mntpt, - const char *passwd + const char *passwd ) { int i, pwlen, isNew; ZipFile *zf, zf0; @@ -1030,17 +1036,17 @@ TclZipfs_Mount( Unlock(); pwlen = 0; if (passwd != NULL) { - pwlen = strlen(passwd); - if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); - } - return TCL_ERROR; - } + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; + } } if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } /* * Mount point can come from Tcl_GetNameOfExecutable() @@ -1097,7 +1103,7 @@ TclZipfs_Mount( z->tnext = NULL; z->depth = CountSlashes(mntpt); z->zipfile = zf; - z->isdir = 1; + z->isdir = (zf->baseoffs == 0) ? 1 : -1; /* root marker */ z->isenc = 0; z->offset = zf->baseoffs; z->crc32 = 0; @@ -1316,7 +1322,7 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); - /* don't report error */ + /* don't report error */ if (hPtr == NULL) goto done; zf = (ZipFile *) Tcl_GetHashValue(hPtr); @@ -1343,7 +1349,7 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) done: Unlock(); if (unmounted) { - Tcl_FSMountsChanged(NULL); + Tcl_FSMountsChanged(NULL); } return ret; } @@ -1374,8 +1380,8 @@ ZipFSMountObjCmd( return TCL_ERROR; } return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, - (objc > 2) ? Tcl_GetString(objv[2]) : NULL, - (objc > 3) ? Tcl_GetString(objv[3]) : NULL); + (objc > 2) ? Tcl_GetString(objv[2]) : NULL, + (objc > 3) ? Tcl_GetString(objv[3]) : NULL); } /* @@ -1435,7 +1441,7 @@ ZipFSUnmountObjCmd( * ZipFSMkKeyObjCmd -- * * This procedure is invoked to process the "zipfs::mkkey" command. - * It produces a rotated password to be embedded into an image file. + * It produces a rotated password to be embedded into an image file. * * Results: * A standard Tcl result. @@ -1454,13 +1460,13 @@ ZipFSMkKeyObjCmd( char *pw, pwbuf[264]; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "password"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "password"); + return TCL_ERROR; } pw = Tcl_GetString(objv[1]); len = strlen(pw); if (len == 0) { - return TCL_OK; + return TCL_OK; } if ((len > 255) || (strchr(pw, 0xff) != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1)); @@ -1490,16 +1496,16 @@ ZipFSMkKeyObjCmd( * ZipAddFile -- * * This procedure is used by ZipFSMkZipOrImgCmd() to add a single - * file to the output ZIP archive file being written. A ZipEntry - * struct about the input file is added to the given fileHash table - * for later creation of the central ZIP directory. + * file to the output ZIP archive file being written. A ZipEntry + * struct about the input file is added to the given fileHash table + * for later creation of the central ZIP directory. * * Results: * A standard Tcl result. * * Side effects: - * Input file is read and (compressed and) written to the output - * ZIP archive file. + * Input file is read and (compressed and) written to the output + * ZIP archive file. * *------------------------------------------------------------------------- */ @@ -1507,8 +1513,8 @@ ZipFSMkKeyObjCmd( static int ZipAddFile( Tcl_Interp *interp, const char *path, const char *name, - Tcl_Channel out, const char *passwd, - char *buf, int bufsize, Tcl_HashTable *fileHash + Tcl_Channel out, const char *passwd, + char *buf, int bufsize, Tcl_HashTable *fileHash ) { Tcl_Channel in; Tcl_HashEntry *hPtr; @@ -1522,10 +1528,10 @@ ZipAddFile( zpath = name; while (zpath != NULL && zpath[0] == '/') { - zpath++; + zpath++; } if ((zpath == NULL) || (zpath[0] == '\0')) { - return TCL_OK; + return TCL_OK; } zpathlen = strlen(zpath); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { @@ -1545,8 +1551,8 @@ ZipAddFile( return TCL_OK; } #endif - Tcl_Close(interp, in); - return TCL_ERROR; + Tcl_Close(interp, in); + return TCL_ERROR; } else { Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); Tcl_StatBuf statBuf; @@ -1589,9 +1595,9 @@ ZipAddFile( len = zpathlen + ZIP_LOCAL_HEADER_LEN; if (Tcl_Write(out, buf, len) != len) { wrerr: - Tcl_AppendResult(interp, "write error", (char *) NULL); - Tcl_Close(interp, in); - return TCL_ERROR; + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; } if ((len + pos[0]) & 3) { char abuf[8]; @@ -1658,44 +1664,44 @@ wrerr: return TCL_ERROR; } do { - len = Tcl_Read(in, buf, bufsize); - if (len == -1) { - Tcl_AppendResult(interp, "read error on \"", path, "\"", - (char *) NULL); - deflateEnd(&stream); - Tcl_Close(interp, in); - return TCL_ERROR; - } - stream.avail_in = len; - stream.next_in = (unsigned char *) buf; - flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; - do { - stream.avail_out = sizeof (obuf); - stream.next_out = (unsigned char *) obuf; - len = deflate(&stream, flush); - if (len == Z_STREAM_ERROR) { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + stream.avail_in = len; + stream.next_in = (unsigned char *) buf; + flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; + do { + stream.avail_out = sizeof (obuf); + stream.next_out = (unsigned char *) obuf; + len = deflate(&stream, flush); + if (len == Z_STREAM_ERROR) { Tcl_AppendResult(interp, "deflate error on \"", path, "\"", (char *) NULL); deflateEnd(&stream); Tcl_Close(interp, in); return TCL_ERROR; - } - olen = sizeof (obuf) - stream.avail_out; - if (passwd != NULL) { + } + olen = sizeof (obuf) - stream.avail_out; + if (passwd != NULL) { int i, tmp; for (i = 0; i < olen; i++) { obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } - } - if (olen && (Tcl_Write(out, obuf, olen) != olen)) { + } + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { Tcl_AppendResult(interp, "write error", (char *) NULL); deflateEnd(&stream); Tcl_Close(interp, in); return TCL_ERROR; - } - nbytecompr += olen; - } while (stream.avail_out == 0); + } + nbytecompr += olen; + } while (stream.avail_out == 0); } while (flush != Z_FINISH); deflateEnd(&stream); Tcl_Flush(out); @@ -1814,23 +1820,23 @@ seekErr: * ZipFSMkZipOrImgObjCmd -- * * This procedure is creates a new ZIP archive file or image file - * given output filename, input directory of files to be archived, - * optional password, and optional image to be prepended to the - * output ZIP archive file. + * given output filename, input directory of files to be archived, + * optional password, and optional image to be prepended to the + * output ZIP archive file. * * Results: * A standard Tcl result. * * Side effects: - * A new ZIP archive file or image file is written. + * A new ZIP archive file or image file is written. * *------------------------------------------------------------------------- */ static int -ZipFSMkZipOrImgObjCmd( - ClientData clientData, Tcl_Interp *interp,int isImg, int isList, int objc, Tcl_Obj *const objv[] -) { +ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int isImg, int isList, int objc, Tcl_Obj *const objv[]) +{ Tcl_Channel out; int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3]; Tcl_Obj **lobjv, *list = NULL; @@ -1843,15 +1849,15 @@ ZipFSMkZipOrImgObjCmd( if (isList) { if ((objc < 3) || (objc > (isImg ? 5 : 4))) { Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile inlist ?password infile?" : - "outfile inlist ?password?"); + "outfile inlist ?password infile?" : + "outfile inlist ?password?"); return TCL_ERROR; } } else { if ((objc < 3) || (objc > (isImg ? 6 : 5))) { Tcl_WrongNumArgs(interp, 1, objv, isImg ? - "outfile indir ?strip? ?password? ?infile?" : - "outfile indir ?strip? ?password?"); + "outfile indir ?strip? ?password? ?infile?" : + "outfile indir ?strip? ?password?"); return TCL_ERROR; } } @@ -1861,7 +1867,7 @@ ZipFSMkZipOrImgObjCmd( pwlen = strlen(pw); if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); + Tcl_NewStringObj("illegal password", -1)); return TCL_ERROR; } } @@ -1890,7 +1896,7 @@ ZipFSMkZipOrImgObjCmd( if (isList && (lobjc % 2)) { Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, - Tcl_NewStringObj("need even number of elements", -1)); + Tcl_NewStringObj("need even number of elements", -1)); return TCL_ERROR; } if (lobjc == 0) { @@ -1904,35 +1910,33 @@ ZipFSMkZipOrImgObjCmd( || (Tcl_SetChannelOption(interp, out, "-translation", "binary") != TCL_OK) || (Tcl_SetChannelOption(interp, out, "-encoding", "binary") != TCL_OK) ) { - Tcl_DecrRefCount(list); - Tcl_Close(interp, out); - return TCL_ERROR; + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + if (pwlen <= 0) { + pw = NULL; + pwlen = 0; } if (isImg) { - ZipFile zf0; + ZipFile *zf, zf0; + int isMounted = 0; const char *imgName; if (isList) { - imgName = (objc > 4) ? Tcl_GetString(objv[4]) : - Tcl_GetNameOfExecutable(); + imgName = (objc > 4) ? Tcl_GetString(objv[4]) : Tcl_GetNameOfExecutable(); } else { - imgName = (objc > 5) ? Tcl_GetString(objv[5]) : - Tcl_GetNameOfExecutable(); - } - if (ZipFSOpenArchive(interp, imgName, 0, &zf0) != TCL_OK) { - Tcl_DecrRefCount(list); - Tcl_Close(interp, out); - return TCL_ERROR; + imgName = (objc > 5) ? Tcl_GetString(objv[5]) : Tcl_GetNameOfExecutable(); } - if ((pw != NULL) && pwlen) { + if (pwlen) { i = 0; len = pwlen; while (len > 0) { - int ch = pw[len - 1]; + int ch = pw[len - 1]; - pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; - i++; - len--; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; } pwbuf[i] = i; ++i; @@ -1942,23 +1946,108 @@ ZipFSMkZipOrImgObjCmd( pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); pwbuf[i] = '\0'; } - i = Tcl_Write(out, (char *) zf0.data, zf0.baseoffsp); - if (i != zf0.baseoffsp) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - Tcl_Close(interp, out); - ZipFSCloseArchive(interp, &zf0); - return TCL_ERROR; + /* Check for mounted image */ + WriteLock(); + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (strcmp(zf->name, imgName) == 0) { + isMounted = 1; + zf->nopen++; + break; + } + } + hPtr = Tcl_NextHashEntry(&search); + } + Unlock(); + if (!isMounted) { + zf = &zf0; + } + if (isMounted || + (ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK)) { + i = Tcl_Write(out, (char *) zf->data, zf->baseoffsp); + if (i != zf->baseoffsp) { + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + if (zf == &zf0) { + ZipFSCloseArchive(interp, zf); + } else { + WriteLock(); + zf->nopen--; + Unlock(); + } + return TCL_ERROR; + } + if (zf == &zf0) { + ZipFSCloseArchive(interp, zf); + } else { + WriteLock(); + zf->nopen--; + Unlock(); + } + } else { + int k, n, m; + Tcl_Channel in; + const char *errMsg = "seek error"; + + /* + * Fall back to read it as plain file which + * hopefully is a static tclsh or wish binary + * with proper zipfs infrastructure built in. + */ + Tcl_ResetResult(interp); + in = Tcl_OpenFileChannel(interp, imgName, "r", 0644); + if (in == NULL) { + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + Tcl_SetChannelOption(interp, in, "-translation", "binary"); + Tcl_SetChannelOption(interp, in, "-encoding", "binary"); + i = Tcl_Seek(in, 0, SEEK_END); + if (i == -1) { +cperr: + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_Close(interp, out); + Tcl_Close(interp, in); + return TCL_ERROR; + } + Tcl_Seek(in, 0, SEEK_SET); + k = 0; + while (k < i) { + m = i - k; + if (m > sizeof (buf)) { + m = sizeof (buf); + } + n = Tcl_Read(in, buf, m); + if (n == -1) { + errMsg = "read error"; + goto cperr; + } else if (n == 0) { + break; + } + m = Tcl_Write(out, buf, n); + if (m != n) { + errMsg = "write error"; + goto cperr; + } + k += m; + } + Tcl_Close(interp, in); } - ZipFSCloseArchive(interp, &zf0); len = strlen(pwbuf); if (len > 0) { i = Tcl_Write(out, pwbuf, len); if (i != len) { - Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - Tcl_Close(interp, out); - return TCL_ERROR; + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + return TCL_ERROR; } } memset(pwbuf, 0, sizeof (pwbuf)); @@ -1992,65 +2081,66 @@ ZipFSMkZipOrImgObjCmd( if (name[0] == '\0') { continue; } - if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), &fileHash) != TCL_OK) { + if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), + &fileHash) != TCL_OK) { goto done; } } pos[1] = Tcl_Tell(out); count = 0; for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { - const char *path, *name; - - path = Tcl_GetString(lobjv[i]); - if (isList) { - name = Tcl_GetString(lobjv[i + 1]); - } else { - name = path; - if (slen > 0) { - len = strlen(name); - if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { - continue; + const char *path, *name; + + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; } - name += slen; - } - } - while (name[0] == '/') { - ++name; - } - if (name[0] == '\0') { - continue; - } - hPtr = Tcl_FindHashEntry(&fileHash, name); - if (hPtr == NULL) { - continue; - } - z = (ZipEntry *) Tcl_GetHashValue(hPtr); - len = strlen(z->name); - zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); - zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); - zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); - zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0); - zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth); - zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); - zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); - zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); - zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr); - zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte); - zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len); - zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); - zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); - zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); - zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); - if ( - (Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) - || (Tcl_Write(out, z->name, len) != len) - ) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); - goto done; - } - count++; + } + while (name[0] == '/') { + ++name; + } + if (name[0] == '\0') { + continue; + } + hPtr = Tcl_FindHashEntry(&fileHash, name); + if (hPtr == NULL) { + continue; + } + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + len = strlen(z->name); + zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); + zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0); + zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len); + zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); + if ( + (Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) + || (Tcl_Write(out, z->name, len) != len) + ) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + goto done; + } + count++; } Tcl_Flush(out); pos[2] = Tcl_Tell(out); @@ -2070,9 +2160,9 @@ ZipFSMkZipOrImgObjCmd( ret = TCL_OK; done: if (ret == TCL_OK) { - ret = Tcl_Close(interp, out); + ret = Tcl_Close(interp, out); } else { - Tcl_Close(interp, out); + Tcl_Close(interp, out); } Tcl_DecrRefCount(list); hPtr = Tcl_FirstHashEntry(&fileHash, &search); @@ -2080,7 +2170,7 @@ done: z = (ZipEntry *) Tcl_GetHashValue(hPtr); Tcl_Free((char *) z); Tcl_DeleteHashEntry(hPtr); - hPtr = Tcl_FirstHashEntry(&fileHash, &search); + hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&fileHash); return ret; @@ -2092,13 +2182,13 @@ done: * ZipFSMkZipObjCmd -- * * This procedure is invoked to process the "zipfs::mkzip" command. - * See description of ZipFSMkZipOrImgCmd(). + * See description of ZipFSMkZipOrImgCmd(). * * Results: * A standard Tcl result. * * Side effects: - * See description of ZipFSMkZipOrImgCmd(). + * See description of ZipFSMkZipOrImgCmd(). * *------------------------------------------------------------------------- */ @@ -2120,30 +2210,30 @@ ZipFSLMkZipObjCmd( /* *------------------------------------------------------------------------- * - * ZipFSMkImgObjCmd -- + * ZipFSZipFSOpenArchiveObjCmd -- * * This procedure is invoked to process the "zipfs::mkimg" command. - * See description of ZipFSMkZipOrImgCmd(). + * See description of ZipFSMkZipOrImgCmd(). * * Results: * A standard Tcl result. * * Side effects: - * See description of ZipFSMkZipOrImgCmd(). + * See description of ZipFSMkZipOrImgCmd(). * *------------------------------------------------------------------------- */ static int ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) { return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv); } static int ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) { return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv); } @@ -2154,8 +2244,8 @@ ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, * ZipFSExistsObjCmd -- * * This procedure is invoked to process the "zipfs::exists" command. - * It tests for the existence of a file in the ZIP filesystem and - * places a boolean into the interp's result. + * It tests for the existence of a file in the ZIP filesystem and + * places a boolean into the interp's result. * * Results: * Always TCL_OK. @@ -2206,8 +2296,8 @@ ZipFSCanonicalObjCmd( * ZipFSExistsObjCmd -- * * This procedure is invoked to process the "zipfs::exists" command. - * It tests for the existence of a file in the ZIP filesystem and - * places a boolean into the interp's result. + * It tests for the existence of a file in the ZIP filesystem and + * places a boolean into the interp's result. * * Results: * Always TCL_OK. @@ -2252,9 +2342,9 @@ ZipFSExistsObjCmd( * ZipFSInfoObjCmd -- * * This procedure is invoked to process the "zipfs::info" command. - * On success, it returns a Tcl list made up of name of ZIP archive - * file, size uncompressed, size compressed, and archive offset of - * a file in the ZIP filesystem. + * On success, it returns a Tcl list made up of name of ZIP archive + * file, size uncompressed, size compressed, and archive offset of + * a file in the ZIP filesystem. * * Results: * A standard Tcl result. @@ -2273,8 +2363,8 @@ ZipFSInfoObjCmd( ZipEntry *z; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "filename"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; } filename = Tcl_GetStringFromObj(objv[1], 0); ReadLock(); @@ -2298,8 +2388,8 @@ ZipFSInfoObjCmd( * ZipFSListObjCmd -- * * This procedure is invoked to process the "zipfs::list" command. - * On success, it returns a Tcl list of files of the ZIP filesystem - * which match a search pattern (glob or regexp). + * On success, it returns a Tcl list of files of the ZIP filesystem + * which match a search pattern (glob or regexp). * * Results: * A standard Tcl result. @@ -2321,8 +2411,8 @@ ZipFSListObjCmd( Tcl_Obj *result = Tcl_GetObjResult(interp); if (objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); + return TCL_ERROR; } if (objc == 3) { int n; @@ -2340,7 +2430,7 @@ ZipFSListObjCmd( return TCL_ERROR; } } else if (objc == 2) { - pattern = Tcl_GetStringFromObj(objv[1], 0); + pattern = Tcl_GetStringFromObj(objv[1], 0); } ReadLock(); if (pattern != NULL) { @@ -2399,7 +2489,7 @@ ZipFSListObjCmd( static int ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) { Tcl_Obj *pResult; @@ -2416,13 +2506,13 @@ ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp, * * ZipChannelClose -- * - * This function is called to close a channel. + * This function is called to close a channel. * * Results: - * Always TCL_OK. + * Always TCL_OK. * * Side effects: - * Resources are free'd. + * Resources are free'd. * *------------------------------------------------------------------------- */ @@ -2433,12 +2523,12 @@ ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) ZipChannel *info = (ZipChannel *) instanceData; if (info->iscompr && (info->ubuf != NULL)) { - Tcl_Free((char *) info->ubuf); - info->ubuf = NULL; + Tcl_Free((char *) info->ubuf); + info->ubuf = NULL; } if (info->isenc) { - info->isenc = 0; - memset(info->keys, 0, sizeof (info->keys)); + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); } if (info->iswr) { ZipEntry *z = info->zipentry; @@ -2473,13 +2563,13 @@ ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) * * ZipChannelRead -- * - * This function is called to read data from channel. + * This function is called to read data from channel. * * Results: - * Number of bytes read or -1 on error with error number set. + * Number of bytes read or -1 on error with error number set. * * Side effects: - * Data is read and file pointer is advanced. + * Data is read and file pointer is advanced. * *------------------------------------------------------------------------- */ @@ -2490,17 +2580,35 @@ ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) ZipChannel *info = (ZipChannel *) instanceData; unsigned long nextpos; + if (info->isdir < 0) { + /* + * Special case: when executable combined with ZIP archive file + * read data in front of ZIP, i.e. the executable itself. + */ + nextpos = info->nread + toRead; + if (nextpos > info->zipfile->baseoffs) { + toRead = info->zipfile->baseoffs - info->nread; + nextpos = info->zipfile->baseoffs; + } + if (toRead == 0) { + return 0; + } + memcpy(buf, info->zipfile->data, toRead); + info->nread = nextpos; + *errloc = 0; + return toRead; + } if (info->isdir) { - *errloc = EISDIR; - return -1; + *errloc = EISDIR; + return -1; } nextpos = info->nread + toRead; if (nextpos > info->nbyte) { - toRead = info->nbyte - info->nread; - nextpos = info->nbyte; + toRead = info->nbyte - info->nread; + nextpos = info->nbyte; } if (toRead == 0) { - return 0; + return 0; } if (info->isenc) { int i, ch; @@ -2510,7 +2618,7 @@ ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) buf[i] = zdecode(info->keys, crc32tab, ch); } } else { - memcpy(buf, info->ubuf + info->nread, toRead); + memcpy(buf, info->ubuf + info->nread, toRead); } info->nread = nextpos; *errloc = 0; @@ -2522,40 +2630,40 @@ ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) * * ZipChannelWrite -- * - * This function is called to write data into channel. + * This function is called to write data into channel. * * Results: - * Number of bytes written or -1 on error with error number set. + * Number of bytes written or -1 on error with error number set. * * Side effects: - * Data is written and file pointer is advanced. + * Data is written and file pointer is advanced. * *------------------------------------------------------------------------- */ static int ZipChannelWrite(ClientData instanceData, const char *buf, - int toWrite, int *errloc) + int toWrite, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; unsigned long nextpos; if (!info->iswr) { - *errloc = EINVAL; - return -1; + *errloc = EINVAL; + return -1; } nextpos = info->nread + toWrite; if (nextpos > info->nmax) { - toWrite = info->nmax - info->nread; - nextpos = info->nmax; + toWrite = info->nmax - info->nread; + nextpos = info->nmax; } if (toWrite == 0) { - return 0; + return 0; } memcpy(info->ubuf + info->nread, buf, toWrite); info->nread = nextpos; if (info->nread > info->nbyte) { - info->nbyte = info->nread; + info->nbyte = info->nread; } *errloc = 0; return toWrite; @@ -2566,13 +2674,13 @@ ZipChannelWrite(ClientData instanceData, const char *buf, * * ZipChannelSeek -- * - * This function is called to position file pointer of channel. + * This function is called to position file pointer of channel. * * Results: - * New file position or -1 on error with error number set. + * New file position or -1 on error with error number set. * * Side effects: - * File pointer is repositioned according to offset and mode. + * File pointer is repositioned according to offset and mode. * *------------------------------------------------------------------------- */ @@ -2581,27 +2689,36 @@ static int ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; + unsigned long end; - if (info->isdir) { + if (!info->iswr && (info->isdir < 0)) { + /* + * Special case: when executable combined with ZIP archive file, + * seek within front of ZIP, i.e. the executable itself. + */ + end = info->zipfile->baseoffs; + } else if (info->isdir) { *errloc = EINVAL; return -1; + } else { + end = info->nbyte; } switch (mode) { - case SEEK_CUR: + case SEEK_CUR: offset += info->nread; break; - case SEEK_END: - offset += info->nbyte; + case SEEK_END: + offset += end; break; - case SEEK_SET: + case SEEK_SET: break; - default: + default: *errloc = EINVAL; return -1; } if (offset < 0) { - *errloc = EINVAL; - return -1; + *errloc = EINVAL; + return -1; } if (info->iswr) { if ((unsigned long) offset > info->nmax) { @@ -2611,7 +2728,7 @@ ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) if ((unsigned long) offset > info->nbyte) { info->nbyte = offset; } - } else if ((unsigned long) offset > info->nbyte) { + } else if ((unsigned long) offset > end) { *errloc = EINVAL; return -1; } @@ -2624,13 +2741,13 @@ ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) * * ZipChannelWatchChannel -- * - * This function is called for event notifications on channel. + * This function is called for event notifications on channel. * * Results: - * None. + * None. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -2646,14 +2763,14 @@ ZipChannelWatchChannel(ClientData instanceData, int mask) * * ZipChannelGetFile -- * - * This function is called to retrieve OS handle for channel. + * This function is called to retrieve OS handle for channel. * * Results: - * Always TCL_ERROR since there's never an OS handle for a - * file within a ZIP archive. + * Always TCL_ERROR since there's never an OS handle for a + * file within a ZIP archive. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -2705,14 +2822,14 @@ static Tcl_ChannelType ZipChannelType = { * * ZipChannelOpen -- * - * This function opens a Tcl_Channel on a file from a mounted ZIP - * archive according to given open mode. + * This function opens a Tcl_Channel on a file from a mounted ZIP + * archive according to given open mode. * * Results: - * Tcl_Channel on success, or NULL on error. + * Tcl_Channel on success, or NULL on error. * * Side effects: - * Memory is allocated, the file from the ZIP archive is uncompressed. + * Memory is allocated, the file from the ZIP archive is uncompressed. * *------------------------------------------------------------------------- */ @@ -2732,7 +2849,7 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); } - return NULL; + return NULL; } WriteLock(); z = ZipFSLookup(filename); @@ -2746,12 +2863,12 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) trunc = (mode & O_TRUNC) != 0; wr = (mode & (O_WRONLY | O_RDWR)) != 0; if ((z->cmeth != ZIP_COMPMETH_STORED) && (z->cmeth != ZIP_COMPMETH_DEFLATED)) { - ZIPFS_ERROR(interp,"unsupported compression method"); - goto error; + ZIPFS_ERROR(interp,"unsupported compression method"); + goto error; } if (wr && z->isdir) { ZIPFS_ERROR(interp,"unsupported file type"); - goto error; + goto error; } if (!trunc) { flags |= TCL_READABLE; @@ -2763,12 +2880,12 @@ ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) goto error; } } else { - flags = TCL_WRITABLE; + flags = TCL_WRITABLE; } info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info)); if (info == NULL) { ZIPFS_ERROR(interp,"out of memory"); - goto error; + goto error; } info->zipfile = z->zipfile; info->zipentry = z; @@ -3004,14 +3121,14 @@ error: * * ZipEntryStat -- * - * This function implements the ZIP filesystem specific version - * of the library version of stat. + * This function implements the ZIP filesystem specific version + * of the library version of stat. * * Results: - * See stat documentation. + * See stat documentation. * * Side effects: - * See stat documentation. + * See stat documentation. * *------------------------------------------------------------------------- */ @@ -3028,9 +3145,9 @@ ZipEntryStat(char *path, Tcl_StatBuf *buf) memset(buf, 0, sizeof (Tcl_StatBuf)); if (z->isdir) { - buf->st_mode = S_IFDIR | 0555; + buf->st_mode = S_IFDIR | 0555; } else { - buf->st_mode = S_IFREG | 0555; + buf->st_mode = S_IFREG | 0555; } buf->st_size = z->nbyte; buf->st_mtime = z->timestamp; @@ -3047,14 +3164,14 @@ done: * * ZipEntryAccess -- * - * This function implements the ZIP filesystem specific version - * of the library version of access. + * This function implements the ZIP filesystem specific version + * of the library version of access. * * Results: - * See access documentation. + * See access documentation. * * Side effects: - * See access documentation. + * See access documentation. * *------------------------------------------------------------------------- */ @@ -3085,7 +3202,7 @@ ZipEntryAccess(char *path, int mode) static Tcl_Channel Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, - int mode, int permissions) + int mode, int permissions) { int len; if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return NULL; @@ -3097,14 +3214,14 @@ Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, * * Zip_FSStatProc -- * - * This function implements the ZIP filesystem specific version - * of the library version of stat. + * This function implements the ZIP filesystem specific version + * of the library version of stat. * * Results: - * See stat documentation. + * See stat documentation. * * Side effects: - * See stat documentation. + * See stat documentation. * *------------------------------------------------------------------------- */ @@ -3122,14 +3239,14 @@ Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) * * Zip_FSAccessProc -- * - * This function implements the ZIP filesystem specific version - * of the library version of access. + * This function implements the ZIP filesystem specific version + * of the library version of access. * * Results: - * See access documentation. + * See access documentation. * * Side effects: - * See access documentation. + * See access documentation. * *------------------------------------------------------------------------- */ @@ -3147,16 +3264,16 @@ Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) * * Zip_FSFilesystemSeparatorProc -- * - * This function returns the separator to be used for a given path. The - * object returned should have a refCount of zero + * This function returns the separator to be used for a given path. The + * object returned should have a refCount of zero * * Results: - * A Tcl object, with a refCount of zero. If the caller needs to retain a - * reference to the object, it should call Tcl_IncrRefCount, and should - * otherwise free the object. + * A Tcl object, with a refCount of zero. If the caller needs to retain a + * reference to the object, it should call Tcl_IncrRefCount, and should + * otherwise free the object. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -3172,23 +3289,23 @@ Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) * * Zip_FSMatchInDirectoryProc -- * - * This routine is used by the globbing code to search a directory for - * all files which match a given pattern. + * This routine is used by the globbing code to search a directory for + * all files which match a given pattern. * * Results: - * The return value is a standard Tcl result indicating whether an - * error occurred in globbing. Errors are left in interp, good - * results are lappend'ed to resultPtr (which must be a valid object). + * The return value is a standard Tcl result indicating whether an + * error occurred in globbing. Errors are left in interp, good + * results are lappend'ed to resultPtr (which must be a valid object). * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ static int Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, - Tcl_Obj *pathPtr, const char *pattern, - Tcl_GlobTypeData *types) + Tcl_Obj *pathPtr, const char *pattern, + Tcl_GlobTypeData *types) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -3200,7 +3317,7 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; if (types != NULL) { - dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; + dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; } /* the prefix that gets prepended to results */ @@ -3213,9 +3330,9 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, Tcl_DStringAppend(&dsPref, prefix, prefixLen); if (strcmp(prefix, path) == 0) { - prefix = NULL; + prefix = NULL; } else { - strip = len + 1; + strip = len + 1; } if (prefix != NULL) { Tcl_DStringAppend(&dsPref, "/", 1); @@ -3224,20 +3341,20 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, } ReadLock(); if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { - l = CountSlashes(path); - if (path[len - 1] == '/') { - len--; - } else { - l++; - } - if ((pattern == NULL) || (pattern[0] == '\0')) { - pattern = "*"; - } - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); - - if (zf->mntptlen == 0) { + l = CountSlashes(path); + if (path[len - 1] == '/') { + len--; + } else { + l++; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + pattern = "*"; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); + + if (zf->mntptlen == 0) { ZipEntry *z = zf->topents; while (z != NULL) { int lenz = strlen(z->name); @@ -3262,13 +3379,13 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, } z = z->tnext; } - } else if ( - (zf->mntptlen > len + 1) - && (strncmp(zf->mntpt, path, len) == 0) - && (zf->mntpt[len] == '/') - && (CountSlashes(zf->mntpt) == l) - && Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0) - ) { + } else if ( + (zf->mntptlen > len + 1) + && (strncmp(zf->mntpt, path, len) == 0) + && (zf->mntpt[len] == '/') + && (CountSlashes(zf->mntpt) == l) + && Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0) + ) { if (prefix != NULL) { Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); Tcl_ListObjAppendElement(NULL, result, @@ -3279,38 +3396,38 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); } - } - hPtr = Tcl_NextHashEntry(&search); - } - goto end; + } + hPtr = Tcl_NextHashEntry(&search); + } + goto end; } if ((pattern == NULL) || (pattern[0] == '\0')) { - hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); - if (hPtr != NULL) { - ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); - - if ((dirOnly < 0) || - (!dirOnly && !z->isdir) || - (dirOnly && z->isdir)) { - if (prefix != NULL) { - Tcl_DStringAppend(&dsPref, z->name, -1); - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(Tcl_DStringValue(&dsPref), - Tcl_DStringLength(&dsPref))); - Tcl_DStringSetLength(&dsPref, prefixLen); - } else { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(z->name, -1)); - } - } - } - goto end; + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if ((dirOnly < 0) || + (!dirOnly && !z->isdir) || + (dirOnly && z->isdir)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } + goto end; } l = strlen(pattern); pat = Tcl_Alloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { - --len; + --len; } if ((len > 1) || (pat[0] != '/')) { pat[len] = '/'; @@ -3320,9 +3437,9 @@ Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, scnt = CountSlashes(pat); for ( hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search) - ) { + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); if ( (dirOnly >= 0) && ((dirOnly && !z->isdir) || (!dirOnly && z->isdir)) @@ -3355,14 +3472,14 @@ end: * * Zip_FSPathInFilesystemProc -- * - * This function determines if the given path object is in the - * ZIP filesystem. + * This function determines if the given path object is in the + * ZIP filesystem. * * Results: - * TCL_OK when the path object is in the ZIP filesystem, -1 otherwise. + * TCL_OK when the path object is in the ZIP filesystem, -1 otherwise. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -3424,13 +3541,13 @@ endloop: * * Zip_FSListVolumesProc -- * - * Lists the currently mounted ZIP filesystem volumes. + * Lists the currently mounted ZIP filesystem volumes. * * Results: - * The list of volumes. + * The list of volumes. * * Side effects: - * None + * None * *------------------------------------------------------------------------- */ @@ -3444,14 +3561,14 @@ Zip_FSListVolumesProc(void) { * * Zip_FSFileAttrStringsProc -- * - * This function implements the ZIP filesystem dependent 'file attributes' - * subcommand, for listing the set of possible attribute strings. + * This function implements the ZIP filesystem dependent 'file attributes' + * subcommand, for listing the set of possible attribute strings. * * Results: - * An array of strings + * An array of strings * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -3460,13 +3577,13 @@ static const char *const * Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) { static const char *const attrs[] = { - "-uncompsize", - "-compsize", - "-offset", - "-mount", - "-archive", - "-permissions", - NULL, + "-uncompsize", + "-compsize", + "-offset", + "-mount", + "-archive", + "-permissions", + NULL, }; return attrs; } @@ -3476,24 +3593,24 @@ Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) * * Zip_FSFileAttrsGetProc -- * - * This function implements the ZIP filesystem specific - * 'file attributes' subcommand, for 'get' operations. + * This function implements the ZIP filesystem specific + * 'file attributes' subcommand, for 'get' operations. * * Results: - * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK - * was returned) is likely to have a refCount of zero. Either way we must - * either store it somewhere (e.g. the Tcl result), or Incr/Decr its - * refCount to ensure it is properly freed. + * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK + * was returned) is likely to have a refCount of zero. Either way we must + * either store it somewhere (e.g. the Tcl result), or Incr/Decr its + * refCount to ensure it is properly freed. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ static int Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef) + Tcl_Obj **objPtrRef) { int len, ret = TCL_OK; char *path; @@ -3540,14 +3657,14 @@ done: * * Zip_FSFileAttrsSetProc -- * - * This function implements the ZIP filesystem specific - * 'file attributes' subcommand, for 'set' operations. + * This function implements the ZIP filesystem specific + * 'file attributes' subcommand, for 'set' operations. * * Results: - * Standard Tcl return code. + * Standard Tcl return code. * * Side effects: - * None. + * None. * *------------------------------------------------------------------------- */ @@ -3556,7 +3673,7 @@ static int Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); } return TCL_ERROR; } @@ -3585,50 +3702,53 @@ Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) * * Zip_FSLoadFile -- * - * This functions deals with loading native object code. If - * the given path object refers to a file within the ZIP - * filesystem, an approriate error code is returned to delegate - * loading to the caller (by copying the file to temp store - * and loading from there). As fallback when the file refers - * to the ZIP file system but is not present, it is looked up - * relative to the executable and loaded from there when available. + * This functions deals with loading native object code. If + * the given path object refers to a file within the ZIP + * filesystem, an approriate error code is returned to delegate + * loading to the caller (by copying the file to temp store + * and loading from there). As fallback when the file refers + * to the ZIP file system but is not present, it is looked up + * relative to the executable and loaded from there when available. * * Results: - * TCL_OK on success, -1 otherwise with error number set. + * TCL_OK on success, TCL_ERROR otherwise with error message left. * * Side effects: - * Loads native code into the process address space. + * Loads native code into the process address space. * *------------------------------------------------------------------------- */ static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, - Tcl_FSUnloadFileProc **unloadProcPtr, int flags) + Tcl_FSUnloadFileProc **unloadProcPtr, int flags) { Tcl_FSLoadFileProc2 *loadFileProc; #ifdef ANDROID /* * Force loadFileProc to native implementation since the - * package manger already extracted the shared libraries + * package manager already extracted the shared libraries * from the APK at install time. */ loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; if (loadFileProc != NULL) { - return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } Tcl_SetErrno(ENOENT); - return -1; + ZIPFS_ERROR(interp,Tcl_PosixError(interp)); + return TCL_ERROR; #else Tcl_Obj *altPath = NULL; - int ret = -1; + int ret = TCL_ERROR; if (Tcl_FSAccess(path, R_OK) == 0) { /* * EXDEV should trigger loading by copying to temp store. */ + Tcl_SetErrno(EXDEV); + ZIPFS_ERROR(interp,Tcl_PosixError(interp)); return ret; } else { Tcl_Obj *objs[2] = { NULL, NULL }; @@ -3658,14 +3778,15 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, } } if (objs[0] == NULL) { - objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),TCL_PATH_DIRNAME); + objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), + TCL_PATH_DIRNAME); } if (objs[0] != NULL) { - altPath = TclJoinPath(2, objs); + altPath = TclJoinPath(2, objs); if (altPath != NULL) { Tcl_IncrRefCount(altPath); if (Tcl_FSAccess(altPath, R_OK) == 0) { - path = altPath; + path = altPath; } } } @@ -3679,12 +3800,13 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, } loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; if (loadFileProc != NULL) { - ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { - Tcl_SetErrno(ENOENT); + Tcl_SetErrno(ENOENT); + ZIPFS_ERROR(interp,Tcl_PosixError(interp)); } if (altPath != NULL) { - Tcl_DecrRefCount(altPath); + Tcl_DecrRefCount(altPath); } return ret; #endif @@ -3740,14 +3862,14 @@ const Tcl_Filesystem zipfsFilesystem = { * * TclZipfs_Init -- * - * Perform per interpreter initialization of this module. + * Perform per interpreter initialization of this module. * * Results: - * The return value is a standard Tcl result. + * The return value is a standard Tcl result. * * Side effects: - * Initializes this module if not already initialized, and adds - * module related commands to the given interpreter. + * Initializes this module if not already initialized, and adds + * module related commands to the given interpreter. * *------------------------------------------------------------------------- */ @@ -3761,35 +3883,35 @@ TclZipfs_Init(Tcl_Interp *interp) Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); if (!ZipFS.initialized) { #ifdef TCL_THREADS - static const Tcl_Time t = { 0, 0 }; - /* - * Inflate condition variable. - */ - Tcl_MutexLock(&ZipFSMutex); - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); - Tcl_MutexUnlock(&ZipFSMutex); + static const Tcl_Time t = { 0, 0 }; + /* + * Inflate condition variable. + */ + Tcl_MutexLock(&ZipFSMutex); + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); + Tcl_MutexUnlock(&ZipFSMutex); #endif - Tcl_FSRegister(NULL, &zipfsFilesystem); - Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); - ZipFS.initialized = ZipFS.idCount = 1; + Tcl_FSRegister(NULL, &zipfsFilesystem); + Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); + ZipFS.initialized = ZipFS.idCount = 1; } Unlock(); if(interp != NULL) { static const EnsembleImplMap initMap[] = { - {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, - {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, - {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, - {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, - {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, - {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, - {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, - {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, - {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, - {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, + {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, + {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, + {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, + {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, + {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, + {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, + {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, + {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, + {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, + {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1}, {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 1}, - {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 0}, + {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -3825,7 +3947,7 @@ TclZipfs_Init(Tcl_Interp *interp) } #if defined(_WIN32) || defined(_WIN64) -#define LIBRARY_SIZE 64 +#define LIBRARY_SIZE 64 static int ToUtf( const WCHAR *wSrc, @@ -3835,8 +3957,8 @@ ToUtf( start = dst; while (*wSrc != '\0') { - dst += Tcl_UniCharToUtf(*wSrc, dst); - wSrc++; + dst += Tcl_UniCharToUtf(*wSrc, dst); + wSrc++; } *dst = '\0'; return (int) (dst - start); @@ -3916,7 +4038,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) } else if (*argc>1) { #if defined(_WIN32) || defined(_WIN64) Tcl_DString ds; - strcpy(archive, Tcl_WinTCharToUtf((*argv)[1], -1, &ds)); + strcpy(archive, Tcl_WinTCharToUtf((*argv)[1], -1, &ds)); Tcl_DStringFree(&ds); #else archive=(*argv)[1]; @@ -4004,14 +4126,14 @@ Tcl_Obj *TclZipfs_TclLibrary(void) { * * TclZipfs_Mount, TclZipfs_Unmount -- * - * Dummy version when no ZLIB support available. + * Dummy version when no ZLIB support available. * *------------------------------------------------------------------------- */ int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, - const char *passwd) + const char *passwd) { return TclZipfs_Init(interp, 1); } -- cgit v0.12 From 7154cc9c4777ae2394afa07b79adfb6680261293 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 24 Nov 2017 11:46:34 +0000 Subject: Tweak to ensure mount points for zipfs are corralled into the //zipfs:/ prefix space --- generic/tclZipfs.c | 140 +++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 126 insertions(+), 14 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 668eee0..2370980 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -35,11 +35,10 @@ #include "crypt.h" /* -** On windows we need VFS to look like a volume -** On Unix we need it to look like a UNC path +** TIP430 style zipfs prefix */ #define ZIPFS_VOLUME "//zipfs:/" -#define ZIPFS_VOLUME_LEN 9 +#define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT "//zipfs:/app" #define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" /* @@ -659,8 +658,88 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPA result=Tcl_DStringValue(dsPtr); return result; } + +/* + *------------------------------------------------------------------------- + * + * AbsolutePath -- + * + * This function computes the absolute path from a given + * (relative) path name into the specified Tcl_DString. + * + * Results: + * Returns the pointer to the absolute path contained in the + * specified Tcl_DString. + * + * Side effects: + * Modifies the specified Tcl_DString. + * + *------------------------------------------------------------------------- + */ +static char * +AbsolutePath(const char *path, +#if HAS_DRIVES + int *drvPtr, +#endif + Tcl_DString *dsPtr) +{ + char *result; + +#if HAS_DRIVES + if (drvPtr != NULL) { + *drvPtr = 0; + } +#endif + if (*path == '~') { + Tcl_DStringAppend(dsPtr, path, -1); + return Tcl_DStringValue(dsPtr); + } + if ((*path != '/') +#if HAS_DRIVES + && (*path != '\\') && + (((*path != '\0') && (strchr(drvletters, *path) == NULL)) || + (path[1] != ':')) +#endif + ) { + Tcl_DString pwd; + + /* relative path */ + Tcl_DStringInit(&pwd); + Tcl_GetCwd(NULL, &pwd); + result = Tcl_DStringValue(&pwd); +#if HAS_DRIVES + if ((result[0] != '\0') && (strchr(drvletters, result[0]) != NULL) && + (result[1] == ':')) { + if (drvPtr != NULL) { + drvPtr[0] = result[0]; + if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) { + drvPtr[0] -= 'a' - 'A'; + } + } + result += 2; + } +#endif + result = CanonicalPath(result, path, dsPtr, 0); + Tcl_DStringFree(&pwd); + } else { + /* absolute path */ +#if HAS_DRIVES + if ((path[0] != '\0') && (strchr(drvletters, path[0]) != NULL) && + (path[1] == ':')) { + if (drvPtr != NULL) { + drvPtr[0] = path[0]; + if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) { + drvPtr[0] -= 'a' - 'A'; + } + } + } +#endif + result = CanonicalPath("", path, dsPtr, 0); + } + return result; +} /* *------------------------------------------------------------------------- @@ -985,12 +1064,17 @@ TclZipfs_Mount( const char *mntpt, const char *passwd ) { + char *realname, *p; int i, pwlen, isNew; ZipFile *zf, zf0; ZipEntry *z; Tcl_HashEntry *hPtr; - Tcl_DString ds, fpBuf; + Tcl_DString ds, dsm, fpBuf; unsigned char *q; +#if HAS_DRIVES + int drive = 0; +#endif + ReadLock(); if (!ZipFS.initialized) { ZIPFS_ERROR(interp,"not initialized"); @@ -1024,11 +1108,31 @@ TclZipfs_Mount( Unlock(); return TCL_OK; } - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); + Tcl_DStringInit(&ds); +#if HAS_DRIVES + p = AbsolutePath(zipname, &drive, &ds); +#else + p = AbsolutePath(zipname, &ds); +#endif + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, p); if (hPtr != NULL) { +#if HAS_DRIVES + if (drive == zf->mntdrv) { + Tcl_Obj *string; + char drvbuf[3]; + + drvbuf[0] = zf->mntdrv; + drvbuf[1] = ':'; + drvbuf[2] = '\0'; + string = Tcl_NewStringObj(drvbuf, 2); + Tcl_AppendToObj(string, zf->mntpt, zf->mntptlen); + Tcl_SetObjResult(interp, string); + } +#else if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); } +#endif } Unlock(); return TCL_OK; @@ -1036,23 +1140,31 @@ TclZipfs_Mount( Unlock(); pwlen = 0; if (passwd != NULL) { - pwlen = strlen(passwd); - if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("illegal password", -1)); + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; } - return TCL_ERROR; - } } if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { return TCL_ERROR; } + Tcl_DStringInit(&ds); +#if HAS_DRIVES + realname = AbsolutePath(zipname, NULL, &ds); +#else + realname = AbsolutePath(zipname, &ds); +#endif /* - * Mount point can come from Tcl_GetNameOfExecutable() - * which sometimes is a relative or otherwise denormalized path. + * Mount point sometimes is a relative or otherwise denormalized path. * But an absolute name is needed as mount point here. */ + Tcl_DStringInit(&dsm); + mntpt = CanonicalPath("",mntpt, &dsm, 1); + WriteLock(); hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew); if (!isNew) { -- cgit v0.12 From 99dc87a51d1e450b24f642aacbda0df262402a94 Mon Sep 17 00:00:00 2001 From: tne Date: Sat, 25 Nov 2017 10:54:15 +0000 Subject: Restoring the Makefile.in for the win/ directory after an unfortunate copy/paste error --- win/Makefile.in | 1444 ++++++++++++++++++++++++++++++++----------------------- 1 file changed, 835 insertions(+), 609 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index 5f81b74..99c8b77 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -1,26 +1,21 @@ -# This file is a Makefile for Tk. If it has the name "Makefile.in" -# then it is a template for a Makefile; to generate the actual Makefile, -# run "./configure", which is a configuration script generated by the -# "autoconf" program (constructs like "@foo@" will get replaced in the -# actual Makefile. - -TCLVERSION = @TCL_VERSION@ -TCLPATCHL = @TCL_PATCH_LEVEL@ -VERSION = @TK_VERSION@ -PATCH_LEVEL = @TK_PATCH_LEVEL@ - -#---------------------------------------------------------------- -# Things you can change to personalize the Makefile for your own -# site (you can make these changes in either Makefile.in or -# Makefile, but changes to Makefile will get lost if you re-run -# the configuration script). -#---------------------------------------------------------------- - -# Default top-level directories in which to install architecture- -# specific files (exec_prefix) and machine-independent files such -# as scripts (prefix). The values specified here may be overridden -# at configure-time with the --exec-prefix and --prefix options -# to the "configure" script. +# +# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it +# is a template for a Makefile; to generate the actual Makefile, run +# "./configure", which is a configuration script generated by the "autoconf" +# program (constructs like "@foo@" will get replaced in the actual Makefile. + +VERSION = @TCL_VERSION@ + +#-------------------------------------------------------------------------- +# Things you can change to personalize the Makefile for your own site (you can +# make these changes in either Makefile.in or Makefile, but changes to +# Makefile will get lost if you re-run the configuration script). +#-------------------------------------------------------------------------- + +# Default top-level directories in which to install architecture-specific +# files (exec_prefix) and machine-independent files such as scripts (prefix). +# The values specified here may be overridden at configure-time with the +# --exec-prefix and --prefix options to the "configure" script. prefix = @prefix@ exec_prefix = @exec_prefix@ @@ -30,159 +25,164 @@ includedir = @includedir@ datarootdir = @datarootdir@ mandir = @mandir@ -# The following definition can be set to non-null for special systems -# like AFS with replication. It allows the pathnames used for installation -# to be different than those used for actually reference files at -# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix -# when installing files. -INSTALL_ROOT = $(DESTDIR) +# The following definition can be set to non-null for special systems like AFS +# with replication. It allows the pathnames used for installation to be +# different than those used for actually reference files at run-time. +# INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. +INSTALL_ROOT = -# Directory from which applications will reference the library of Tk -# scripts (note: you can set the TK_LIBRARY environment variable at -# run-time to override this value): -TK_LIBRARY = $(prefix)/lib/tk$(VERSION) +# Directory from which applications will reference the library of Tcl scripts +# (note: you can set the TCL_LIBRARY environment variable at run-time to +# override this value): +TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION) # Path to use at runtime to refer to LIB_INSTALL_DIR: LIB_RUNTIME_DIR = $(libdir) -# Directory in which to install the program wish: +# Directory in which to install the program tclsh: BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) -# Directory in which to install the .a or .so binary for the Tk library: +# Directory in which to install the .a or .so binary for the Tcl library: LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) -# Path name to use when installing library scripts: -SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY) +# Path name to use when installing library scripts. +SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) -# Directory in which to install the include file tk.h: +# Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) -# Directory in which to (optionally) install the private tk headers: +# Directory in which to (optionally) install the private tcl headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) -# Top-level directory for manual entries: +# Top-level directory in which to install manual entries: MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) -# Directory in which to install manual entry for wish: -MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 +# Directory in which to install manual entry for tclsh: +MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 -# Directory in which to install manual entries for Tk's C library -# procedures: -MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 +# Directory in which to install manual entries for Tcl's C library procedures: +MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 -# Directory in which to install manual entries for the built-in -# Tk commands: -MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann +# Directory in which to install manual entries for the built-in Tcl commands: +MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Libraries built with optimization switches have this additional extension -TK_DBGX = @TK_DBGX@ - -# Directory in which to install the pkgIndex.tcl file for loadable Tk -PKG_INSTALL_DIR = $(LIB_INSTALL_DIR)/tk$(VERSION)$(TK_DBGX) - -# Package index file for loadable Tk -PKG_INDEX = $(PKG_INSTALL_DIR)/pkgIndex.tcl - -# The directory containing the Tcl source and header files. -TCL_SRC_DIR = @TCL_SRC_DIR@ +TCL_DBGX = @TCL_DBGX@ -# The directory containing the Tcl library archive file appropriate -# for this version of Tk: -TCL_BIN_DIR = @TCL_BIN_DIR@ +# warning flags +CFLAGS_WARNING = @CFLAGS_WARNING@ -# The directory containing the Tcl sources and headers appropriate -# for this version of Tk ("srcdir" will be replaced or has already -# been replaced by the configure script): -TCL_GENERIC_DIR = @TCL_SRC_DIR@/generic +# The default switches for optimization or debugging +CFLAGS_DEBUG = @CFLAGS_DEBUG@ +CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ -# The directory containing the platform specific Tcl sources and headers -# appropriate for this version of Tk: -TCL_PLATFORM_DIR = @TCL_SRC_DIR@/win +# To change the compiler switches, for example to change from optimization to +# debugging symbols, change the following line: +#CFLAGS = $(CFLAGS_DEBUG) +#CFLAGS = $(CFLAGS_OPTIMIZE) +#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE -D_ATL_XP_TARGETING + +# To compile without backward compatibility and deprecated code uncomment the +# following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED + +# To enable compilation debugging reverse the comment characters on one of the +# following lines. +COMPILE_DEBUG_FLAGS = +#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG +#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS -TCL_TOOL_DIR = @TCL_SRC_DIR@/tools +SRC_DIR = @srcdir@ +ROOT_DIR = @srcdir@/.. +TOP_DIR = $(shell cd @srcdir@/..; pwd -P) +GENERIC_DIR = $(TOP_DIR)/generic +TOMMATH_DIR = $(TOP_DIR)/libtommath +WIN_DIR = $(TOP_DIR)/win +COMPAT_DIR = $(TOP_DIR)/compat +PKGS_DIR = $(TOP_DIR)/pkgs +ZLIB_DIR = $(COMPAT_DIR)/zlib # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ -# The name of the Tcl library. -TCL_LIB_FILE = "$(shell $(CYGPATH) '@TCL_BIN_DIR@/@TCL_LIB_FILE@')" -TCL_STUB_LIB_FILE = "$(shell $(CYGPATH) '@TCL_BIN_DIR@/@TCL_STUB_LIB_FILE@')" - -SRC_DIR = @srcdir@ -ROOT_DIR = $(SRC_DIR)/.. -WIN_DIR = $(SRC_DIR) -UNIX_DIR = $(SRC_DIR)/../unix -GENERIC_DIR = $(SRC_DIR)/../generic -TTK_DIR = $(GENERIC_DIR)/ttk -BITMAP_DIR = $(ROOT_DIR)/bitmaps -XLIB_DIR = $(ROOT_DIR)/xlib -RC_DIR = $(WIN_DIR)/rc - -ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g') -WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)' | sed 's!\\!/!g') -GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)' | sed 's!\\!/!g') -BITMAP_DIR_NATIVE = $(ROOT_DIR_NATIVE)/bitmaps -XLIB_DIR_NATIVE = $(ROOT_DIR_NATIVE)/xlib -RC_DIR_NATIVE = $(WIN_DIR_NATIVE)/rc -TCL_GENERIC_NATIVE = $(shell $(CYGPATH) '$(TCL_GENERIC_DIR)' | sed 's!\\!/!g') -TCL_PLATFORM_NATIVE = $(shell $(CYGPATH) '$(TCL_PLATFORM_DIR)' | sed 's!\\!/!g') -TCL_SRC_DIR_NATIVE = $(shell $(CYGPATH) '$(TCL_SRC_DIR)' | sed 's!\\!/!g') - +libdir_native = $(shell $(CYGPATH) '$(libdir)') +bindir_native = $(shell $(CYGPATH) '$(bindir)') +includedir_native = $(shell $(CYGPATH) '$(includedir)') +mandir_native = $(shell $(CYGPATH) '$(mandir)') +TCL_LIBRARY_NATIVE = $(shell $(CYGPATH) '$(TCL_LIBRARY)') +GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') +TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') +WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') +ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') +ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)') +#GENERIC_DIR_NATIVE = $(GENERIC_DIR) +#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) +#WIN_DIR_NATIVE = $(WIN_DIR) +#ROOT_DIR_NATIVE = $(ROOT_DIR) + +# Fully qualify library path so that `make test` +# does not depend on the current directory. +LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) +LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ -TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@ -TK_LIB_FILE = @TK_LIB_FILE@ -TK_DLL_FILE = @TK_DLL_FILE@ -TEST_DLL_FILE = tktest$(VER)${DLLSUFFIX} -TEST_LIB_FILE = @LIBPREFIX@tktest$(VER)${LIBSUFFIX} - -SHARED_LIBRARIES = $(TK_DLL_FILE) $(TK_STUB_LIB_FILE) -STATIC_LIBRARIES = $(TK_LIB_FILE) - -WISH = wish$(VER)${EXESUFFIX} -TKTEST = tktest${EXEEXT} +VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@ +DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@ +DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@ +DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@ +REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@ +REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@ + +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + + +TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ +TCL_DLL_FILE = @TCL_DLL_FILE@ +TCL_LIB_FILE = @TCL_LIB_FILE@ +DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} +DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX} +REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} +REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} +TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} +TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} +ZLIB_DLL_FILE = zlib1.dll + +SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ +STATIC_LIBRARIES = $(TCL_LIB_FILE) + +TCLSH = tclsh$(VER)${EXESUFFIX} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) -@SET_MAKE@ +# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is +# available *BEFORE* running make for the first time. Certain build targets +# (make genstubs, make install) need it to be available on the PATH. This +# executable should *NOT* be required just to do a normal build although +# it can be required to run make dist. +TCL_EXE = @TCL_EXE@ -# Setting the VPATH variable to a list of paths will cause the -# makefile to look into these paths when resolving .c to .obj -# dependencies. - -VPATH = $(GENERIC_DIR):$(TTK_DIR):$(WIN_DIR):$(UNIX_DIR):$(XLIB_DIR):$(RC_DIR) - -# warning flags -CFLAGS_WARNING = @CFLAGS_WARNING@ - -# The default switches for optimization or debugging -CFLAGS_DEBUG = @CFLAGS_DEBUG@ -CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ - -# The default switches for optimization or debugging -LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ -LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ +@SET_MAKE@ -# To change the compiler switches, for example to change from optimization to -# debugging symbols, change the following line: -#CFLAGS = $(CFLAGS_DEBUG) -#CFLAGS = $(CFLAGS_OPTIMIZE) -#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE -D_ATL_XP_TARGETING +# Setting the VPATH variable to a list of paths will cause the Makefile to +# look into these paths when resolving .c to .obj dependencies. -# Special compiler flags to use when building man2tcl on Windows. -MAN2TCLFLAGS = @MAN2TCLFLAGS@ +VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR) AR = @AR@ RANLIB = @RANLIB@ CC = @CC@ RC = @RC@ RES = @RES@ -TK_RES = @TK_RES@ -AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@ @TCL_DEFS@ +AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@ CPPFLAGS = @CPPFLAGS@ +LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ +LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@ LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@ LDFLAGS_WINDOW = @LDFLAGS_WINDOW@ @@ -193,323 +193,512 @@ SHLIB_LD = @SHLIB_LD@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ -VER = @TK_MAJOR_VERSION@@TK_MINOR_VERSION@ -DOTVER = @TK_MAJOR_VERSION@.@TK_MINOR_VERSION@ -LIBS = $(TCL_STUB_LIB_FILE) @LIBS@ @LIBS_GUI@ +LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@') + RMDIR = rm -rf MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f COPY = cp -BUILD_TCLSH = @BUILD_TCLSH@ - -# Tk does not used deprecated Tcl constructs so it should -# compile fine with -DTCL_NO_DEPRECATED. To remove its own -# set of deprecated code uncomment the second line. -NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED +### +# Tip 430 - ZipFS Modifications +### -# TCL_EXE is the name of a tclsh executable that is available *BEFORE* -# running make for the first time. Certain build targets (make genstubs) -# need it to be available on the PATH. This executable should *NOT* be -# required just to do a normal build although it can be required to run -# make dist. -TCL_EXE = @TCLSH_PROG@ +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs -CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ --I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ --I"${XLIB_DIR_NATIVE}" -I"${BITMAP_DIR_NATIVE}" \ --I"${TCL_GENERIC_NATIVE}" -I"${TCL_PLATFORM_NATIVE}" \ -${AC_FLAGS} $(NO_DEPRECATED_FLAGS) -DUSE_TCL_STUBS +HOST_CC = @CC_FOR_BUILD@ +HOST_EXEEXT = @EXEEXT_FOR_BUILD@ +HOST_OBJEXT = @OBJEXT_FOR_BUILD@ +ZIPFS_BUILD = @ZIPFS_BUILD@ +NATIVE_ZIP = @ZIP_PROG@ +ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ +ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ +SHARED_BUILD = @SHARED_BUILD@ +INSTALL_MSGS = @INSTALL_MSGS@ +INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ + +# Minizip +MINIZIP_OBJS = \ + adler32.$(HOST_OBJEXT) \ + compress.$(HOST_OBJEXT) \ + crc32.$(HOST_OBJEXT) \ + deflate.$(HOST_OBJEXT) \ + infback.$(HOST_OBJEXT) \ + inffast.$(HOST_OBJEXT) \ + inflate.$(HOST_OBJEXT) \ + inftrees.$(HOST_OBJEXT) \ + ioapi.$(HOST_OBJEXT) \ + iowin32.$(HOST_OBJEXT) \ + trees.$(HOST_OBJEXT) \ + uncompr.$(HOST_OBJEXT) \ + zip.$(HOST_OBJEXT) \ + zutil.$(HOST_OBJEXT) \ + minizip.$(HOST_OBJEXT) + +ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ + +CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ +-I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \ +-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ +${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ -# Tk used to let the configure script choose which program to use -# for installing, but there are just too many different versions of -# "install" around; better to use the install-sh script that comes -# with the distribution, which is slower but guaranteed to work. - -INSTALL = cp -INSTALL_PROGRAM = ${INSTALL} -INSTALL_DATA = ${INSTALL} - -WISH_OBJS = \ - winMain.$(OBJEXT) - -TKTEST_OBJS = \ - tkSquare.$(OBJEXT) \ - tkTest.$(OBJEXT) \ - tkOldTest.$(OBJEXT) \ - tkWinTest.$(OBJEXT) - -XLIB_OBJS = \ - xcolors.$(OBJEXT) \ - xdraw.$(OBJEXT) \ - xgc.$(OBJEXT) \ - ximage.$(OBJEXT) \ - xutil.$(OBJEXT) - -TK_OBJS = \ - tkConsole.$(OBJEXT) \ - tkUnixMenubu.$(OBJEXT) \ - tkUnixScale.$(OBJEXT) \ - $(XLIB_OBJS) \ - tkWin3d.$(OBJEXT) \ - tkWin32Dll.$(OBJEXT) \ - tkWinButton.$(OBJEXT) \ - tkWinClipboard.$(OBJEXT) \ - tkWinColor.$(OBJEXT) \ - tkWinConfig.$(OBJEXT) \ - tkWinCursor.$(OBJEXT) \ - tkWinDialog.$(OBJEXT) \ - tkWinDraw.$(OBJEXT) \ - tkWinEmbed.$(OBJEXT) \ - tkWinFont.$(OBJEXT) \ - tkWinImage.$(OBJEXT) \ - tkWinInit.$(OBJEXT) \ - tkWinKey.$(OBJEXT) \ - tkWinMenu.$(OBJEXT) \ - tkWinPixmap.$(OBJEXT) \ - tkWinPointer.$(OBJEXT) \ - tkWinRegion.$(OBJEXT) \ - tkWinScrlbr.$(OBJEXT) \ - tkWinSend.$(OBJEXT) \ - tkWinSendCom.$(OBJEXT) \ - tkWinWindow.$(OBJEXT) \ - tkWinWm.$(OBJEXT) \ - tkWinX.$(OBJEXT) \ - stubs.$(OBJEXT) \ - tk3d.$(OBJEXT) \ - tkArgv.$(OBJEXT) \ - tkAtom.$(OBJEXT) \ - tkBind.$(OBJEXT) \ - tkBitmap.$(OBJEXT) \ - tkBusy.$(OBJEXT) \ - tkButton.$(OBJEXT) \ - tkCanvArc.$(OBJEXT) \ - tkCanvBmap.$(OBJEXT) \ - tkCanvImg.$(OBJEXT) \ - tkCanvLine.$(OBJEXT) \ - tkCanvPoly.$(OBJEXT) \ - tkCanvPs.$(OBJEXT) \ - tkCanvText.$(OBJEXT) \ - tkCanvUtil.$(OBJEXT) \ - tkCanvWind.$(OBJEXT) \ - tkCanvas.$(OBJEXT) \ - tkClipboard.$(OBJEXT) \ - tkCmds.$(OBJEXT) \ - tkColor.$(OBJEXT) \ - tkConfig.$(OBJEXT) \ - tkCursor.$(OBJEXT) \ - tkEntry.$(OBJEXT) \ - tkError.$(OBJEXT) \ - tkEvent.$(OBJEXT) \ - tkFileFilter.$(OBJEXT) \ - tkFocus.$(OBJEXT) \ - tkFont.$(OBJEXT) \ - tkFrame.$(OBJEXT) \ - tkGC.$(OBJEXT) \ - tkGeometry.$(OBJEXT) \ - tkGet.$(OBJEXT) \ - tkGrab.$(OBJEXT) \ - tkGrid.$(OBJEXT) \ - tkImage.$(OBJEXT) \ - tkImgBmap.$(OBJEXT) \ - tkImgGIF.$(OBJEXT) \ - tkImgPNG.$(OBJEXT) \ - tkImgPPM.$(OBJEXT) \ - tkImgPhoto.$(OBJEXT) \ - tkImgPhInstance.$(OBJEXT) \ - tkImgUtil.$(OBJEXT) \ - tkListbox.$(OBJEXT) \ - tkMacWinMenu.$(OBJEXT) \ - tkMain.$(OBJEXT) \ - tkMain2.$(OBJEXT) \ - tkMenu.$(OBJEXT) \ - tkMenubutton.$(OBJEXT) \ - tkMenuDraw.$(OBJEXT) \ - tkMessage.$(OBJEXT) \ - tkPanedWindow.$(OBJEXT) \ - tkObj.$(OBJEXT) \ - tkOldConfig.$(OBJEXT) \ - tkOption.$(OBJEXT) \ - tkPack.$(OBJEXT) \ - tkPlace.$(OBJEXT) \ - tkPointer.$(OBJEXT) \ - tkRectOval.$(OBJEXT) \ - tkScale.$(OBJEXT) \ - tkScrollbar.$(OBJEXT) \ - tkSelect.$(OBJEXT) \ - tkStyle.$(OBJEXT) \ - tkText.$(OBJEXT) \ - tkTextBTree.$(OBJEXT) \ - tkTextDisp.$(OBJEXT) \ - tkTextImage.$(OBJEXT) \ - tkTextIndex.$(OBJEXT) \ - tkTextMark.$(OBJEXT) \ - tkTextTag.$(OBJEXT) \ - tkTextWind.$(OBJEXT) \ - tkTrig.$(OBJEXT) \ - tkUndo.$(OBJEXT) \ - tkUtil.$(OBJEXT) \ - tkVisual.$(OBJEXT) \ - tkStubInit.$(OBJEXT) \ - tkWindow.$(OBJEXT) \ - $(TTK_OBJS) - -TTK_OBJS = \ - ttkWinMonitor.$(OBJEXT) \ - ttkWinTheme.$(OBJEXT) \ - ttkWinXPTheme.$(OBJEXT) \ - ttkBlink.$(OBJEXT) \ - ttkButton.$(OBJEXT) \ - ttkCache.$(OBJEXT) \ - ttkClamTheme.$(OBJEXT) \ - ttkClassicTheme.$(OBJEXT) \ - ttkDefaultTheme.$(OBJEXT) \ - ttkElements.$(OBJEXT) \ - ttkEntry.$(OBJEXT) \ - ttkFrame.$(OBJEXT) \ - ttkImage.$(OBJEXT) \ - ttkInit.$(OBJEXT) \ - ttkLabel.$(OBJEXT) \ - ttkLayout.$(OBJEXT) \ - ttkManager.$(OBJEXT) \ - ttkNotebook.$(OBJEXT) \ - ttkPanedwindow.$(OBJEXT) \ - ttkProgress.$(OBJEXT) \ - ttkScale.$(OBJEXT) \ - ttkScrollbar.$(OBJEXT) \ - ttkScroll.$(OBJEXT) \ - ttkSeparator.$(OBJEXT) \ - ttkSquare.$(OBJEXT) \ - ttkState.$(OBJEXT) \ - ttkTagSet.$(OBJEXT) \ - ttkTheme.$(OBJEXT) \ - ttkTrace.$(OBJEXT) \ - ttkTrack.$(OBJEXT) \ - ttkTreeview.$(OBJEXT) \ - ttkWidget.$(OBJEXT) \ - ttkStubInit.$(OBJEXT) +STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ +-I"${GENERIC_DIR_NATIVE}" -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ +-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ +${COMPILE_DEBUG_FLAGS} + +TCLTEST_OBJS = \ + tclTest.$(OBJEXT) \ + tclTestObj.$(OBJEXT) \ + tclTestProcBodyObj.$(OBJEXT) \ + tclThreadTest.$(OBJEXT) \ + tclWinTest.$(OBJEXT) + +GENERIC_OBJS = \ + regcomp.$(OBJEXT) \ + regexec.$(OBJEXT) \ + regfree.$(OBJEXT) \ + regerror.$(OBJEXT) \ + tclAlloc.$(OBJEXT) \ + tclAssembly.$(OBJEXT) \ + tclAsync.$(OBJEXT) \ + tclBasic.$(OBJEXT) \ + tclBinary.$(OBJEXT) \ + tclCkalloc.$(OBJEXT) \ + tclClock.$(OBJEXT) \ + tclCmdAH.$(OBJEXT) \ + tclCmdIL.$(OBJEXT) \ + tclCmdMZ.$(OBJEXT) \ + tclCompCmds.$(OBJEXT) \ + tclCompCmdsGR.$(OBJEXT) \ + tclCompCmdsSZ.$(OBJEXT) \ + tclCompExpr.$(OBJEXT) \ + tclCompile.$(OBJEXT) \ + tclConfig.$(OBJEXT) \ + tclDate.$(OBJEXT) \ + tclDictObj.$(OBJEXT) \ + tclDisassemble.$(OBJEXT) \ + tclEncoding.$(OBJEXT) \ + tclEnsemble.$(OBJEXT) \ + tclEnv.$(OBJEXT) \ + tclEvent.$(OBJEXT) \ + tclExecute.$(OBJEXT) \ + tclFCmd.$(OBJEXT) \ + tclFileName.$(OBJEXT) \ + tclGet.$(OBJEXT) \ + tclHash.$(OBJEXT) \ + tclHistory.$(OBJEXT) \ + tclIndexObj.$(OBJEXT) \ + tclInterp.$(OBJEXT) \ + tclIO.$(OBJEXT) \ + tclIOCmd.$(OBJEXT) \ + tclIOGT.$(OBJEXT) \ + tclIORChan.$(OBJEXT) \ + tclIORTrans.$(OBJEXT) \ + tclIOSock.$(OBJEXT) \ + tclIOUtil.$(OBJEXT) \ + tclLink.$(OBJEXT) \ + tclLiteral.$(OBJEXT) \ + tclListObj.$(OBJEXT) \ + tclLoad.$(OBJEXT) \ + tclMain.$(OBJEXT) \ + tclMain2.$(OBJEXT) \ + tclNamesp.$(OBJEXT) \ + tclNotify.$(OBJEXT) \ + tclOO.$(OBJEXT) \ + tclOOBasic.$(OBJEXT) \ + tclOOCall.$(OBJEXT) \ + tclOODefineCmds.$(OBJEXT) \ + tclOOInfo.$(OBJEXT) \ + tclOOMethod.$(OBJEXT) \ + tclOOStubInit.$(OBJEXT) \ + tclObj.$(OBJEXT) \ + tclOptimize.$(OBJEXT) \ + tclPanic.$(OBJEXT) \ + tclParse.$(OBJEXT) \ + tclPathObj.$(OBJEXT) \ + tclPipe.$(OBJEXT) \ + tclPkg.$(OBJEXT) \ + tclPkgConfig.$(OBJEXT) \ + tclPosixStr.$(OBJEXT) \ + tclPreserve.$(OBJEXT) \ + tclProc.$(OBJEXT) \ + tclRegexp.$(OBJEXT) \ + tclResolve.$(OBJEXT) \ + tclResult.$(OBJEXT) \ + tclScan.$(OBJEXT) \ + tclStringObj.$(OBJEXT) \ + tclStrToD.$(OBJEXT) \ + tclStubInit.$(OBJEXT) \ + tclThread.$(OBJEXT) \ + tclThreadAlloc.$(OBJEXT) \ + tclThreadJoin.$(OBJEXT) \ + tclThreadStorage.$(OBJEXT) \ + tclTimer.$(OBJEXT) \ + tclTomMathInterface.$(OBJEXT) \ + tclTrace.$(OBJEXT) \ + tclUtf.$(OBJEXT) \ + tclUtil.$(OBJEXT) \ + tclVar.$(OBJEXT) \ + tclZipfs.$(OBJEXT) \ + tclZlib.$(OBJEXT) + +TOMMATH_OBJS = \ + bncore.${OBJEXT} \ + bn_reverse.${OBJEXT} \ + bn_fast_s_mp_mul_digs.${OBJEXT} \ + bn_fast_s_mp_sqr.${OBJEXT} \ + bn_mp_add.${OBJEXT} \ + bn_mp_add_d.${OBJEXT} \ + bn_mp_and.${OBJEXT} \ + bn_mp_clamp.${OBJEXT} \ + bn_mp_clear.${OBJEXT} \ + bn_mp_clear_multi.${OBJEXT} \ + bn_mp_cmp.${OBJEXT} \ + bn_mp_cmp_d.${OBJEXT} \ + bn_mp_cmp_mag.${OBJEXT} \ + bn_mp_cnt_lsb.${OBJEXT} \ + bn_mp_copy.${OBJEXT} \ + bn_mp_count_bits.${OBJEXT} \ + bn_mp_div.${OBJEXT} \ + bn_mp_div_d.${OBJEXT} \ + bn_mp_div_2.${OBJEXT} \ + bn_mp_div_2d.${OBJEXT} \ + bn_mp_div_3.${OBJEXT} \ + bn_mp_exch.${OBJEXT} \ + bn_mp_expt_d.${OBJEXT} \ + bn_mp_expt_d_ex.${OBJEXT} \ + bn_mp_get_int.${OBJEXT} \ + bn_mp_get_long.${OBJEXT} \ + bn_mp_get_long_long.${OBJEXT} \ + bn_mp_grow.${OBJEXT} \ + bn_mp_init.${OBJEXT} \ + bn_mp_init_copy.${OBJEXT} \ + bn_mp_init_multi.${OBJEXT} \ + bn_mp_init_set.${OBJEXT} \ + bn_mp_init_set_int.${OBJEXT} \ + bn_mp_init_size.${OBJEXT} \ + bn_mp_karatsuba_mul.${OBJEXT} \ + bn_mp_karatsuba_sqr.$(OBJEXT) \ + bn_mp_lshd.${OBJEXT} \ + bn_mp_mod.${OBJEXT} \ + bn_mp_mod_2d.${OBJEXT} \ + bn_mp_mul.${OBJEXT} \ + bn_mp_mul_2.${OBJEXT} \ + bn_mp_mul_2d.${OBJEXT} \ + bn_mp_mul_d.${OBJEXT} \ + bn_mp_neg.${OBJEXT} \ + bn_mp_or.${OBJEXT} \ + bn_mp_radix_size.${OBJEXT} \ + bn_mp_radix_smap.${OBJEXT} \ + bn_mp_read_radix.${OBJEXT} \ + bn_mp_rshd.${OBJEXT} \ + bn_mp_set.${OBJEXT} \ + bn_mp_set_int.${OBJEXT} \ + bn_mp_set_long.${OBJEXT} \ + bn_mp_set_long_long.${OBJEXT} \ + bn_mp_shrink.${OBJEXT} \ + bn_mp_sqr.${OBJEXT} \ + bn_mp_sqrt.${OBJEXT} \ + bn_mp_sub.${OBJEXT} \ + bn_mp_sub_d.${OBJEXT} \ + bn_mp_to_unsigned_bin.${OBJEXT} \ + bn_mp_to_unsigned_bin_n.${OBJEXT} \ + bn_mp_toom_mul.${OBJEXT} \ + bn_mp_toom_sqr.${OBJEXT} \ + bn_mp_toradix_n.${OBJEXT} \ + bn_mp_unsigned_bin_size.${OBJEXT} \ + bn_mp_xor.${OBJEXT} \ + bn_mp_zero.${OBJEXT} \ + bn_s_mp_add.${OBJEXT} \ + bn_s_mp_mul_digs.${OBJEXT} \ + bn_s_mp_sqr.${OBJEXT} \ + bn_s_mp_sub.${OBJEXT} + + +WIN_OBJS = \ + tclWin32Dll.$(OBJEXT) \ + tclWinChan.$(OBJEXT) \ + tclWinConsole.$(OBJEXT) \ + tclWinSerial.$(OBJEXT) \ + tclWinError.$(OBJEXT) \ + tclWinFCmd.$(OBJEXT) \ + tclWinFile.$(OBJEXT) \ + tclWinInit.$(OBJEXT) \ + tclWinLoad.$(OBJEXT) \ + tclWinNotify.$(OBJEXT) \ + tclWinPipe.$(OBJEXT) \ + tclWinSock.$(OBJEXT) \ + tclWinThrd.$(OBJEXT) \ + tclWinTime.$(OBJEXT) + +DDE_OBJS = tclWinDde.$(OBJEXT) + +REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ - tkStubLib.$(OBJEXT) \ - ttkStubLib.$(OBJEXT) + tclStubLib.$(OBJEXT) \ + tclTomMathStubLib.$(OBJEXT) \ + tclOOStubLib.$(OBJEXT) -TCL_DOCS = "$(TCL_SRC_DIR_NATIVE)/doc/*.[13n]" -TK_DOCS = "$(ROOT_DIR_NATIVE)/doc/*.[13n]" -CORE_DOCS = $(TCL_DOCS) $(TK_DOCS) +TCLSH_OBJS = tclAppInit.$(OBJEXT) -DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget +ZLIB_OBJS = \ + adler32.$(OBJEXT) \ + compress.$(OBJEXT) \ + crc32.$(OBJEXT) \ + deflate.$(OBJEXT) \ + infback.$(OBJEXT) \ + inffast.$(OBJEXT) \ + inflate.$(OBJEXT) \ + inftrees.$(OBJEXT) \ + trees.$(OBJEXT) \ + uncompr.$(OBJEXT) \ + zutil.$(OBJEXT) -SHELL_ENV = \ - @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \ - TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \ - PATH="$(TCL_BIN_DIR):$(PATH)"; export PATH; +TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ -### -# Tip 430 - ZipFS Modifications -### -TK_ZIP_FILE = libtk_${MAJOR_VERSION}_${MINOR_VERSION}_${PATCH_LEVEL}.zip -TK_VFS_PATH = libtk.vfs/tk_library -TK_VFS_ROOT = libtk.vfs -TCL_ZIPFS_SUPPORT = @TCL_ZIPFS_SUPPORT@ -TCL_ZIPFS_FLAG = @TCL_ZIPFS_FLAG@ -TCL_ZIPFS_OBJS = -ZIP_PROG = @ZIP_PROG@ -ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ -ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ -SHARED_BUILD = @SHARED_BUILD@ +TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] -ifeq (${TCL_ZIPFS_SUPPORT},1) - TCL_ZIPFS_OBJS=${TK_ZIP_FILE} -endif -ifeq (${TCL_ZIPFS_SUPPORT},2) - TCL_ZIPFS_OBJS=${TK_ZIP_FILE} -endif +all: binaries libraries doc packages -# Main targets. The default target -- all -- builds the binaries, -# performs any post processing on libraries or documents. +tcltest: $(TCLSH) $(TEST_DLL_FILE) -all: binaries libraries doc +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH) -binaries: @LIBRARIES@ $(WISH) +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} libraries: -$(ROOT_DIR)/doc/man.macros: - $(INSTALL_DATA) "$(TCL_SRC_DIR)/doc/man.macros" "$(ROOT_DIR)/doc/man.macros" +doc: + +tclzipfile: ${TCL_ZIP_FILE} -doc: $(ROOT_DIR)/doc/man.macros +${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} + rm -rf ${TCL_VFS_ROOT} + mkdir -p ${TCL_VFS_PATH} + $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH} + cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} -${TK_ZIP_FILE}: - $(RMDIR) ${TK_VFS_ROOT} - $(MKDIR) ${TK_VFS_PATH} - $(COPY) -a $(TOP_DIR)/library/* ${TK_VFS_PATH} - cd ${TK_VFS_ROOT} ; ${ZIP_PROG} ${ZIP_PROG_OPTIONS} ../${TK_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} +$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ +cat32.$(OBJEXT): cat.c + $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) -winhelp: $(TCL_SRC_DIR)/tools/man2help.tcl $(MAN2TCL) - $(TCL_EXE) "$(TCL_SRC_DIR_NATIVE)/tools/man2help.tcl" tcl "$(VER)" $(CORE_DOCS) - $(COPY) "$(TCL_BIN_DIR)/tcl.hpj" ./ - hcw /c /e tcl.hpj - $(COPY) ./tcl$(VER).cnt ./TCL$(VER).HLP "$(TCL_SRC_DIR_NATIVE)/tools/" +$(CAT32): cat32.$(OBJEXT) + $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) -$(MAN2TCL): $(TCL_SRC_DIR)/tools/man2tcl.c - $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(TCL_SRC_DIR_NATIVE)/tools/man2tcl.c" +# The following targets are configured by autoconf to generate either a shared +# library or static library -# Specifying TESTFLAGS on the command line is the standard way to pass -# args to tcltest, ie: -# % make test TESTFLAGS="-verbose bps -file fileName.test" +${TCL_STUB_LIB_FILE}: ${STUB_OBJS} + @$(RM) ${TCL_STUB_LIB_FILE} + @MAKE_STUB_LIB@ ${STUB_OBJS} + @POST_MAKE_LIB@ -test: test-classic test-ttk +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE} + @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) + @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) + @VC_MANIFEST_EMBED_DLL@ +ifeq (${ZIPFS_BUILD},1) + cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE} +endif -test-classic: binaries $(TKTEST) $(TEST_DLL_FILE) $(CAT32) - $(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" \ - $(TESTFLAGS) | ./$(CAT32) +${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} + @$(RM) ${TCL_LIB_FILE} + @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} + @POST_MAKE_LIB@ -test-ttk: binaries $(TKTEST) $(TEST_DLL_FILE) $(CAT32) - $(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/ttk/all.tcl" \ - $(TESTFLAGS) | ./$(CAT32) +${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} + @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -runtest: binaries $(TKTEST) $(TEST_DLL_FILE) - $(SHELL_ENV) ./$(TKTEST) $(TESTFLAGS) $(SCRIPT) +${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} + @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -# This target can be used to run wish from the build directory -# via `make shell` or `make shell SCRIPT=foo.tcl` -shell: binaries - $(SHELL_ENV) ./$(WISH) $(SCRIPT) +${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} + @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} + @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -demo: $(WISH) - $(SHELL_ENV) ./$(WISH) $(ROOT_DIR)/library/demos/widget +# use pre-built zlib1.dll +${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} + @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \ + $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ + else \ + $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ + fi; -# This target can be used to run wish inside either gdb or insight -gdb: binaries - @echo "set env TCL_LIBRARY=$(TCL_SRC_DIR_NATIVE)/library" > gdb.run - @echo "set env TK_LIBRARY=$(ROOT_DIR_NATIVE)/library" >> gdb.run - PATH="$(TCL_BIN_DIR):$(PATH)"; export PATH; \ - gdb ./$(WISH) --command=gdb.run - @$(RM) gdb.run - - -# Tip 430 - When we bump Tk, offer up only zipfile bundled Tk -# For now, 8.6 needs to be able to load Tk, and it doesn't -# have zipfs facilities -#INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ -INSTALL_LIBRARIES = install-libraries -INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) +# Add the object extension to the implicit rules. By default .obj is not +# automatically added. + +.SUFFIXES: .${OBJEXT} +.SUFFIXES: .$(RES) +.SUFFIXES: .rc + +# Special case object targets + +tclWinInit.${OBJEXT}: tclWinInit.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + +tclWinPipe.${OBJEXT}: tclWinPipe.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + +testMain.${OBJEXT}: tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) + +tclMain2.${OBJEXT}: tclMain.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) + +# TIP #430, ZipFS Support +tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ + -DCFG_RUNTIME_PATH=\"$(bindir_native)\" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ + $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip @DEPARG@ $(CC_OBJNAME) + + +# TIP #59, embedding of configuration information into the binary library. +# +# Part of Tcl's configuration information are the paths where it was installed +# and where it will look for its libraries (which can be different). We derive +# this information from the variables which can be overridden by the user. As +# every path can be configured separately we do not remember one general +# prefix/exec_prefix but all the different paths individually. + +tclPkgConfig.${OBJEXT}: tclPkgConfig.c + $(CC) -c $(CC_SWITCHES) \ + -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \ + \ + -DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \ + -DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \ + -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \ + -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \ + -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ + -DBUILD_tcl \ + @DEPARG@ $(CC_OBJNAME) + +# The following objects are part of the stub library and should not be built +# as DLL objects but none of the symbols should be exported + +tclStubLib.${OBJEXT}: tclStubLib.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + +tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + +tclOOStubLib.${OBJEXT}: tclOOStubLib.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + +# Implicit rule for all object files that will end up in the Tcl library + +%.${OBJEXT}: %.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME) + +.rc.$(RES): + $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ + + + +#-------------------------------------------------------------------------- +# Minizip implementation +#-------------------------------------------------------------------------- +adler32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c + +compress.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c + +crc32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c + +deflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c + +ioapi.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + +iowin32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c + +infback.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c + +inffast.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c + +inflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c + +inftrees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c + +trees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c + +uncompr.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c + +zip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c + +zutil.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c + +minizip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + +minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) + $(HOST_CC) -o $@ $(MINIZIP_OBJS) + +# The following target generates the file generic/tclDate.c from the yacc +# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is +# not available in all environments. The name of the .c file is different than +# the name of the .y file so that make doesn't try to automatically regenerate +# the .c file. + +gendate: + bison --output-file=$(GENERIC_DIR)/tclDate.c \ + --name-prefix=TclDate \ + --no-lines \ + $(GENERIC_DIR)/tclGetDate.y + +# The following target generates the file generic/tclTomMath.h. It needs to be +# run (and the results checked) after updating to a new release of libtommath. + +gentommath_h: + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \ + "$(TOMMATH_DIR_NATIVE)/tommath.h" \ + > "$(GENERIC_DIR_NATIVE)/tclTomMath.h" + +INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) INSTALL_DOC_TARGETS = install-doc +INSTALL_PACKAGE_TARGETS = install-packages INSTALL_DEV_TARGETS = install-headers -INSTALL_DEMO_TARGETS = install-demos -INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) \ - $(INSTALL_DEMO_TARGETS) +INSTALL_EXTRA_TARGETS = +INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ + $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) install: $(INSTALL_TARGETS) install-binaries: binaries - @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) $(PKG_INSTALL_DIR); \ + @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ @@ -518,140 +707,133 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in $(TK_DLL_FILE) $(WISH); \ + @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ + do \ + if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ + echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ + $(MKDIR) $(LIB_INSTALL_DIR)/$$i; \ + else true; \ + fi; \ + done; + @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ done - @echo "Creating package index $(PKG_INDEX)"; - @$(RM) $(PKG_INDEX); - @(\ - echo "if {[catch {package present Tcl 8.6.0}]} return";\ - echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\ - echo " || ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\ - echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin libtk$(VERSION).dll]] Tk]";\ - echo "} else {";\ - echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin $(TK_DLL_FILE)]] Tk]";\ - echo "}";\ - ) > $(PKG_INDEX); - @for i in tkConfig.sh $(TK_LIB_FILE) $(TK_STUB_LIB_FILE); \ + @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \ $(COPY) $$i "$(LIB_INSTALL_DIR)"; \ fi; \ done + @if [ -f $(DDE_DLL_FILE) ]; then \ + echo Installing $(DDE_DLL_FILE); \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ + $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + fi + @if [ -f $(DDE_LIB_FILE) ]; then \ + echo Installing $(DDE_LIB_FILE); \ + $(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)/reg${REGDOTVER}; \ + $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ + $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + fi + @if [ -f $(REG_LIB_FILE) ]; then \ + echo Installing $(REG_LIB_FILE); \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + fi install-libraries-zipfs-shared: libraries - @for i in "$(SCRIPT_INSTALL_DIR)"; \ - do \ - if [ ! -d "$$i" ] ; then \ - echo "Making directory $$i"; \ - $(INSTALL_DATA_DIR) "$$i"; \ - else true; \ - fi; \ - done; - @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"; - @for i in \ - $(WIN_DIR)/tkAppInit.c; \ - do \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ - done; install-libraries-zipfs-static: install-libraries-zipfs-shared - $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" ;\ + $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" -install-libraries: libraries - @for i in $(INSTALL_ROOT)$(prefix)/lib \ - $(INCLUDE_INSTALL_DIR) $(INCLUDE_INSTALL_DIR)/X11 \ - $(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images \ - $(SCRIPT_INSTALL_DIR)/msgs $(SCRIPT_INSTALL_DIR)/ttk; \ +install-libraries: libraries install-tzdata install-msgs + @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ + $(SCRIPT_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ - chmod 755 $$i; \ else true; \ fi; \ done; - @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; - @for i in $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkPlatDecls.h \ - $(GENERIC_DIR)/tkIntXlibDecls.h $(GENERIC_DIR)/tkDecls.h ; \ - do \ - $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \ - done; - @for i in $(XLIB_DIR)/X11/*.h; \ + @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ do \ - $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR)/X11; \ + if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ + echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ + $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \ + else true; \ + fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; - @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex \ - $(UNIX_DIR)/tkAppInit.c; \ + @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ do \ - $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \ + $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing library ttk directory"; - @for i in $(ROOT_DIR)/library/ttk/*.tcl; \ + @echo "Installing library http1.0 directory"; + @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ - if [ -f $$i ] ; then \ - $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/ttk; \ - fi; \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing library images directory"; - @for i in $(ROOT_DIR)/library/images/*; \ + @echo "Installing package http 2.8.12 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.12.tm; + @echo "Installing library opt0.4 directory"; + @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ - if [ -f $$i ] ; then \ - $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/images; \ - fi; \ - done; - @echo "Installing translation directory"; - @for i in $(ROOT_DIR)/library/msgs/*.msg; \ - do \ - if [ -f $$i ] ; then \ - $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/msgs; \ - fi; \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; + @echo "Installing package msgcat 1.6.1 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm; + @echo "Installing package tcltest 2.4.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm; + @echo "Installing package platform 1.0.14 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; + @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm; + @echo "Installing encodings"; + @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ + $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ + done; + +install-tzdata: + @echo "Installing time zone data" + @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + +install-msgs: + @echo "Installing message catalogs" + @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" -install-demos: - @for i in $(INSTALL_ROOT)$(prefix)/lib $(SCRIPT_INSTALL_DIR) \ - $(SCRIPT_INSTALL_DIR)/demos \ - $(SCRIPT_INSTALL_DIR)/demos/images ; \ +install-doc: doc + +install-headers: + @for i in "$(INCLUDE_INSTALL_DIR)"; \ do \ - if [ ! -d $$i ] ; then \ + if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ - $(MKDIR) $$i; \ - chmod 755 $$i; \ + $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; - @echo "Installing demos to $(SCRIPT_INSTALL_DIR)/demos/"; - @for i in $(ROOT_DIR)/library/demos/*; \ - do \ - if [ -f $$i ] ; then \ - sed -e '3 s|exec wish|exec wish$(VER)|' \ - $$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \ - fi; \ - done; - @for i in $(DEMOPROGS); \ - do \ - if test $$i = "square"; then \ - rm -f $(SCRIPT_INSTALL_DIR)/demos/$$i; \ - else \ - chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \ - fi; \ - done; - @echo "Installing demo images"; - @for i in $(ROOT_DIR)/library/demos/images/*; \ + @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; + @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ + $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ + $(GENERIC_DIR)/tclPlatDecls.h \ + $(GENERIC_DIR)/tclTomMath.h \ + $(GENERIC_DIR)/tclTomMathDecls.h ; \ do \ - if [ -f $$i ] ; then \ - $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \ - fi; \ + $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \ done; -install-doc: doc - # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ @@ -659,153 +841,197 @@ install-private-headers: libraries if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ - chmod 755 $$i; \ else true; \ fi; \ done; - @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/"; - @for i in $(GENERIC_DIR)/tkInt.h $(GENERIC_DIR)/tkIntDecls.h \ - $(GENERIC_DIR)/tkIntPlatDecls.h $(GENERIC_DIR)/tkPort.h \ - $(WIN_DIR)/tkWinPort.h $(WIN_DIR)/tkWinInt.h $(WIN_DIR)/tkWin.h; \ + @echo "Installing private header files"; + @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ + "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ + "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \ + "$(WIN_DIR)/tclWinPort.h" ; \ do \ - $(INSTALL_DATA) $$i $(PRIVATE_INCLUDE_INSTALL_DIR); \ + $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done; -$(WISH): $(WISH_OBJS) @LIBRARIES@ $(TK_STUB_LIB_FILE) wish.$(RES) - $(CC) $(CFLAGS) $(WISH_OBJS) $(TK_LIB_FILE) \ - $(TK_STUB_LIB_FILE) $(TCL_LIB_FILE) $(LIBS) \ - wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW) - @VC_MANIFEST_EMBED_EXE@ - -tktest: $(TKTEST) - -$(TKTEST): testMain.$(OBJEXT) $(TEST_DLL_FILE) @LIBRARIES@ $(TK_STUB_LIB_FILE) wish.$(RES) - $(CC) $(CFLAGS) testMain.$(OBJEXT) $(TEST_LIB_FILE) $(TK_LIB_FILE) \ - $(TK_STUB_LIB_FILE) $(TCL_LIB_FILE) $(LIBS) \ - wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW) - @VC_MANIFEST_EMBED_EXE@ - -${TEST_DLL_FILE}: ${TKTEST_OBJS} ${TK_STUB_LIB_FILE} - @MAKE_DLL@ ${TKTEST_OBJS} $(TK_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - -# Msys make requires this next rule for some reason. -$(TCL_SRC_DIR)/win/cat.c: - -cat32.${OBJEXT}: $(TCL_SRC_DIR)/win/cat.c - $(CC) -c $(CC_SWITCHES) "$(TCL_SRC_DIR)/win/cat.c" $(CC_OBJNAME) - -$(CAT32): cat32.${OBJEXT} - $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) - -# The following targets are configured by autoconf to generate either -# a shared library or static library - -${TK_STUB_LIB_FILE}: ${STUB_OBJS} - @$(RM) ${TK_STUB_LIB_FILE} - @MAKE_STUB_LIB@ ${STUB_OBJS} - @POST_MAKE_LIB@ - -${TK_DLL_FILE}: ${TK_OBJS} $(TK_RES) ${TCL_ZIPFS_OBJS} - @$(RM) ${TK_DLL_FILE} - @MAKE_DLL@ ${TK_OBJS} $(TK_RES) $(SHLIB_LD_LIBS) - @VC_MANIFEST_EMBED_DLL@ -ifeq (${TCL_ZIPFS_SUPPORT},1) - cat ${TK_ZIP_FILE} >> ${LIB_FILE} -endif - -${TK_LIB_FILE}: ${TK_OBJS} - @$(RM) ${TK_LIB_FILE} - @MAKE_LIB@ ${TK_OBJS} - @POST_MAKE_LIB@ - -# Special case object file targets - -winMain.$(OBJEXT): winMain.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -testMain.$(OBJEXT): winMain.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ -DTK_TEST $(CC_OBJNAME) - -tkTest.$(OBJEXT): tkTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tkOldTest.$(OBJEXT): tkOldTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tkWinTest.$(OBJEXT): tkWinTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tkSquare.$(OBJEXT): tkSquare.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tkMain2.$(OBJEXT): tkMain.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tk -DTK_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) - -# Extra dependency info -tkConsole.$(OBJEXT): configure Makefile -tkMain.$(OBJEXT): configure Makefile -tkWindow.$(OBJEXT): configure Makefile +# Specifying TESTFLAGS on the command line is the standard way to pass args to +# tcltest, i.e.: +# % make test TESTFLAGS="-verbose bps -file fileName.test" -# Add the object extension to the implicit rules. By default .obj is not -# automatically added. +test: test-tcl test-packages -.SUFFIXES: .${OBJEXT} -.SUFFIXES: .$(RES) -.SUFFIXES: .rc +test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) + TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) -# Implicit rule for all object files that will end up in the Tk library +# Useful target to launch a built tclsh with the proper path,... +runtest: binaries $(TCLSH) $(TEST_DLL_FILE) + @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ + ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) -%.$(OBJEXT): %.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tk -DBUILD_ttk @DEPARG@ $(CC_OBJNAME) +# This target can be used to run tclsh from the build directory via +# `make shell SCRIPT=foo.tcl` +shell: binaries + @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ + ./$(TCLSH) $(SCRIPT) -.rc.$(RES): - $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@ +# This target can be used to run tclsh inside either gdb or insight +gdb: binaries + @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run + gdb ./$(TCLSH) --command=gdb.run + rm gdb.run depend: +Makefile: $(SRC_DIR)/Makefile.in + ./config.status + cleanhelp: - $(RM) *.hlp *.cnt *.hpj *.GID *.rtf man2tcl${EXEEXT} + $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe -clean: cleanhelp - $(RM) *.lib *.a *.exp *.dll *.res *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(WISH) $(TKTEST) $(CAT32) +clean: cleanhelp clean-packages + $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out + $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb + $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} + $(RM) *.zip + $(RMDIR) *.vfs -distclean: clean - $(RM) Makefile config.status config.cache config.log tkConfig.sh \ - wish.exe.manifest +distclean: distclean-packages clean + $(RM) Makefile config.status config.cache config.log tclConfig.sh \ + tcl.hpj config.status.lineno tclsh.exe.manifest -Makefile: $(SRC_DIR)/Makefile.in - ./config.status +# +# Bundled package targets +# + +PKG_CFG_ARGS = @PKG_CFG_ARGS@ +PKG_DIR = ./pkgs + +packages: + @builddir=`$(CYGPATH) $$(pwd -P)`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ] ; then \ + if [ -x $$i/configure ] ; then \ + pkg=`basename $$i`; \ + mkdir -p $(PKG_DIR)/$$pkg; \ + if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + ( cd $(PKG_DIR)/$$pkg; \ + echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \ + $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \ + fi ; \ + echo "Building package '$$pkg'"; \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +install-packages: packages + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + echo "Installing package '$$pkg'"; \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) install "DESTDIR=$(INSTALL_ROOT)"; ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +test-packages: tcltest packages + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + echo "Testing package '$$pkg'"; \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +clean-packages: + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +distclean-packages: + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \ + fi; \ + cd $$builddir; \ + rm -rf $(PKG_DIR)/$$pkg; \ + fi; \ + done; \ + rm -rf $(PKG_DIR) # # Regenerate the stubs files. # -$(GENERIC_DIR)/tkStubInit.c: $(GENERIC_DIR)/tk.decls \ - $(GENERIC_DIR)/tkInt.decls - @echo "Warning: tkStubInit.c may be out of date." +$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ + $(GENERIC_DIR)/tclInt.decls + @echo "Warning: tclStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" genstubs: - $(TCL_EXE) "$(TCL_TOOL_DIR)/genStubs.tcl" \ + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ + "$(GENERIC_DIR_NATIVE)" \ + "$(GENERIC_DIR_NATIVE)/tcl.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)/tk.decls" \ - "$(GENERIC_DIR_NATIVE)/tkInt.decls" - $(TCL_EXE) "$(TTK_DIR)/ttkGenStubs.tcl" \ - "$(TTK_DIR)" \ - "$(TTK_DIR)/ttk.decls" + "$(GENERIC_DIR_NATIVE)/tclOO.decls" + +# +# This target creates the HTML folder for Tcl & Tk and places it in +# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool +# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# tk8.* up two directories from the TOOL_DIR. +# + +TOOL_DIR=$(ROOT_DIR)/tools +HTML_INSTALL_DIR=$(ROOT_DIR)/html +html: + $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" + +html-tcl: $(TCLSH) + $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" + +html-tk: $(TCLSH) + $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" # # The list of all the targets that do not correspond to real files. This stops # 'make' from getting confused when someone makes an error in a rule. # -.PHONY: all binaries libraries doc tkLibObjs objs tktest-real test test-classic -.PHONY: test-ttk testlang runtest shell demo gdb install install-strip -.PHONY: install-binaries install-libraries install-demos install-doc -.PHONY: install-private-headers clean distclean depend genstubs checkstubs -.PHONY: checkuchar checkexports rpm dist alldist allpatch html html-tcl html-tk +.PHONY: all tcltest binaries libraries doc gendate gentommath_h install +.PHONY: install-binaries install-libraries install-tzdata install-msgs +.PHONY: install-doc install-private-headers test test-tcl runtest shell +.PHONY: gdb depend cleanhelp clean distclean packages install-packages +.PHONY: test-packages clean-packages distclean-packages genstubs html +.PHONY: html-tcl html-tk +.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile # DO NOT DELETE THIS LINE -- make depend depends on it. -- cgit v0.12 From 48fb6e2c88c4b6966e52e0a8d34274e91eef47f3 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 25 Nov 2017 16:36:22 +0000 Subject: Fix for issue [4f6a1ebd64]: ensemble: segmentation fault when -subcommand and -map values are the same object. --- generic/tclEnsemble.c | 14 +++++++++++++- tests/namespace.test | 18 +++++++++++++++++- 2 files changed, 30 insertions(+), 2 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index f3e8187..392f430 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2505,6 +2505,7 @@ BuildEnsembleConfig( int i, j, isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; + Tcl_Obj *subcmdDictCopy = NULL ; if (hash->numEntries != 0) { /* @@ -2553,7 +2554,15 @@ BuildEnsembleConfig( */ if (ensemblePtr->subcommandDict != NULL) { - Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i], + if (subcmdDictCopy == NULL) { + if (ensemblePtr->subcmdList == ensemblePtr->subcommandDict) { + subcmdDictCopy = Tcl_DuplicateObj(ensemblePtr->subcommandDict); + } else { + subcmdDictCopy = ensemblePtr->subcommandDict; + } + Tcl_IncrRefCount(subcmdDictCopy); + } + Tcl_DictObjGet(NULL, subcmdDictCopy, subcmdv[i], &target); if (target != NULL) { Tcl_SetHashValue(hPtr, target); @@ -2578,6 +2587,9 @@ BuildEnsembleConfig( Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); } + if (subcmdDictCopy != NULL) { + Tcl_DecrRefCount(subcmdDictCopy); + } } else if (ensemblePtr->subcommandDict != NULL) { /* * No subcmd list, but we do have a mapping dictionary so we should diff --git a/tests/namespace.test b/tests/namespace.test index f6f817b..623f06d 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -1785,7 +1785,10 @@ test namespace-42.7 {ensembles: nested} -body { } -cleanup { namespace delete ns } -result {{1 ::ns::x0::z} 1 2 3} -test namespace-42.8 {ensembles: [Bug 1670091]} -setup { +test namespace-42.8 { + ensembles: [Bug 1670091], panic due to pointer to a deallocated List + struct. +} -setup { proc demo args {} variable target [list [namespace which demo] x] proc trial args {variable target; string length $target} @@ -1800,6 +1803,19 @@ test namespace-42.8 {ensembles: [Bug 1670091]} -setup { rename foo {} } -result {} +test namespace-42.9 { + ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a + deallocated List struct. +} -setup { + namespace eval n {namespace ensemble create} + dict set list one ::two + namespace ensemble configure n -subcommands $list -map $list +} -body { + n one +} -cleanup { + namespace delete n +} -returnCodes error -match glob -result {invalid command name*} + test namespace-43.1 {ensembles: dict-driven} { namespace eval ns { namespace export x* -- cgit v0.12 From 811ec68434e9a83c37f1a0fd3ef0a8cae5baac91 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 25 Nov 2017 18:24:10 +0000 Subject: Add missing parenthesis to an expression in TclEnsureNamespace. --- generic/tclNamesp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index e7914ad..d661856 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2444,7 +2444,7 @@ TclEnsureNamespace( Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; - if (!nsPtr->flags & NS_DYING) { + if (!(nsPtr->flags & NS_DYING)) { return namespacePtr; } return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL); -- cgit v0.12 From 20dedcd841ef5caf05a104ccd36929080f8a5645 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 27 Nov 2017 13:52:18 +0000 Subject: Fix test-cases in safe.test, failing due to changes in min/max math functions. --- generic/tclInterp.c | 4 ---- tests/safe.test | 2 +- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index d9dfd37..d4bf465 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3208,10 +3208,6 @@ Tcl_MakeSafe( (void) Tcl_EvalEx(interp, "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0); - (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master, - "::tcl::mathfunc::min", 0, NULL); - (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master, - "::tcl::mathfunc::max", 0, NULL); } iPtr->flags |= SAFE_INTERP; diff --git a/tests/safe.test b/tests/safe.test index e43ce12..33ee166 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -74,7 +74,7 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -s lsort [a aliases] } -cleanup { interp delete a -} -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock} +} -result {clock} test safe-3.1 {calling safe::interpInit is safe} -setup { catch {safe::interpDelete a} -- cgit v0.12 From d95ab0247a35a1a40f5e39186127a9f6ba4540a9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 27 Nov 2017 14:11:16 +0000 Subject: missed some more failing test-cases --- tests/interp.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/interp.test b/tests/interp.test index 1389304..4ea04e3 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -1847,7 +1847,7 @@ test interp-23.2 {testing hiding vs aliases: safe interp} -setup { lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] } -cleanup { interp delete a -} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds] +} -result [list $hidden_cmds {bar clock} $hidden_cmds {bar clock} [lsort [concat $hidden_cmds bar]] {clock} $hidden_cmds] test interp-24.1 {result resetting on error} -setup { catch {interp delete a} -- cgit v0.12 From 293016951704770ca48af42b926e4fada4e2054a Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 27 Nov 2017 19:45:40 +0000 Subject: Streamline TclOO object cleanup routines. --- generic/tclOO.c | 484 ++++++++++++++++++++++------------------------------- generic/tclOOInt.h | 4 + 2 files changed, 208 insertions(+), 280 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 7feeb5d..3fece42 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -4,6 +4,7 @@ * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * * Copyright (c) 2005-2012 by Donal K. Fellows + * Copyright (c) 2017 by Nathan Coulter * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -82,7 +83,6 @@ static void ObjectRenamedTrace(ClientData clientData, const char *newName, int flags); static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); static inline void SquelchCachedName(Object *oPtr); -static void SquelchedNsFirst(ClientData clientData); static int PublicObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -583,8 +583,7 @@ AllocObject( */ if (nsNameStr != NULL) { - oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, - ObjectNamespaceDeleted); + oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = ++fPtr->tsdPtr->nsCount; goto configNamespace; @@ -596,8 +595,7 @@ AllocObject( char objName[10 + TCL_INTEGER_SPACE]; sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); - oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, - ObjectNamespaceDeleted); + oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = fPtr->tsdPtr->nsCount; break; @@ -637,7 +635,7 @@ AllocObject( * access variables in it. [Bug 2950259] */ - ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = SquelchedNsFirst; + ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = ObjectNamespaceDeleted; /* * Fill in the rest of the non-zero/NULL parts of the structure. @@ -752,30 +750,6 @@ MyDeleted( /* * ---------------------------------------------------------------------- * - * SquelchedNsFirst -- - * - * This callback is triggered when the object's namespace is deleted by - * any mechanism. It deletes the object's public command if it has not - * already been deleted, so ensuring that destructors get run at an - * appropriate time. [Bug 2950259] - * - * ---------------------------------------------------------------------- - */ - -static void -SquelchedNsFirst( - ClientData clientData) -{ - Object *oPtr = clientData; - - if (oPtr->command) { - Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); - } -} - -/* - * ---------------------------------------------------------------------- - * * ObjectRenamedTrace -- * * This callback is triggered when the object is deleted by any @@ -795,8 +769,6 @@ ObjectRenamedTrace( int flags) /* Why was the object deleted? */ { Object *oPtr = clientData; - Foundation *fPtr = oPtr->fPtr; - /* * If this is a rename and not a delete of the object, we just flush the * cache of the object name. @@ -808,87 +780,35 @@ ObjectRenamedTrace( } /* - * Oh dear, the object really is being deleted. Handle this by running the - * destructors and deleting the object's namespace, which in turn causes - * the real object structures to be deleted. - * - * Note that it is possible for the namespace to be deleted before the - * command. Because of that case, we must take care here to mark the - * command as being deleted so that if we return here we don't run into - * reentrancy problems. - * - * We also do not run destructors on the core class objects when the - * interpreter is being deleted; their incestuous nature causes problems - * in that case when the destructor is partially deleted before the uses - * of it have gone. [Bug 2949397] - */ - - AddRef(oPtr); - AddRef(fPtr->classCls); - AddRef(fPtr->objectCls); - AddRef(fPtr->classCls->thisPtr); - AddRef(fPtr->objectCls->thisPtr); - oPtr->command = NULL; - - if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) { - CallContext *contextPtr = - TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); - int result; - Tcl_InterpState state; - - oPtr->flags |= DESTRUCTOR_CALLED; - if (contextPtr != NULL) { - contextPtr->callPtr->flags |= DESTRUCTOR; - contextPtr->skip = 0; - state = Tcl_SaveInterpState(interp, TCL_OK); - result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, - contextPtr, 0, NULL); - if (result != TCL_OK) { - Tcl_BackgroundException(interp, result); - } - Tcl_RestoreInterpState(interp, state); - TclOODeleteContext(contextPtr); - } - } - - /* - * OK, the destructor's been run. Time to splat the class data (if any) - * and nuke the namespace (which triggers the final crushing of the object - * structure itself). - * - * The class of objects needs some special care; if it is deleted (and - * we're not killing the whole interpreter) we force the delete of the - * class of classes now as well. Due to the incestuous nature of those two - * classes, if one goes the other must too and yet the tangle can - * sometimes not go away automatically; we force it here. [Bug 2962664] - */ - - if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr) - && !Deleted(fPtr->classCls->thisPtr)) { - Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); - } - - if (oPtr->classPtr != NULL) { - AddRef(oPtr->classPtr); - ReleaseClassContents(interp, oPtr); - } - - /* * The namespace is only deleted if it hasn't already been deleted. [Bug - * 2950259] + * 2950259]. If the namespace has already been deleted, then + * ObjectNamespaceDeleted() has already cleaned up this command. */ - if (oPtr->namespacePtr && ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) { - Tcl_DeleteNamespace(oPtr->namespacePtr); - } - if (oPtr->classPtr) { - DelRef(oPtr->classPtr); + if (oPtr->namespacePtr == NULL) { + /* + * ObjectNamespaceDeleted() has already done all the cleanup, but + * detected that the command was in the process of being deleted, and + * left the pointer allocated for us. + */ + DelRef(oPtr); + } else { + if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc == NULL) { + /* + * ObjectNamespaceDeleted() called us, and still has some work to + * do, so we leave the pointer allocated for it to finish, and then + * it will deallocate the pointer. + */ + } else { + Tcl_DeleteNamespace(oPtr->namespacePtr); + /* + * ObjectNamespaceDeleted() doesn't know it was us that just + * called, so it left the pointer allocated. + */ + DelRef(oPtr); + } } - DelRef(fPtr->classCls->thisPtr); - DelRef(fPtr->objectCls->thisPtr); - DelRef(fPtr->classCls); - DelRef(fPtr->objectCls); - DelRef(oPtr); + return; } /* @@ -960,7 +880,9 @@ ReleaseClassContents( int i; Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr; Object *instancePtr; + Method *mPtr; Foundation *fPtr = oPtr->fPtr; + Tcl_Obj *variableObj; /* * Sanity check! @@ -1151,6 +1073,26 @@ ReleaseClassContents( ckfree(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } + + ClearMixins(clsPtr); + ClearSuperclasses(clsPtr); + + FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { + TclOODelMethodRef(mPtr); + } + Tcl_DeleteHashTable(&clsPtr->classMethods); + TclOODelMethodRef(clsPtr->constructorPtr); + TclOODelMethodRef(clsPtr->destructorPtr); + + FOREACH(variableObj, clsPtr->variables) { + TclDecrRefCount(variableObj); + } + if (i) { + ckfree(clsPtr->variables.list); + } + + DelRef(clsPtr); + } /* @@ -1172,36 +1114,92 @@ ObjectNamespaceDeleted( * being deleted. */ { Object *oPtr = clientData; + Foundation *fPtr = oPtr->fPtr; FOREACH_HASH_DECLS; - Class *clsPtr = oPtr->classPtr, *mixinPtr; + Class *mixinPtr; Method *mPtr; Tcl_Obj *filterObj, *variableObj; - int deleteAlreadyInProgress = 0, i; + Tcl_Interp *interp = oPtr->fPtr->interp; + int finished = 0, i; + + + AddRef(fPtr->classCls); + AddRef(fPtr->objectCls); + AddRef(fPtr->classCls->thisPtr); + AddRef(fPtr->objectCls->thisPtr); /* - * Instruct everyone to no longer use any allocated fields of the object. - * Also delete the commands that refer to the object at this point (if - * they still exist) because otherwise their references to the object - * point into freed memory, allowing crashes. + * We do not run destructors on the core class objects when the + * interpreter is being deleted; their incestuous nature causes problems + * in that case when the destructor is partially deleted before the uses + * of it have gone. [Bug 2949397] */ - if (oPtr->command) { - if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) { - /* - * Namespace deletion must have been triggered by a trace on command - * deletion , meaning that ObjectRenamedTrace() is eventually going - * to be called . - */ - deleteAlreadyInProgress = 1; + if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) { + CallContext *contextPtr = + TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); + int result; + + Tcl_InterpState state; + + oPtr->flags |= DESTRUCTOR_CALLED; + if (contextPtr != NULL) { + contextPtr->callPtr->flags |= DESTRUCTOR; + contextPtr->skip = 0; + state = Tcl_SaveInterpState(interp, TCL_OK); + result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, + contextPtr, 0, NULL); + if (result != TCL_OK) { + Tcl_BackgroundException(interp, result); + } + Tcl_RestoreInterpState(interp, state); + TclOODeleteContext(contextPtr); } + } + /* + * Instruct everyone to no longer use any allocated fields of the object. + * Also delete the command that refers to the object at this point (if + * it still exists) because otherwise its pointer to the object + * points into freed memory. + */ + + if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) { + /* + * Something has already started the command deletion process. We can + * go ahead and clean up the the namespace, + */ + } else { + /* + * The namespace must have been deleted directly. Delete the command + * as well. + */ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); + finished = 1; } + oPtr->command = NULL; + if (oPtr->myCommand) { Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand); } /* + * The class of objects needs some special care; if it is deleted (and + * we're not killing the whole interpreter) we force the delete of the + * class of classes now as well. Due to the incestuous nature of those two + * classes, if one goes the other must too and yet the tangle can + * sometimes not go away automatically; we force it here. [Bug 2962664] + */ + if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr) + && !Deleted(fPtr->classCls->thisPtr)) { + Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); + } + + if (oPtr->classPtr != NULL) { + ReleaseClassContents(interp, oPtr); + } + + /* * Splice the object out of its context. After this, we must *not* call * methods on the object. */ @@ -1260,77 +1258,27 @@ ObjectNamespaceDeleted( } /* - * If this was a class, there's additional deletion work to do. - */ - - if (clsPtr != NULL) { - Tcl_ObjectMetadataType *metadataTypePtr; - ClientData value; - - if (clsPtr->metadataPtr != NULL) { - FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { - metadataTypePtr->deleteProc(value); - } - Tcl_DeleteHashTable(clsPtr->metadataPtr); - ckfree(clsPtr->metadataPtr); - clsPtr->metadataPtr = NULL; - } - - FOREACH(filterObj, clsPtr->filters) { - TclDecrRefCount(filterObj); - } - if (i) { - ckfree(clsPtr->filters.list); - clsPtr->filters.num = 0; - } - - ClearMixins(clsPtr); - - ClearSuperclasses(clsPtr); - - if (clsPtr->subclasses.list) { - ckfree(clsPtr->subclasses.list); - clsPtr->subclasses.list = NULL; - clsPtr->subclasses.num = 0; - } - if (clsPtr->instances.list) { - ckfree(clsPtr->instances.list); - clsPtr->instances.list = NULL; - clsPtr->instances.num = 0; - } - if (clsPtr->mixinSubs.list) { - ckfree(clsPtr->mixinSubs.list); - clsPtr->mixinSubs.list = NULL; - clsPtr->mixinSubs.num = 0; - } - - FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { - TclOODelMethodRef(mPtr); - } - Tcl_DeleteHashTable(&clsPtr->classMethods); - TclOODelMethodRef(clsPtr->constructorPtr); - TclOODelMethodRef(clsPtr->destructorPtr); - - FOREACH(variableObj, clsPtr->variables) { - TclDecrRefCount(variableObj); - } - if (i) { - ckfree(clsPtr->variables.list); - } - - DelRef(clsPtr); - } - - /* * Delete the object structure itself. */ - if (deleteAlreadyInProgress) { - oPtr->classPtr = NULL; - oPtr->namespacePtr = NULL; - } else { + oPtr->classPtr = NULL; + oPtr->namespacePtr = NULL; + + DelRef(fPtr->classCls->thisPtr); + DelRef(fPtr->objectCls->thisPtr); + DelRef(fPtr->classCls); + DelRef(fPtr->objectCls); + if (finished) { + /* + * ObjectRenamedTrace called us, and not the other way around. + */ DelRef(oPtr); + } else { + /* + * ObjectRenamedTrace will call DelRef(oPtr). + */ } + return; } @@ -1424,7 +1372,7 @@ TclOOAddToInstances( void TclOORemoveFromSubclasses( Class *subPtr, /* The subclass to remove. */ - Class *superPtr) /* The superclass to (possibly) remove the + Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { int i; @@ -1495,7 +1443,7 @@ TclOOAddToSubclasses( void TclOORemoveFromMixinSubs( Class *subPtr, /* The subclass to remove. */ - Class *superPtr) /* The superclass to (possibly) remove the + Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { int i; @@ -1569,7 +1517,7 @@ AllocClass( * class. */ Object *useThisObj) /* Object that is to act as the class * representation, or NULL if a new object - * (with automatic name) is to be used. */ + * with automatic name is to be used. */ { Foundation *fPtr = GetFoundation(interp); Class *clsPtr = ckalloc(sizeof(Class)); @@ -1641,7 +1589,6 @@ AllocClass( * * ---------------------------------------------------------------------- */ - Tcl_Object Tcl_NewObjectInstance( Tcl_Interp *interp, /* Interpreter context. */ @@ -1658,54 +1605,14 @@ Tcl_NewObjectInstance( * constructor. */ { register Class *classPtr = (Class *) cls; - Foundation *fPtr = GetFoundation(interp); Object *oPtr; - /* - * Check if we're going to create an object over an existing command; - * that's not allowed. - */ - - if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, - TCL_NAMESPACE_ONLY)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create object \"%s\": command already exists with" - " that name", nameStr)); - Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); - return NULL; - } - - /* - * Create the object. - */ - - oPtr = AllocObject(interp, nameStr, nsNameStr); - oPtr->selfCls = classPtr; - TclOOAddToInstances(oPtr, classPtr); - - /* - * Check to see if we're really creating a class. If so, allocate the - * class structure as well. - */ - - if (TclOOIsReachable(fPtr->classCls, classPtr)) { - /* - * Is a class, so attach a class structure. Note that the AllocClass - * function splices the structure into the object, so we don't have - * to. Once that's done, we need to repatch the object to have the - * right class since AllocClass interferes with that. - */ - - AllocClass(interp, oPtr); - oPtr->selfCls = classPtr; - TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); - } else { - oPtr->classPtr = NULL; - } + oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); + if (oPtr == NULL) {return NULL;} /* - * Run constructors, except when objc < 0 (a special flag case used for - * object cloning only). + * Run constructors, except when objc < 0, which is a special flag case + * used for object cloning only. */ if (objc >= 0) { @@ -1733,9 +1640,8 @@ Tcl_NewObjectInstance( } /* - * It's an error if the object was whacked in the constructor. - * Force this if it isn't already an error (don't want to lose - * errors by accident...) [Bug 2903011] + * Ensure an error if the object was deleted in the constructor. + * Don't want to lose errors by accident. [Bug 2903011] */ if (result != TCL_ERROR && Deleted(oPtr)) { @@ -1786,7 +1692,6 @@ TclNRNewObjectInstance( * successful allocation. */ { register Class *classPtr = (Class *) cls; - Foundation *fPtr = GetFoundation(interp); CallContext *contextPtr; Tcl_InterpState state; Object *oPtr; @@ -1796,45 +1701,8 @@ TclNRNewObjectInstance( */ AddRef(classPtr); - /* - * Check if we're going to create an object over an existing command; - * that's not allowed. - */ - - if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, - TCL_NAMESPACE_ONLY)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create object \"%s\": command already exists with" - " that name", nameStr)); - Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); - return TCL_ERROR; - } - - /* - * Create the object. - */ - - oPtr = AllocObject(interp, nameStr, nsNameStr); - oPtr->selfCls = classPtr; - TclOOAddToInstances(oPtr, classPtr); - - /* - * Check to see if we're really creating a class. If so, allocate the - * class structure as well. - */ - - if (TclOOIsReachable(fPtr->classCls, classPtr)) { - /* - * Is a class, so attach a class structure. Note that the AllocClass - * function splices the structure into the object, so we don't have - * to. Once that's done, we need to repatch the object to have the - * right class since AllocClass interferes with that. - */ - - AllocClass(interp, oPtr); - oPtr->selfCls = classPtr; - TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); - } + oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); + if (oPtr == NULL) {return TCL_ERROR;} /* * Run constructors, except when objc < 0 (a special flag case used for @@ -1877,6 +1745,62 @@ TclNRNewObjectInstance( return TclOOInvokeContext(contextPtr, interp, objc, objv); } + +Object * +TclNewObjectInstanceCommon( + Tcl_Interp *interp, + Class *classPtr, + const char *nameStr, + const char *nsNameStr) +{ + Foundation *fPtr = GetFoundation(interp); + Object *oPtr; + + /* + * Disallow creation of an object over an existing command. + */ + + if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, + TCL_NAMESPACE_ONLY)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create object \"%s\": command already exists with" + " that name", nameStr)); + Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); + return NULL; + } + + /* + * Create the object. + */ + + oPtr = AllocObject(interp, nameStr, nsNameStr); + oPtr->selfCls = classPtr; + TclOOAddToInstances(oPtr, classPtr); + + /* + * Check to see if we're really creating a class. If so, allocate the + * class structure as well. + */ + + if (TclOOIsReachable(fPtr->classCls, classPtr)) { + /* + * Is a class, so attach a class structure. Note that the AllocClass + * function splices the structure into the object, so we don't have + * to. Once that's done, we need to repatch the object to have the + * right class since AllocClass interferes with that. + */ + + AllocClass(interp, oPtr); + oPtr->selfCls = classPtr; + TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); + } else { + oPtr->classPtr = NULL; + } + return oPtr; +} + + + static int FinalizeAlloc( ClientData data[], diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 11ba698..83b4d58 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -495,6 +495,10 @@ MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip, Tcl_Object *objectPtr); +MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, + Class *classPtr, + const char *nameStr, + const char *nsNameStr); MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr); MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr); MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr); -- cgit v0.12 From a8a602d3ffaf67e797df3e1a1e9a57124c43e267 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 27 Nov 2017 23:30:57 +0000 Subject: Eliminate some duplicate code in tclOO.c/Tcl_NewObjectInstance(). --- generic/tclOO.c | 39 ++++++++++----------------------------- 1 file changed, 10 insertions(+), 29 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 3fece42..07a96a7 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1606,6 +1606,7 @@ Tcl_NewObjectInstance( { register Class *classPtr = (Class *) cls; Object *oPtr; + ClientData clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) {return NULL;} @@ -1639,35 +1640,16 @@ Tcl_NewObjectInstance( TclResetRewriteEnsemble(interp, 1); } - /* - * Ensure an error if the object was deleted in the constructor. - * Don't want to lose errors by accident. [Bug 2903011] - */ + clientData[0] = contextPtr; + clientData[1] = oPtr; + clientData[2] = state; + clientData[3] = &oPtr; - if (result != TCL_ERROR && Deleted(oPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object deleted in constructor", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); - result = TCL_ERROR; - } - TclOODeleteContext(contextPtr); + AddRef(oPtr); + result = FinalizeAlloc(clientData, interp, result); if (result != TCL_OK) { - Tcl_DiscardInterpState(state); - - /* - * Take care to not delete a deleted object; that would be - * bad. [Bug 2903011] Also take care to make sure that we have - * the name of the command before we delete it. [Bug - * 9dd1bd7a74] - */ - - if (!Deleted(oPtr)) { - (void) TclOOObjectName(interp, oPtr); - Tcl_DeleteCommandFromToken(interp, oPtr->command); - } return NULL; } - Tcl_RestoreInterpState(interp, state); } } @@ -1726,7 +1708,7 @@ TclNRNewObjectInstance( contextPtr->skip = skip; /* - * Adjust the ensmble tracking record if necessary. [Bug 3514761] + * Adjust the ensemble tracking record if necessary. [Bug 3514761] */ if (TclInitRewriteEnsemble(interp, skip, skip, objv)) { @@ -1813,9 +1795,8 @@ FinalizeAlloc( Tcl_Object *objectPtr = data[3]; /* - * It's an error if the object was whacked in the constructor. Force this - * if it isn't already an error (don't want to lose errors by accident...) - * [Bug 2903011] + * Ensure an error if the object was deleted in the constructor. + * Don't want to lose errors by accident. [Bug 2903011] */ if (result != TCL_ERROR && Deleted(oPtr)) { -- cgit v0.12 From fe65a79d19b49f2cb167f72b3e422a71be69bead Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 28 Nov 2017 15:43:41 +0000 Subject: Minor refactoring of TclOO object reference count booking during object creation. --- generic/tclOO.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 07a96a7..d7ae349 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1678,11 +1678,6 @@ TclNRNewObjectInstance( Tcl_InterpState state; Object *oPtr; - /* - * Protect classPtr from getting cleaned up when the command is created. - */ - AddRef(classPtr); - oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) {return TCL_ERROR;} @@ -1693,13 +1688,11 @@ TclNRNewObjectInstance( if (objc < 0) { *objectPtr = (Tcl_Object) oPtr; - DelRef(classPtr); return TCL_OK; } contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL); if (contextPtr == NULL) { *objectPtr = (Tcl_Object) oPtr; - DelRef(classPtr); return TCL_OK; } @@ -1723,7 +1716,6 @@ TclNRNewObjectInstance( TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); TclPushTailcallPoint(interp); - DelRef(classPtr); return TclOOInvokeContext(contextPtr, interp, objc, objv); } @@ -1755,7 +1747,15 @@ TclNewObjectInstanceCommon( * Create the object. */ + /* + * The command for the object could have the same name as the command + * associated with classPtr, so protect the structure from deallocation + * here. + */ + AddRef(classPtr); + oPtr = AllocObject(interp, nameStr, nsNameStr); + DelRef(classPtr); oPtr->selfCls = classPtr; TclOOAddToInstances(oPtr, classPtr); -- cgit v0.12 From 8396e878da979c46691b73731c51888f05e7bb77 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 28 Nov 2017 23:33:14 +0000 Subject: Fix for issue [6cf568a21b]: Tcl_Eval() causes new segfault (TclOO object creation by qualified name). --- generic/tclOO.c | 60 +++++++++++++++++++++++++++++++-------------------------- tests/oo.test | 3 +++ 2 files changed, 36 insertions(+), 27 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index d7ae349..93abf3f 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -59,7 +59,7 @@ static const struct { static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj); static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, - const char *nsNameStr); + Namespace *nsPtr, const char *nsNameStr); static void ClearMixins(Class *clsPtr); static void ClearSuperclasses(Class *clsPtr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, @@ -380,9 +380,9 @@ InitFoundation( */ fPtr->objectCls = AllocClass(interp, - AllocObject(interp, "::oo::object", NULL)); + AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); fPtr->classCls = AllocClass(interp, - AllocObject(interp, "::oo::class", NULL)); + AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; @@ -552,6 +552,8 @@ AllocObject( * if the OO system should pick the object * name itself (equal to the namespace * name). */ + Namespace *nsPtr, /* The namespace to create the object in, + or NULL if *nameStr is NULL */ const char *nsNameStr) /* The name of the namespace to create, or * NULL if the OO system should pick a unique * name itself. If this is non-NULL but names @@ -562,10 +564,7 @@ AllocObject( Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - Namespace *nsPtr, *altNsPtr, *cxtNsPtr; - Tcl_Namespace *inNsPtr; int creationEpoch, ignored; - const char *simpleName; oPtr = ckalloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); @@ -653,17 +652,11 @@ AllocObject( * command is deleted). */ - if (nameStr) { - inNsPtr = TclGetCurrentNamespace(interp); - } else { + if (!nameStr) { nameStr = oPtr->namespacePtr->name; - inNsPtr = oPtr->namespacePtr; + nsPtr = (Namespace *)oPtr->namespacePtr; } - - TclGetNamespaceForQualName(interp, nameStr, (Namespace *) inNsPtr, 0, - &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); - - oPtr->command = TclCreateObjCommandInNs(interp, simpleName, + oPtr->command = TclCreateObjCommandInNs(interp, nameStr, (Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL); /* @@ -1528,7 +1521,7 @@ AllocClass( memset(clsPtr, 0, sizeof(Class)); if (useThisObj == NULL) { - clsPtr->thisPtr = AllocObject(interp, NULL, NULL); + clsPtr->thisPtr = AllocObject(interp, NULL, NULL, NULL); } else { clsPtr->thisPtr = useThisObj; } @@ -1727,20 +1720,33 @@ TclNewObjectInstanceCommon( const char *nameStr, const char *nsNameStr) { + Tcl_HashEntry *hPtr; Foundation *fPtr = GetFoundation(interp); Object *oPtr; + const char *simpleName = NULL; + Namespace *nsPtr = NULL, *dummy, + *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); + int isNew; - /* - * Disallow creation of an object over an existing command. - */ + if (nameStr) { + TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN, + &nsPtr, &dummy, &dummy, &simpleName); - if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, - TCL_NAMESPACE_ONLY)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create object \"%s\": command already exists with" - " that name", nameStr)); - Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); - return NULL; + /* + * Disallow creation of an object over an existing command. + */ + + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew); + if (isNew) { + /* Just kidding */ + Tcl_DeleteHashEntry(hPtr); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create object \"%s\": command already exists with" + " that name", nameStr)); + Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); + return NULL; + } } /* @@ -1754,7 +1760,7 @@ TclNewObjectInstanceCommon( */ AddRef(classPtr); - oPtr = AllocObject(interp, nameStr, nsNameStr); + oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); DelRef(classPtr); oPtr->selfCls = classPtr; TclOOAddToInstances(oPtr, classPtr); diff --git a/tests/oo.test b/tests/oo.test index b6af1ee..c44ec18 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -128,6 +128,9 @@ test oo-1.3 {basic test of OO functionality: no classes} { test oo-1.4 {basic test of OO functionality} -body { oo::object create {} } -returnCodes 1 -result {object name must not be empty} +test oo-1.4.1 {fully-qualified nested name} -body { + oo::object create ::one::two::three +} -result {::one::two::three} test oo-1.5 {basic test of OO functionality} -body { oo::object doesnotexist } -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new} -- cgit v0.12 From 3af16acbcb63ea2935d71b905371252560dc4659 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Nov 2017 08:59:49 +0000 Subject: Treat invalid UTF-8 characters in the range 0x80-0x9F as cp1252: See [https://en.wikipedia.org/wiki/UTF-8]. To be added to TIP #389 --- doc/Utf.3 | 3 +++ generic/tclInt.h | 2 +- generic/tclUtf.c | 17 +++++++++++++++-- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/doc/Utf.3 b/doc/Utf.3 index 638f349..de9545d 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -140,6 +140,9 @@ number of bytes read from \fIsrc\fR. The caller must ensure that the source buffer is long enough such that this routine does not run off the end and dereference non-existent or random memory; if the source buffer is known to be null-terminated, this will not happen. If the input is +a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the +cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR +and returns 1. If the input is otherwise not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and 0x00ff and return 1. diff --git a/generic/tclInt.h b/generic/tclInt.h index ef88bf5..d77889e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4446,7 +4446,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclUtfToUniChar(str, chPtr) \ - ((((unsigned char) *(str)) < 0xC0) ? \ + ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 4ed201f..aed332f 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -272,6 +272,13 @@ Tcl_UniCharToUtfDString( *--------------------------------------------------------------------------- */ +static const unsigned short cp1252[32] = { + 0x20ac, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021, + 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F, + 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, + 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 +}; + int Tcl_UtfToUniChar( register const char *src, /* The UTF-8 string. */ @@ -288,11 +295,17 @@ Tcl_UtfToUniChar( if (byte < 0xC0) { /* * Handles properly formed UTF-8 characters between 0x01 and 0x7F. - * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid + * Treats naked trail bytes 0x80 to 0x9F as valid characters from + * the cp1252 table. See: + * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid * characters representing themselves. */ - *chPtr = (Tcl_UniChar) byte; + if ((unsigned)(byte-0x80) < (unsigned) 0x20) { + *chPtr = (Tcl_UniChar) cp1252[byte-0x80]; + } else { + *chPtr = (Tcl_UniChar) byte; + } return 1; } else if (byte < 0xE0) { if ((src[1] & 0xC0) == 0x80) { -- cgit v0.12 From 03c66864aa2ffa9871ce216b00cd661eaf1be688 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Nov 2017 09:49:31 +0000 Subject: Fix [8e1e31eac0fd6b6c4452bc108a98ab08c6b64588|8e1e31eac0]: lsort treats NUL chars strangely --- generic/tclCmdIL.c | 4 +-- generic/tclCmdMZ.c | 2 +- generic/tclInt.h | 1 + generic/tclUtf.c | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++--- 4 files changed, 80 insertions(+), 6 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 47076ec..b41d312 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2945,7 +2945,7 @@ Tcl_LsearchObjCmd( double patDouble, objDouble; SortInfo sortInfo; Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr; - SortStrCmpFn_t strCmpFn = strcmp; + SortStrCmpFn_t strCmpFn = TclUtfCmp; Tcl_RegExp regexp = NULL; static const char *const options[] = { "-all", "-ascii", "-bisect", "-decreasing", "-dictionary", @@ -4263,7 +4263,7 @@ SortCompare( int order = 0; if (infoPtr->sortMode == SORTMODE_ASCII) { - order = strcmp(elemPtr1->collationKey.strValuePtr, + order = TclUtfCmp(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) { order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ad1dd5f..a206cc5 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3547,7 +3547,7 @@ TclNRSwitchObjCmd( OPT_LAST }; typedef int (*strCmpFn_t)(const char *, const char *); - strCmpFn_t strCmpFn = strcmp; + strCmpFn_t strCmpFn = TclUtfCmp; mode = OPT_EXACT; foundmode = 0; diff --git a/generic/tclInt.h b/generic/tclInt.h index d77889e..ad1d9c6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3219,6 +3219,7 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); +MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCount(int ch); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); diff --git a/generic/tclUtf.c b/generic/tclUtf.c index aed332f..aff10c1 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1108,6 +1108,15 @@ Tcl_UtfNcmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); +#if TCL_UTF_MAX == 4 + /* map high surrogate characters to values > 0xffff */ + if ((ch1 & 0xFC00) == 0xD800) { + ch1 += 0x4000; + } + if ((ch2 & 0xFC00) == 0xD800) { + ch2 += 0x4000; + } +#endif if (ch1 != ch2) { return (ch1 - ch2); } @@ -1140,6 +1149,7 @@ Tcl_UtfNcasecmp( unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; + while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. @@ -1148,6 +1158,15 @@ Tcl_UtfNcasecmp( */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); +#if TCL_UTF_MAX == 4 + /* map high surrogate characters to values > 0xffff */ + if ((ch1 & 0xFC00) == 0xD800) { + ch1 += 0x4000; + } + if ((ch2 & 0xFC00) == 0xD800) { + ch2 += 0x4000; + } +#endif if (ch1 != ch2) { ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); @@ -1158,11 +1177,56 @@ Tcl_UtfNcasecmp( } return 0; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_UtfCmp -- + * + * Compare UTF chars of string cs to string ct case sensitively. + * Replacement for strcmp in Tcl core, in places where UTF-8 should + * be handled. + * + * Results: + * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclUtfCmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct) /* UTF string cs is compared to. */ +{ + Tcl_UniChar ch1 = 0, ch2 = 0; + + while (*cs && *ct) { + cs += TclUtfToUniChar(cs, &ch1); + ct += TclUtfToUniChar(ct, &ch2); +#if TCL_UTF_MAX == 4 + /* map high surrogate characters to values > 0xffff */ + if ((ch1 & 0xFC00) == 0xD800) { + ch1 += 0x4000; + } + if ((ch2 & 0xFC00) == 0xD800) { + ch2 += 0x4000; + } +#endif + if (ch1 != ch2) { + return ch1 - ch2; + } + } + return UCHAR(*cs) - UCHAR(*ct); +} + /* *---------------------------------------------------------------------- * - * Tcl_UtfNcasecmp -- + * TclUtfCasecmp -- * * Compare UTF chars of string cs to string ct case insensitively. * Replacement for strcasecmp in Tcl core, in places where UTF-8 should @@ -1182,11 +1246,20 @@ TclUtfCasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct) /* UTF string cs is compared to. */ { - while (*cs && *ct) { - Tcl_UniChar ch1 = 0, ch2 = 0; + Tcl_UniChar ch1 = 0, ch2 = 0; + while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); +#if TCL_UTF_MAX == 4 + /* map high surrogate characters to values > 0xffff */ + if ((ch1 & 0xFC00) == 0xD800) { + ch1 += 0x4000; + } + if ((ch2 & 0xFC00) == 0xD800) { + ch2 += 0x4000; + } +#endif if (ch1 != ch2) { ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); -- cgit v0.12 From c032f5043e88e8f54ac32f526413a3b62c9a20f4 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 29 Nov 2017 12:01:21 +0000 Subject: Fix for [6bca38d59b], TclOO segmentation fault cleaning up objects that that have mixed themselves into themselves. --- generic/tclOO.c | 128 ++++++++++++++++++++++++++++++++------------------------ tests/oo.test | 33 +++++++++++++-- 2 files changed, 103 insertions(+), 58 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 93abf3f..5404abc 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -913,28 +913,30 @@ ReleaseClassContents( } if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { - int j; - if (instancePtr->selfCls == clsPtr) { - instancePtr->flags |= CLASS_GONE; - } - for(j=0 ; jmixins.num ; j++) { - Class *mixin = instancePtr->mixins.list[j]; - Class *nextMixin = NULL; - if (mixin == clsPtr) { - if (j < instancePtr->mixins.num - 1) { - nextMixin = instancePtr->mixins.list[j+1]; - } - if (j == 0) { - instancePtr->mixins.num = 0; - instancePtr->mixins.list = NULL; - } else { - instancePtr->mixins.list[j-1] = nextMixin; + if (instancePtr != oPtr) { + int j; + if (instancePtr->selfCls == clsPtr) { + instancePtr->flags |= CLASS_GONE; + } + for(j=0 ; jmixins.num ; j++) { + Class *mixin = instancePtr->mixins.list[j]; + Class *nextMixin = NULL; + if (mixin == clsPtr) { + if (j < instancePtr->mixins.num - 1) { + nextMixin = instancePtr->mixins.list[j+1]; + } + if (j == 0) { + instancePtr->mixins.num = 0; + instancePtr->mixins.list = NULL; + } else { + instancePtr->mixins.list[j-1] = nextMixin; + } + instancePtr->mixins.num -= 1; } - instancePtr->mixins.num -= 1; } - } - if (instancePtr != NULL && !IsRoot(instancePtr)) { - AddRef(instancePtr); + if (instancePtr != NULL && !IsRoot(instancePtr)) { + AddRef(instancePtr); + } } } } @@ -944,13 +946,15 @@ ReleaseClassContents( */ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) { - if (!Deleted(mixinSubclassPtr->thisPtr)) { - Tcl_DeleteCommandFromToken(interp, - mixinSubclassPtr->thisPtr->command); + if (mixinSubclassPtr != clsPtr) { + if (!Deleted(mixinSubclassPtr->thisPtr)) { + Tcl_DeleteCommandFromToken(interp, + mixinSubclassPtr->thisPtr->command); + } + ClearMixins(mixinSubclassPtr); + DelRef(mixinSubclassPtr->thisPtr); + DelRef(mixinSubclassPtr); } - ClearMixins(mixinSubclassPtr); - DelRef(mixinSubclassPtr->thisPtr); - DelRef(mixinSubclassPtr); } if (clsPtr->mixinSubs.list != NULL) { ckfree(clsPtr->mixinSubs.list); @@ -985,19 +989,21 @@ ReleaseClassContents( if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { - if (instancePtr == NULL || IsRoot(instancePtr)) { - continue; - } - if (!Deleted(instancePtr)) { - Tcl_DeleteCommandFromToken(interp, instancePtr->command); - /* - * Tcl_DeleteCommandFromToken() may have done to whole - * job for us. Roll back and check again. - */ - i--; - continue; + if (instancePtr != oPtr) { + if (instancePtr == NULL || IsRoot(instancePtr)) { + continue; + } + if (!Deleted(instancePtr)) { + Tcl_DeleteCommandFromToken(interp, instancePtr->command); + /* + * Tcl_DeleteCommandFromToken() may have done to whole + * job for us. Roll back and check again. + */ + i--; + continue; + } + DelRef(instancePtr); } - DelRef(instancePtr); } } if (clsPtr->instances.list != NULL) { @@ -1084,6 +1090,10 @@ ReleaseClassContents( ckfree(clsPtr->variables.list); } + /* Tell oPtr that it's class is gone so that it doesn't try to remove + * itself from it's classe's list of instances + */ + oPtr->flags |= CLASS_GONE; DelRef(clsPtr); } @@ -1177,22 +1187,6 @@ ObjectNamespaceDeleted( } /* - * The class of objects needs some special care; if it is deleted (and - * we're not killing the whole interpreter) we force the delete of the - * class of classes now as well. Due to the incestuous nature of those two - * classes, if one goes the other must too and yet the tangle can - * sometimes not go away automatically; we force it here. [Bug 2962664] - */ - if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr) - && !Deleted(fPtr->classCls->thisPtr)) { - Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); - } - - if (oPtr->classPtr != NULL) { - ReleaseClassContents(interp, oPtr); - } - - /* * Splice the object out of its context. After this, we must *not* call * methods on the object. */ @@ -1202,7 +1196,7 @@ ObjectNamespaceDeleted( } FOREACH(mixinPtr, oPtr->mixins) { - if (mixinPtr) { + if (mixinPtr && mixinPtr != oPtr->classPtr) { TclOORemoveFromInstances(oPtr, mixinPtr); } } @@ -1251,6 +1245,30 @@ ObjectNamespaceDeleted( } /* + * Because an object can be a class that is an instance of itself, the + * A class object's class structure should only be cleaned after most of + * the cleanup on the object is done. + */ + + + /* + * The class of objects needs some special care; if it is deleted (and + * we're not killing the whole interpreter) we force the delete of the + * class of classes now as well. Due to the incestuous nature of those two + * classes, if one goes the other must too and yet the tangle can + * sometimes not go away automatically; we force it here. [Bug 2962664] + */ + if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr) + && !Deleted(fPtr->classCls->thisPtr)) { + Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); + } + + if (oPtr->classPtr != NULL) { + ReleaseClassContents(interp, oPtr); + } + + + /* * Delete the object structure itself. */ diff --git a/tests/oo.test b/tests/oo.test index c44ec18..556d529 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1501,7 +1501,7 @@ test oo-11.5 {OO: cleanup} { test oo-11.6 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances -} { +} -body { oo::class create obj1 ::oo::define obj1 {self mixin [self]} @@ -1509,12 +1509,14 @@ test oo-11.6 { ::oo::objdefine obj2 {mixin [self]} ::oo::copy obj2 obj3 - trace add command obj3 delete [list obj3 dying] + rename obj3 {} rename obj2 {} # No segmentation fault return done -} done +} -cleanup { + rename obj1 {} +} -result done test oo-12.1 {OO: filters} { oo::class create Aclass @@ -3867,6 +3869,31 @@ test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} } -cleanup { base destroy } -result {{c d e} {c d e}} +test oo-35.6 { + Bug : teardown of an object that is a class that is an instance of itself +} -setup { + oo::class create obj + + oo::copy obj obj1 obj1 + oo::objdefine obj1 { + mixin obj1 obj + } + oo::copy obj1 obj2 + oo::objdefine obj2 { + mixin obj2 obj1 + } +} -body { + rename obj2 {} + rename obj1 {} + # doesn't crash + return done +} -cleanup { + rename obj {} +} -result done + + + + test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object -- cgit v0.12 From 5a9014a650af70ba5c09763035dc589d05402700 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 29 Nov 2017 15:19:04 +0000 Subject: Follow header file conventions. --- generic/tclInt.h | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 85d2a14..7d5071f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2915,10 +2915,8 @@ MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); -Tcl_Namespace * TclEnsureNamespace( - Tcl_Interp *interp, +MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); - MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); -- cgit v0.12 From c47ba70f4545f7c961160a6beb0a466e3bfd5532 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 29 Nov 2017 18:35:51 +0000 Subject: Add TCL_CREATE_NS_IF_UNKNOWN back into Tcl_CreateEnsemble(). --- generic/tclEnsemble.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index c5ccd22..a981851 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -732,7 +732,6 @@ Tcl_CreateEnsemble( Tcl_Namespace *namespacePtr, int flags) { - Tcl_Obj *nameObj = NULL; Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr, *actualNsPtr; const char * simpleName; @@ -741,11 +740,8 @@ Tcl_CreateEnsemble( nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } - TclGetNamespaceForQualName(interp, name, nsPtr, 0, + TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName); - if (nameObj != NULL) { - TclDecrRefCount(nameObj); - } return TclCreateEnsembleInNs(interp, simpleName, (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags); } -- cgit v0.12 From 72998869a3be3534fec99499faabe2d1557d6bcb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Nov 2017 13:14:43 +0000 Subject: Fix [8e1e31eac0fd6b6c4452bc108a98ab08c6b64588|8e1e31eac0]: lsort treats NUL chars strangely. Also fix various initializations, which only make a difference when TCL_UTF_MAX == 4. Add new test-cases which demonstrate the fix. For TCL_UTF_MAX == 4, surrogates will now be handled as expected as well when sorting. --- doc/UniCharIsAlpha.3 | 2 +- generic/tclCmdIL.c | 4 +- generic/tclCmdMZ.c | 2 +- generic/tclInt.h | 3 +- generic/tclScan.c | 2 +- generic/tclStringObj.c | 10 ++--- generic/tclUtf.c | 103 +++++++++++++++++++++++++++++++++++-------------- generic/tclUtil.c | 10 ++--- tests/cmdIL.test | 13 +++++++ win/tclWinSerial.c | 2 +- 10 files changed, 105 insertions(+), 46 deletions(-) diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index 5ba3fc9..61490ed 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -48,7 +48,7 @@ int .SH ARGUMENTS .AS int ch .AP int ch in -The Tcl_UniChar to be examined. +The Unicode character to be examined. .BE .SH DESCRIPTION diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 47076ec..b41d312 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2945,7 +2945,7 @@ Tcl_LsearchObjCmd( double patDouble, objDouble; SortInfo sortInfo; Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr; - SortStrCmpFn_t strCmpFn = strcmp; + SortStrCmpFn_t strCmpFn = TclUtfCmp; Tcl_RegExp regexp = NULL; static const char *const options[] = { "-all", "-ascii", "-bisect", "-decreasing", "-dictionary", @@ -4263,7 +4263,7 @@ SortCompare( int order = 0; if (infoPtr->sortMode == SORTMODE_ASCII) { - order = strcmp(elemPtr1->collationKey.strValuePtr, + order = TclUtfCmp(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) { order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ad1dd5f..a206cc5 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3547,7 +3547,7 @@ TclNRSwitchObjCmd( OPT_LAST }; typedef int (*strCmpFn_t)(const char *, const char *); - strCmpFn_t strCmpFn = strcmp; + strCmpFn_t strCmpFn = TclUtfCmp; mode = OPT_EXACT; foundmode = 0; diff --git a/generic/tclInt.h b/generic/tclInt.h index ef88bf5..ad1d9c6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3219,6 +3219,7 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); +MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCount(int ch); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); @@ -4446,7 +4447,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclUtfToUniChar(str, chPtr) \ - ((((unsigned char) *(str)) < 0xC0) ? \ + ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) diff --git a/generic/tclScan.c b/generic/tclScan.c index 7f71262..e0798df 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -889,7 +889,7 @@ Tcl_ScanObjCmd( i = (int)sch; #if TCL_UTF_MAX == 4 if (!offset) { - offset = Tcl_UtfToUniChar(string, &sch); + offset = TclUtfToUniChar(string, &sch); i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); } #endif diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 547f7c6..b943095 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1869,20 +1869,20 @@ Tcl_AppendFormatToObj( } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG useWide = 1; #endif } else if ((format[1] == '3') && (format[2] == '2')) { format += (step + 2); - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); } else { format += step; - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); } } else if ((ch == 't') || (ch == 'z')) { format += step; - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG if (sizeof(size_t) > sizeof(int)) { useWide = 1; @@ -1890,7 +1890,7 @@ Tcl_AppendFormatToObj( #endif } else if ((ch == 'q') ||(ch == 'j')) { format += step; - step = Tcl_UtfToUniChar(format, &ch); + step = TclUtfToUniChar(format, &ch); #ifndef TCL_WIDE_INT_IS_LONG useWide = 1; #endif diff --git a/generic/tclUtf.c b/generic/tclUtf.c index a72394d..43636b4 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -720,8 +720,7 @@ Tcl_UniCharAtIndex( { Tcl_UniChar ch = 0; - while (index >= 0) { - index--; + while (index-- >= 0) { src += TclUtfToUniChar(src, &ch); } return ch; @@ -751,8 +750,7 @@ Tcl_UtfAtIndex( { Tcl_UniChar ch = 0; - while (index > 0) { - index--; + while (index-- > 0) { src += TclUtfToUniChar(src, &ch); } return src; @@ -1066,16 +1064,17 @@ Tcl_UtfNcmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { #if TCL_UTF_MAX == 4 - /* map high surrogate characters to values > 0xffff */ - if ((ch1 & 0xFC00) == 0xD800) { - ch1 += 0x4000; - } - if ((ch2 & 0xFC00) == 0xD800) { - ch2 += 0x4000; - } + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } #endif - if (ch1 != ch2) { return (ch1 - ch2); } } @@ -1116,16 +1115,17 @@ Tcl_UtfNcasecmp( */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { #if TCL_UTF_MAX == 4 - /* map high surrogate characters to values > 0xffff */ - if ((ch1 & 0xFC00) == 0xD800) { - ch1 += 0x4000; - } - if ((ch2 & 0xFC00) == 0xD800) { - ch2 += 0x4000; - } + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } #endif - if (ch1 != ch2) { ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { @@ -1135,6 +1135,52 @@ Tcl_UtfNcasecmp( } return 0; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_UtfCmp -- + * + * Compare UTF chars of string cs to string ct case sensitively. + * Replacement for strcmp in Tcl core, in places where UTF-8 should + * be handled. + * + * Results: + * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclUtfCmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct) /* UTF string cs is compared to. */ +{ + Tcl_UniChar ch1 = 0, ch2 = 0; + + while (*cs && *ct) { + cs += TclUtfToUniChar(cs, &ch1); + ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { +#if TCL_UTF_MAX == 4 + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } +#endif + return ch1 - ch2; + } + } + return UCHAR(*cs) - UCHAR(*ct); +} + /* *---------------------------------------------------------------------- @@ -1164,16 +1210,17 @@ TclUtfCasecmp( while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { #if TCL_UTF_MAX == 4 - /* map high surrogate characters to values > 0xffff */ - if ((ch1 & 0xFC00) == 0xD800) { - ch1 += 0x4000; - } - if ((ch2 & 0xFC00) == 0xD800) { - ch2 += 0x4000; - } + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } #endif - if (ch1 != ch2) { ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 8ebace5..51af016 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1665,6 +1665,7 @@ TclTrimRight( { const char *p = bytes + numBytes; int pInc; + Tcl_UniChar ch1 = 0, ch2 = 0; if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { Tcl_Panic("TclTrimRight works only on null-terminated strings"); @@ -1683,7 +1684,6 @@ TclTrimRight( */ do { - Tcl_UniChar ch1; const char *q = trim; int bytesLeft = numTrim; @@ -1695,7 +1695,6 @@ TclTrimRight( */ do { - Tcl_UniChar ch2; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -1745,6 +1744,7 @@ TclTrimLeft( int numTrim) /* ...and its length in bytes */ { const char *p = bytes; + Tcl_UniChar ch1 = 0, ch2 = 0; if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { Tcl_Panic("TclTrimLeft works only on null-terminated strings"); @@ -1763,7 +1763,6 @@ TclTrimLeft( */ do { - Tcl_UniChar ch1; int pInc = TclUtfToUniChar(p, &ch1); const char *q = trim; int bytesLeft = numTrim; @@ -1773,7 +1772,6 @@ TclTrimLeft( */ do { - Tcl_UniChar ch2; int qInc = TclUtfToUniChar(q, &ch2); if (ch1 == ch2) { @@ -2107,7 +2105,7 @@ Tcl_StringCaseMatch( { int p, charLen; const char *pstart = pattern; - Tcl_UniChar ch1, ch2; + Tcl_UniChar ch1 = 0, ch2 = 0; while (1) { p = *pattern; @@ -2217,7 +2215,7 @@ Tcl_StringCaseMatch( */ if (p == '[') { - Tcl_UniChar startChar, endChar; + Tcl_UniChar startChar = 0, endChar = 0; pattern++; if (UCHAR(*str) < 0x80) { diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 70ac6bb..df59e6e 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -19,6 +19,7 @@ catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] +testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort @@ -147,6 +148,18 @@ test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} { {{b i g} 12345} {{d e m o} 34512} } } {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}} +test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { + lsort -ascii [list \0 \x7f \x80 \uffff] +} [list \0 \x7f \x80 \uffff] +test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { + lsort -ascii -nocase [list \0 \x7f \x80 \uffff] +} [list \0 \x7f \x80 \uffff] +test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} fullutf { + lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff] +} [list \0 \x7f \x80 \uffff \U01ffff] +test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} fullutf { + lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff] +} [list \0 \x7f \x80 \uffff \U01ffff] # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index ed1a8e5..acfeecb 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1738,7 +1738,7 @@ SerialSetOptionProc( dcb.XonChar = argv[0][0]; dcb.XoffChar = argv[1][0]; if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { - Tcl_UniChar character; + Tcl_UniChar character = 0; int charLen; charLen = Tcl_UtfToUniChar(argv[0], &character); -- cgit v0.12 From 9dd792a540427e3171555bc127aaa24f565a5cda Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Nov 2017 14:48:03 +0000 Subject: 8.[67] -> 9.0 in a few more places --- README | 6 +++--- doc/InitStubs.3 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/README b/README index 2a3b597..2431357 100644 --- a/README +++ b/README @@ -49,7 +49,7 @@ and selling it either in whole or in part. See the file Extensive documentation is available at our website. The home page for this release, including new features, is - http://www.tcl.tk/software/tcltk/8.7.html + http://www.tcl.tk/software/tcltk/9.0.html Detailed release notes can be found at the file distributions page by clicking on the relevant version. @@ -61,9 +61,9 @@ Information about Tcl itself can be found at There have been many Tcl books on the market. Many are mentioned in the Wiki: http://wiki.tcl.tk/_/ref?N=25206 -To view the complete set of reference manual entries for Tcl 8.7 online, +To view the complete set of reference manual entries for Tcl 9.0 online, visit the URL: - http://www.tcl.tk/man/tcl8.7/ + http://www.tcl.tk/man/tcl9.0/ 2a. Unix Documentation ---------------------- diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 4423666..20105fe 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard -Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms, -the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the -library name is \fItclstub86.lib\fR. +Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms, +the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the +library name is \fItclstub90.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link -- cgit v0.12 From 99798b2202f0a40a22c5d5e2d457759a5526005a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Nov 2017 15:24:39 +0000 Subject: Fix build of test-suite, after previous commit --- generic/tclIntDecls.h | 63 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 51 insertions(+), 12 deletions(-) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index f2654c0..c3ee084 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -1354,31 +1354,70 @@ extern const TclIntStubs *tclIntStubsPtr; # undef TclSetStartupScript # undef TclGetStartupScript # undef TclCreateNamespace -# define tcl_CreateNamespace tclCreateNamespace # undef TclDeleteNamespace -# define tcl_DeleteNamespace tclDeleteNamespace # undef TclAppendExportList -# define tcl_AppendExportList tclAppendExportList # undef TclExport -# define tcl_Export tclExport # undef TclImport -# define tcl_Import tclImport # undef TclForgetImport -# define tcl_ForgetImport tclForgetImport # undef TclGetCurrentNamespace_ -# define tcl_GetCurrentNamespace tclGetCurrentNamespace_ # undef TclGetGlobalNamespace_ -# define tcl_GetGlobalNamespace tclGetGlobalNamespace_ # undef TclFindNamespace -# define tcl_FindNamespace tclFindNamespace # undef TclFindCommand -# define tcl_FindCommand tclFindCommand # undef TclGetCommandFromObj -# define tcl_GetCommandFromObj tclGetCommandFromObj # undef TclGetCommandFullName -# define tcl_GetCommandFullName tclGetCommandFullName # undef TclCopyChannelOld # undef TclSockMinimumBuffersOld + +#if !defined(TCL_NO_DEPRECATED) +# undef Tcl_CreateNamespace +# define Tcl_CreateNamespace \ + (tclIntStubsPtr->tclCreateNamespace) /* 113 */ +# define tcl_CreateNamespace tclCreateNamespace +# undef Tcl_DeleteNamespace +# define Tcl_DeleteNamespace \ + (tclIntStubsPtr->tclDeleteNamespace) /* 114 */ +# define tcl_DeleteNamespace tclDeleteNamespace +# undef Tcl_AppendExportList +# define Tcl_AppendExportList \ + (tclIntStubsPtr->tclAppendExportList) /* 112 */ +# define tcl_AppendExportList tclAppendExportList +# undef Tcl_Export +# define Tcl_Export \ + (tclIntStubsPtr->tclExport) /* 115 */ +# define tcl_Export tclExport +# undef Tcl_Import +# define Tcl_Import \ + (tclIntStubsPtr->tclImport) /* 127 */ +# define tcl_Import tclImport +# undef Tcl_ForgetImport +# define Tcl_ForgetImport \ + (tclIntStubsPtr->tclForgetImport) /* 121 */ +# define tcl_ForgetImport tclForgetImport +# undef Tcl_GetCurrentNamespace +# define Tcl_GetCurrentNamespace \ + (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */ +# define tcl_GetCurrentNamespace tclGetCurrentNamespace_ +# undef Tcl_GetGlobalNamespace +# define Tcl_GetGlobalNamespace \ + (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */ +# define tcl_GetGlobalNamespace tclGetGlobalNamespace_ +# undef Tcl_FindNamespace +# define Tcl_FindNamespace \ + (tclIntStubsPtr->tclFindNamespace) /* 117 */ +# define tcl_FindNamespace tclFindNamespace +# undef Tcl_FindCommand +# define Tcl_FindCommand \ + (tclIntStubsPtr->tclFindCommand) /* 116 */ +# define tcl_FindCommand tclFindCommand +# undef Tcl_GetCommandFromObj +# define Tcl_GetCommandFromObj \ + (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */ +# define tcl_GetCommandFromObj tclGetCommandFromObj +# undef Tcl_GetCommandFullName +# define Tcl_GetCommandFullName \ + (tclIntStubsPtr->tclGetCommandFullName) /* 123 */ +# define tcl_GetCommandFullName tclGetCommandFullName +#endif /* !defined(TCL_NO_DEPRECATED) */ #endif #endif /* _TCLINTDECLS */ -- cgit v0.12 From 0efada5548249fb9f61dcd3a5eea4ceb381e3e52 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Nov 2017 16:03:01 +0000 Subject: Eliminate use of certain unnecessary struct names. Also white-spacing. Nothing functional. --- generic/tclEncoding.c | 8 ++++---- generic/tclEnsemble.c | 10 +++++----- generic/tclIORTrans.c | 6 +++--- generic/tclIOUtil.c | 2 +- generic/tclOO.c | 6 +++--- tests/oo.test | 4 ++-- 6 files changed, 18 insertions(+), 18 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1f48a1c..e1e26d3 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src); * convert between various character sets and UTF-8. */ -typedef struct Encoding { +typedef struct { char *name; /* Name of encoding. Malloced because (1) hash * table entry that owns this encoding may be * freed prior to this encoding being freed, @@ -57,7 +57,7 @@ typedef struct Encoding { * encoding. */ -typedef struct TableEncodingData { +typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ @@ -91,7 +91,7 @@ typedef struct TableEncodingData { * for switching character sets. */ -typedef struct EscapeSubTable { +typedef struct { unsigned sequenceLen; /* Length of following string. */ char sequence[16]; /* Escape code that marks this encoding. */ char name[32]; /* Name for encoding. */ @@ -100,7 +100,7 @@ typedef struct EscapeSubTable { * yet. */ } EscapeSubTable; -typedef struct EscapeEncodingData { +typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index a981851..972c33e 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -649,12 +649,12 @@ TclNamespaceEnsembleCmd( Tcl_Command TclCreateEnsembleInNs( - Tcl_Interp *interp, - + Tcl_Interp *interp, + const char *name, /* Simple name of command to create (no */ /* namespace components). */ - Tcl_Namespace /* Name of namespace to create the command in. */ - *nameNsPtr, + Tcl_Namespace /* Name of namespace to create the command in. */ + *nameNsPtr, Tcl_Namespace *ensembleNsPtr, /* Name of the namespace for the ensemble. */ int flags @@ -2591,7 +2591,7 @@ BuildEnsembleConfig( if (ensemblePtr->subcmdList == ensemblePtr->subcommandDict) { subcmdDictCopy = Tcl_DuplicateObj(ensemblePtr->subcommandDict); } else { - subcmdDictCopy = ensemblePtr->subcommandDict; + subcmdDictCopy = ensemblePtr->subcommandDict; } Tcl_IncrRefCount(subcmdDictCopy); } diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index f198c69..fe2e458 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = { * layers upon reading from the channel, plus the functions to manage such. */ -typedef struct _ResultBuffer_ { +typedef struct { unsigned char *buf; /* Reference to the buffer area. */ int allocated; /* Allocated size of the buffer area. */ int used; /* Number of bytes in the buffer, @@ -253,7 +253,7 @@ typedef enum { * sharing problems. */ -typedef struct ForwardParamBase { +typedef struct { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if @@ -298,7 +298,7 @@ typedef struct ForwardingResult ForwardingResult; * General event structure, with reference to operation specific data. */ -typedef struct ForwardingEvent { +typedef struct { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 4f2288e..8fb3aa8 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -245,7 +245,7 @@ static Tcl_ThreadDataKey fsDataKey; * code. */ -typedef struct FsDivertLoad { +typedef struct { Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *divertedFile; diff --git a/generic/tclOO.c b/generic/tclOO.c index 5404abc..84380e0 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1091,8 +1091,8 @@ ReleaseClassContents( } /* Tell oPtr that it's class is gone so that it doesn't try to remove - * itself from it's classe's list of instances - */ + * itself from it's classe's list of instances + */ oPtr->flags |= CLASS_GONE; DelRef(clsPtr); @@ -1247,7 +1247,7 @@ ObjectNamespaceDeleted( /* * Because an object can be a class that is an instance of itself, the * A class object's class structure should only be cleaned after most of - * the cleanup on the object is done. + * the cleanup on the object is done. */ diff --git a/tests/oo.test b/tests/oo.test index 556d529..b9c5067 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -129,7 +129,7 @@ test oo-1.4 {basic test of OO functionality} -body { oo::object create {} } -returnCodes 1 -result {object name must not be empty} test oo-1.4.1 {fully-qualified nested name} -body { - oo::object create ::one::two::three + oo::object create ::one::two::three } -result {::one::two::three} test oo-1.5 {basic test of OO functionality} -body { oo::object doesnotexist @@ -3889,7 +3889,7 @@ test oo-35.6 { return done } -cleanup { rename obj {} -} -result done +} -result done -- cgit v0.12 From 1a237e67df1f72fce66636d7efcd7cffa82bd0b8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Dec 2017 10:38:04 +0000 Subject: Simpler solution for Itcl 3.4 build (compatibilty) problem. Thanks to Don Porter for bringing this to my attention! --- generic/tclIntDecls.h | 67 ++++++++++++--------------------------------------- 1 file changed, 16 insertions(+), 51 deletions(-) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index c3ee084..5848bb3 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -28,6 +28,22 @@ # endif #endif +#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) +/* Those macro's are especially for Itcl 3.4 compatibility */ +# define tclCreateNamespace tcl_CreateNamespace +# define tclDeleteNamespace tcl_DeleteNamespace +# define tclAppendExportList tcl_AppendExportList +# define tclExport tcl_Export +# define tclImport tcl_Import +# define tclForgetImport tcl_ForgetImport +# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace +# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace +# define tclFindNamespace tcl_FindNamespace +# define tclFindCommand tcl_FindCommand +# define tclGetCommandFromObj tcl_GetCommandFromObj +# define tclGetCommandFullName tcl_GetCommandFullName +#endif /* !defined(TCL_NO_DEPRECATED) */ + /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -1367,57 +1383,6 @@ extern const TclIntStubs *tclIntStubsPtr; # undef TclGetCommandFullName # undef TclCopyChannelOld # undef TclSockMinimumBuffersOld - -#if !defined(TCL_NO_DEPRECATED) -# undef Tcl_CreateNamespace -# define Tcl_CreateNamespace \ - (tclIntStubsPtr->tclCreateNamespace) /* 113 */ -# define tcl_CreateNamespace tclCreateNamespace -# undef Tcl_DeleteNamespace -# define Tcl_DeleteNamespace \ - (tclIntStubsPtr->tclDeleteNamespace) /* 114 */ -# define tcl_DeleteNamespace tclDeleteNamespace -# undef Tcl_AppendExportList -# define Tcl_AppendExportList \ - (tclIntStubsPtr->tclAppendExportList) /* 112 */ -# define tcl_AppendExportList tclAppendExportList -# undef Tcl_Export -# define Tcl_Export \ - (tclIntStubsPtr->tclExport) /* 115 */ -# define tcl_Export tclExport -# undef Tcl_Import -# define Tcl_Import \ - (tclIntStubsPtr->tclImport) /* 127 */ -# define tcl_Import tclImport -# undef Tcl_ForgetImport -# define Tcl_ForgetImport \ - (tclIntStubsPtr->tclForgetImport) /* 121 */ -# define tcl_ForgetImport tclForgetImport -# undef Tcl_GetCurrentNamespace -# define Tcl_GetCurrentNamespace \ - (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */ -# define tcl_GetCurrentNamespace tclGetCurrentNamespace_ -# undef Tcl_GetGlobalNamespace -# define Tcl_GetGlobalNamespace \ - (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */ -# define tcl_GetGlobalNamespace tclGetGlobalNamespace_ -# undef Tcl_FindNamespace -# define Tcl_FindNamespace \ - (tclIntStubsPtr->tclFindNamespace) /* 117 */ -# define tcl_FindNamespace tclFindNamespace -# undef Tcl_FindCommand -# define Tcl_FindCommand \ - (tclIntStubsPtr->tclFindCommand) /* 116 */ -# define tcl_FindCommand tclFindCommand -# undef Tcl_GetCommandFromObj -# define Tcl_GetCommandFromObj \ - (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */ -# define tcl_GetCommandFromObj tclGetCommandFromObj -# undef Tcl_GetCommandFullName -# define Tcl_GetCommandFullName \ - (tclIntStubsPtr->tclGetCommandFullName) /* 123 */ -# define tcl_GetCommandFullName tclGetCommandFullName -#endif /* !defined(TCL_NO_DEPRECATED) */ #endif #endif /* _TCLINTDECLS */ -- cgit v0.12 From ff91f80124907c2c578fa2ae3db6fb67dd4d3637 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Dec 2017 11:55:28 +0000 Subject: TIP 488: Remove tcl_precision --- doc/PrintDbl.3 | 9 +-- doc/tclvars.n | 66 +-------------------- generic/tcl.h | 4 +- generic/tclBasic.c | 3 - generic/tclInt.decls | 9 +-- generic/tclIntDecls.h | 10 +--- generic/tclObj.c | 3 +- generic/tclStrToD.c | 7 +-- generic/tclStubInit.c | 2 +- generic/tclUtil.c | 157 +++----------------------------------------------- tests/basic.test | 8 +-- tests/util.test | 44 -------------- 12 files changed, 27 insertions(+), 295 deletions(-) diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3 index 896b6eb..42b258c 100644 --- a/doc/PrintDbl.3 +++ b/doc/PrintDbl.3 @@ -18,10 +18,7 @@ Tcl_PrintDouble \- Convert floating value to string .SH ARGUMENTS .AS Tcl_Interp *interp out .AP Tcl_Interp *interp in -Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter -controlled the conversion. As of Tcl 8.0, this argument is ignored and -the conversion is controlled by the \fBtcl_precision\fR variable -that is now shared by all interpreters. +This argument is ignored. .AP double value in Floating-point value to be converted. .AP char *dst out @@ -41,9 +38,7 @@ so that it does not look like an integer. Where \fB%g\fR would generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds .QW .0 . .PP -If the \fBtcl_precision\fR value is non-zero, the result will have -precisely that many digits of significance. If the value is zero -(the default), the result will have the fewest digits needed to +The result will have the fewest digits needed to represent the number in such a way that \fBTcl_NewDoubleObj\fR will generate the same number when presented with the given string. IEEE semantics of rounding to even apply to the conversion. diff --git a/doc/tclvars.n b/doc/tclvars.n index adefe40..42e9212 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl +argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl .BE .SH DESCRIPTION .PP @@ -356,70 +356,6 @@ This gives the size of the native-machine word in bytes (strictly, it is same as the result of evaluating \fIsizeof(long)\fR in C.) .RE .TP -\fBtcl_precision\fR -. -This variable controls the number of digits to generate -when converting floating-point values to strings. It defaults -to 0. \fIApplications should not change this value;\fR it is -provided for compatibility with legacy code. -.PP -.RS -The default value of 0 is special, meaning that Tcl should -convert numbers using as few digits as possible while still -distinguishing any floating point number from its nearest -neighbours. It differs from using an arbitrarily high value -for \fItcl_precision\fR in that an inexact number like \fI1.4\fR -will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR -even though the latter is nearer to the exact value of the -binary number. -.RE -.PP -.RS -If \fBtcl_precision\fR is not zero, then when Tcl converts a floating -point number, it creates a decimal representation of at most -\fBtcl_precision\fR significant digits; the result may be shorter if -the shorter result represents the original number exactly. If no -result of at most \fBtcl_precision\fR digits is an exact representation -of the original number, the one that is closest to the original -number is chosen. -If the original number lies precisely between two equally accurate -decimal representations, then the one with an even value for the least -significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then -0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to -0.688, not 0.687. Any string of trailing zeroes that remains is trimmed. -.RE -.PP -.RS -a \fBtcl_precision\fR value of 17 digits is -.QW perfect -for IEEE floating-point in that it allows -double-precision values to be converted to strings and back to -binary with no loss of information. For this reason, you will often -see it as a value in legacy code that must run on Tcl versions before -8.5. It is no longer recommended; as noted above, a zero value is the -preferred method. -.RE -.PP -.RS -All interpreters in a thread share a single \fBtcl_precision\fR value: -changing it in one interpreter will affect all other interpreters as -well. Safe interpreters are not allowed to modify the -variable. -.RE -.PP -.RS -Valid values for \fBtcl_precision\fR range from 0 to 17. -.RE -.TP -\fBtcl_rcFileName\fR -. -This variable is used during initialization to indicate the name of a -user-specific startup file. If it is set by application-specific -initialization, then the Tcl startup code will check for the existence -of this file and \fBsource\fR it if it exists. For example, for \fBwish\fR -the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR -for Windows. -.TP \fBtcl_traceCompile\fR . The value of this variable can be set to control diff --git a/generic/tcl.h b/generic/tcl.h index 8cc6825..688d678 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -948,8 +948,8 @@ typedef struct Tcl_DString { /* * Definitions for the maximum number of digits of precision that may be - * specified in the "tcl_precision" variable, and the number of bytes of - * buffer space required by Tcl_PrintDouble. + * produced by Tcl_PrintDouble, and the number of bytes of buffer space + * required by Tcl_PrintDouble. */ #define TCL_MAX_PREC 17 diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 67e5490..5a3472c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -937,9 +937,6 @@ Tcl_CreateInterp(void) Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); - Tcl_TraceVar2(interp, "tcl_precision", NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - TclPrecTraceProc, NULL); TclpSetVariables(interp); #ifdef TCL_THREADS diff --git a/generic/tclInt.decls b/generic/tclInt.decls index ad48007..7d9ff37 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -358,10 +358,11 @@ declare 81 { # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } -declare 88 { - char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, - const char *name1, const char *name2, int flags) -} +# Removed in 9.0: +#declare 88 { +# char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, +# const char *name1, const char *name2, int flags) +#} declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3a61f9c..4852101 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -210,10 +210,7 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size); /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -/* 88 */ -EXTERN char * TclPrecTraceProc(ClientData clientData, - Tcl_Interp *interp, const char *name1, - const char *name2, int flags); +/* Slot 88 is reserved */ /* 89 */ EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); @@ -677,7 +674,7 @@ typedef struct TclIntStubs { void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); - char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ + void (*reserved88)(void); int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ @@ -991,8 +988,7 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -#define TclPrecTraceProc \ - (tclIntStubsPtr->tclPrecTraceProc) /* 88 */ +/* Slot 88 is reserved */ #define TclPreventAliasLoop \ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */ /* Slot 90 is reserved */ diff --git a/generic/tclObj.c b/generic/tclObj.c index ab259c2..a19b2b0 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2349,8 +2349,7 @@ SetDoubleFromAny( * UpdateStringOfDouble -- * * Update the string representation for a double-precision floating point - * object. This must obey the current tcl_precision value for - * double-to-string conversions. Note: This function does not free an + * object. Note: This function does not free an * existing old string rep so storage will be lost if this has not * already been done. * diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 6502733..a26c361 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -3996,8 +3996,8 @@ StrictBignumConversion( * This function is a service routine that produces the string of digits for * floating-point-to-decimal conversion. It can do a number of things * according to the 'flags' argument. Valid values for 'flags' include: - * TCL_DD_SHORTEST - This is the default for floating point conversion if - * ::tcl_precision is 0. It constructs the shortest string of + * TCL_DD_SHORTEST - This is the default for floating point conversion. + * It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. @@ -4012,8 +4012,7 @@ StrictBignumConversion( * subsequent input conversion is 'round up' or 'round down' * rather than 'round to nearest', but is surprising otherwise. * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format - * conversion (or for default floating->string if tcl_precision - * is not 0). It constructs a string of at most 'ndigits' digits, + * conversion. It constructs a string of at most 'ndigits' digits, * choosing the one that is closest to the given number (and * resolving ties with 'round to even'). It is allowed to return * fewer than 'ndigits' if the number converts exactly; if the diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 5be129c..443bd63 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -376,7 +376,7 @@ static const TclIntStubs tclIntStubs = { 0, /* 85 */ 0, /* 86 */ 0, /* 87 */ - TclPrecTraceProc, /* 88 */ + 0, /* 88 */ TclPreventAliasLoop, /* 89 */ 0, /* 90 */ TclProcCleanupProc, /* 91 */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index bbf9466..efb51ca 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -94,13 +94,6 @@ static ProcessGlobalValue executableName = { #define CONVERT_ANY 16 /* - * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to - * access the precision to be used for double formatting. - */ - -static Tcl_ThreadDataKey precisionKey; - -/* * Prototypes for functions defined later in this file. */ @@ -3037,10 +3030,9 @@ Tcl_DStringEndSublist( * string using. * * Results: - * The ASCII equivalent of "value" is written at "dst". It is written - * using the current precision, and it is guaranteed to contain a decimal - * point or exponent, so that it looks like a floating-point value and - * not an integer. + * The ASCII equivalent of "value" is written at "dst". It is guaranteed + * to contain a decimal point or exponent, so that it looks like a + * floating-point value and not an integer. * * Side effects: * None. @@ -3050,9 +3042,7 @@ Tcl_DStringEndSublist( void Tcl_PrintDouble( - Tcl_Interp *interp, /* Interpreter whose tcl_precision variable - * used to be used to control printing. It's - * ignored now. */ + Tcl_Interp *interp, /* Not used */ double value, /* Value to print as string. */ char *dst) /* Where to store converted value; must have * at least TCL_DOUBLE_SPACE characters. */ @@ -3062,7 +3052,6 @@ Tcl_PrintDouble( int signum; char *digits; char *end; - int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. @@ -3094,53 +3083,8 @@ Tcl_PrintDouble( * Ordinary (normal and denormal) values. */ - if (*precisionPtr == 0) { - digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, - &exponent, &signum, &end); - } else { - /* - * There are at least two possible interpretations for tcl_precision. - * - * The first is, "choose the decimal representation having - * $tcl_precision digits of significance that is nearest to the given - * number, breaking ties by rounding to even, and then trimming - * trailing zeros." This gives the greatest possible precision in the - * decimal string, but offers the anomaly that [expr 0.1] will be - * "0.10000000000000001". - * - * The second is "choose the decimal representation having at most - * $tcl_precision digits of significance that is nearest to the given - * number. If no such representation converts exactly to the given - * number, choose the one that is closest, breaking ties by rounding - * to even. If more than one such representation converts exactly to - * the given number, choose the shortest, breaking ties in favour of - * the nearest, breaking remaining ties in favour of the one ending in - * an even digit." - * - * Tcl 8.4 implements the first of these, which gives rise to - * anomalies in formatting: - * - * % expr 0.1 - * 0.10000000000000001 - * % expr 0.01 - * 0.01 - * % expr 1e-7 - * 9.9999999999999995e-08 - * - * For human readability, it appears better to choose the second rule, - * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer - * the first (the recommended zero value for tcl_precision avoids the - * problem entirely). - * - * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the method - * that allows floating point values to be shortened if it can be done - * without loss of precision. - */ - - digits = TclDoubleDigits(value, *precisionPtr, - TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, - &exponent, &signum, &end); - } + digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, + &exponent, &signum, &end); if (signum) { *dst++ = '-'; } @@ -3160,16 +3104,7 @@ Tcl_PrintDouble( } } - /* - * Tcl 8.4 appears to format with at least a two-digit exponent; - * preserve that behaviour when tcl_precision != 0 - */ - - if (*precisionPtr == 0) { - sprintf(dst, "e%+d", exponent); - } else { - sprintf(dst, "e%+03d", exponent); - } + sprintf(dst, "e%+d", exponent); } else { /* * F format for others. @@ -3207,84 +3142,6 @@ Tcl_PrintDouble( /* *---------------------------------------------------------------------- * - * TclPrecTraceProc -- - * - * This function is invoked whenever the variable "tcl_precision" is - * written. - * - * Results: - * Returns NULL if all went well, or an error message if the new value - * for the variable doesn't make sense. - * - * Side effects: - * If the new value doesn't make sense then this function undoes the - * effect of the variable modification. Otherwise it modifies the format - * string that's used by Tcl_PrintDouble. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -char * -TclPrecTraceProc( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Name of variable. */ - const char *name2, /* Second part of variable name. */ - int flags) /* Information about what happened. */ -{ - Tcl_Obj *value; - int prec; - int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); - - /* - * If the variable is unset, then recreate the trace. - */ - - if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) { - Tcl_TraceVar2(interp, name1, name2, - TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES - |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); - } - return NULL; - } - - /* - * When the variable is read, reset its value from our shared value. This - * is needed in case the variable was modified in some other interpreter - * so that this interpreter's value is out of date. - */ - - - if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr), - flags & TCL_GLOBAL_ONLY); - return NULL; - } - - /* - * The variable is being written. Check the new value and disallow it if - * it isn't reasonable or if this is a safe interpreter (we don't want - * safe interpreters messing up the precision of other interpreters). - */ - - if (Tcl_IsSafe(interp)) { - return (char *) "can't modify precision from a safe interpreter"; - } - value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); - if (value == NULL - || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK - || prec < 0 || prec > TCL_MAX_PREC) { - return (char *) "improper value for precision"; - } - *precisionPtr = prec; - return NULL; -} - -/* - *---------------------------------------------------------------------- - * * TclNeedSpace -- * * This function checks to see whether it is appropriate to add a space diff --git a/tests/basic.test b/tests/basic.test index 7819241..a11ffdf 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -893,10 +893,7 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup { rename stress {} } -result 0 -test basic-48.17.$noComp {expansion: object safety} -setup { - set old_precision $::tcl_precision - set ::tcl_precision 4 - } -constraints $constraints -body { +test basic-48.17.$noComp {expansion: object safety} -constraints $constraints -body { set third [expr {1.0/3.0}] set l [list $third $third] set x [run {list $third {*}$l $third}] @@ -906,8 +903,7 @@ test basic-48.17.$noComp {expansion: object safety} -setup { } set res } -cleanup { - set ::tcl_precision $old_precision - unset old_precision res t l x third + unset res t l x third } -result {1.0 1.0 1.0 1.0} test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -body { diff --git a/tests/util.test b/tests/util.test index 35fc642..5fd2102 100644 --- a/tests/util.test +++ b/tests/util.test @@ -424,50 +424,6 @@ test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr 3.0e98] } {x3e+98} -test util-7.1 {TclPrecTraceProc - unset callbacks} -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 7 - set x $tcl_precision - unset tcl_precision - list $x $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {7 7} -test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 12 - interp create child - set x [child eval set tcl_precision] - child eval {set tcl_precision 6} - interp delete child - list $x $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {12 6} -test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 12 - interp create -safe child - set x [child eval { - list [catch {set tcl_precision 8} msg] $msg - }] - interp delete child - list $x $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12} -test util-7.4 {TclPrecTraceProc - write traces, bogus values} -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 12 - list [catch {set tcl_precision abc} msg] $msg $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {1 {can't set "tcl_precision": improper value for precision} 12} - # This test always succeeded in the C locale anyway... test util-8.1 {TclNeedSpace - correct UTF8 handling} { # Bug 411825 -- cgit v0.12 From 0bd09c41062b3c0f5831b8ac4355a235366a93d7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Dec 2017 12:24:25 +0000 Subject: remove many test-cases related to tcl_precision --- tests/util.test | 1903 ------------------------------------------------------- 1 file changed, 1903 deletions(-) diff --git a/tests/util.test b/tests/util.test index 5fd2102..9d4c57e 100644 --- a/tests/util.test +++ b/tests/util.test @@ -385,38 +385,6 @@ test util-5.51 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch "" "" } 1 -test util-6.1 {Tcl_PrintDouble - using tcl_precision} -setup { - set old_precision $::tcl_precision - set ::tcl_precision 12 -} -body { - concat x[expr 1.4] -} -cleanup { - set ::tcl_precision $old_precision -} -result {x1.4} -test util-6.2 {Tcl_PrintDouble - using tcl_precision} -setup { - set old_precision $::tcl_precision - set ::tcl_precision 12 -} -body { - concat x[expr 1.39999999999] -} -cleanup { - set ::tcl_precision $old_precision -} -result {x1.39999999999} -test util-6.3 {Tcl_PrintDouble - using tcl_precision} -setup { - set old_precision $::tcl_precision - set ::tcl_precision 12 -} -body { - concat x[expr 1.399999999999] -} -cleanup { - set ::tcl_precision $old_precision -} -result {x1.4} -test util-6.4 {Tcl_PrintDouble - using tcl_precision} -setup { - set old_precision $::tcl_precision - set ::tcl_precision 5 -} -body { - concat x[expr 1.123412341234] -} -cleanup { - set tcl_precision $old_precision -} -result {x1.1234} test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr 2.0] } {x2.0} @@ -2094,1875 +2062,6 @@ test util-15.8 {smallest normal} {*}{ } } -set saved_precision $::tcl_precision -foreach ::tcl_precision {0 12} { - for {set e -312} {$e < -9} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr 1.1e$e" 1.1e$e - } -} -set tcl_precision 0 -for {set e -9} {$e < -4} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr 1.1e$e" 1.1e$e -} -set tcl_precision 12 -for {set e -9} {$e < -4} {incr e} { - test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} \ - "expr 1.1e$e" 1.1e[format %+03d $e] -} -foreach ::tcl_precision {0 12} { - test util-16.1.$::tcl_precision.-4 {shortening of numbers} \ - {expr 1.1e-4} \ - 0.00011 - test util-16.1.$::tcl_precision.-3 {shortening of numbers} \ - {expr 1.1e-3} \ - 0.0011 - test util-16.1.$::tcl_precision.-2 {shortening of numbers} \ - {expr 1.1e-2} \ - 0.011 - test util-16.1.$::tcl_precision.-1 {shortening of numbers} \ - {expr 1.1e-1} \ - 0.11 - test util-16.1.$::tcl_precision.0 {shortening of numbers} \ - {expr 1.1} \ - 1.1 - for {set e 1} {$e < 17} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr 11[string repeat 0 [expr {$e-1}]].0" \ - 11[string repeat 0 [expr {$e-1}]].0 - } - for {set e 17} {$e < 309} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr 1.1e$e" 1.1e+$e - } -} -set tcl_precision 17 -test util-16.1.17.-300 {8.4 compatible formatting of doubles} \ - {expr 1e-300} \ - 1e-300 -test util-16.1.17.-299 {8.4 compatible formatting of doubles} \ - {expr 1e-299} \ - 9.9999999999999999e-300 -test util-16.1.17.-298 {8.4 compatible formatting of doubles} \ - {expr 1e-298} \ - 9.9999999999999991e-299 -test util-16.1.17.-297 {8.4 compatible formatting of doubles} \ - {expr 1e-297} \ - 1e-297 -test util-16.1.17.-296 {8.4 compatible formatting of doubles} \ - {expr 1e-296} \ - 1e-296 -test util-16.1.17.-295 {8.4 compatible formatting of doubles} \ - {expr 1e-295} \ - 1.0000000000000001e-295 -test util-16.1.17.-294 {8.4 compatible formatting of doubles} \ - {expr 1e-294} \ - 1e-294 -test util-16.1.17.-293 {8.4 compatible formatting of doubles} \ - {expr 1e-293} \ - 1.0000000000000001e-293 -test util-16.1.17.-292 {8.4 compatible formatting of doubles} \ - {expr 1e-292} \ - 1.0000000000000001e-292 -test util-16.1.17.-291 {8.4 compatible formatting of doubles} \ - {expr 1e-291} \ - 9.9999999999999996e-292 -test util-16.1.17.-290 {8.4 compatible formatting of doubles} \ - {expr 1e-290} \ - 1.0000000000000001e-290 -test util-16.1.17.-289 {8.4 compatible formatting of doubles} \ - {expr 1e-289} \ - 1e-289 -test util-16.1.17.-288 {8.4 compatible formatting of doubles} \ - {expr 1e-288} \ - 1.0000000000000001e-288 -test util-16.1.17.-287 {8.4 compatible formatting of doubles} \ - {expr 1e-287} \ - 1e-287 -test util-16.1.17.-286 {8.4 compatible formatting of doubles} \ - {expr 1e-286} \ - 1.0000000000000001e-286 -test util-16.1.17.-285 {8.4 compatible formatting of doubles} \ - {expr 1e-285} \ - 1.0000000000000001e-285 -test util-16.1.17.-284 {8.4 compatible formatting of doubles} \ - {expr 1e-284} \ - 1e-284 -test util-16.1.17.-283 {8.4 compatible formatting of doubles} \ - {expr 1e-283} \ - 9.9999999999999995e-284 -test util-16.1.17.-282 {8.4 compatible formatting of doubles} \ - {expr 1e-282} \ - 1e-282 -test util-16.1.17.-281 {8.4 compatible formatting of doubles} \ - {expr 1e-281} \ - 1e-281 -test util-16.1.17.-280 {8.4 compatible formatting of doubles} \ - {expr 1e-280} \ - 9.9999999999999996e-281 -test util-16.1.17.-279 {8.4 compatible formatting of doubles} \ - {expr 1e-279} \ - 1.0000000000000001e-279 -test util-16.1.17.-278 {8.4 compatible formatting of doubles} \ - {expr 1e-278} \ - 9.9999999999999994e-279 -test util-16.1.17.-277 {8.4 compatible formatting of doubles} \ - {expr 1e-277} \ - 9.9999999999999997e-278 -test util-16.1.17.-276 {8.4 compatible formatting of doubles} \ - {expr 1e-276} \ - 1.0000000000000001e-276 -test util-16.1.17.-275 {8.4 compatible formatting of doubles} \ - {expr 1e-275} \ - 9.9999999999999993e-276 -test util-16.1.17.-274 {8.4 compatible formatting of doubles} \ - {expr 1e-274} \ - 9.9999999999999997e-275 -test util-16.1.17.-273 {8.4 compatible formatting of doubles} \ - {expr 1e-273} \ - 1.0000000000000001e-273 -test util-16.1.17.-272 {8.4 compatible formatting of doubles} \ - {expr 1e-272} \ - 9.9999999999999993e-273 -test util-16.1.17.-271 {8.4 compatible formatting of doubles} \ - {expr 1e-271} \ - 9.9999999999999996e-272 -test util-16.1.17.-270 {8.4 compatible formatting of doubles} \ - {expr 1e-270} \ - 1e-270 -test util-16.1.17.-269 {8.4 compatible formatting of doubles} \ - {expr 1e-269} \ - 9.9999999999999996e-270 -test util-16.1.17.-268 {8.4 compatible formatting of doubles} \ - {expr 1e-268} \ - 9.9999999999999996e-269 -test util-16.1.17.-267 {8.4 compatible formatting of doubles} \ - {expr 1e-267} \ - 9.9999999999999998e-268 -test util-16.1.17.-266 {8.4 compatible formatting of doubles} \ - {expr 1e-266} \ - 9.9999999999999998e-267 -test util-16.1.17.-265 {8.4 compatible formatting of doubles} \ - {expr 1e-265} \ - 9.9999999999999998e-266 -test util-16.1.17.-264 {8.4 compatible formatting of doubles} \ - {expr 1e-264} \ - 1e-264 -test util-16.1.17.-263 {8.4 compatible formatting of doubles} \ - {expr 1e-263} \ - 1e-263 -test util-16.1.17.-262 {8.4 compatible formatting of doubles} \ - {expr 1e-262} \ - 1e-262 -test util-16.1.17.-261 {8.4 compatible formatting of doubles} \ - {expr 1e-261} \ - 9.9999999999999998e-262 -test util-16.1.17.-260 {8.4 compatible formatting of doubles} \ - {expr 1e-260} \ - 9.9999999999999996e-261 -test util-16.1.17.-259 {8.4 compatible formatting of doubles} \ - {expr 1e-259} \ - 1.0000000000000001e-259 -test util-16.1.17.-258 {8.4 compatible formatting of doubles} \ - {expr 1e-258} \ - 9.9999999999999995e-259 -test util-16.1.17.-257 {8.4 compatible formatting of doubles} \ - {expr 1e-257} \ - 9.9999999999999998e-258 -test util-16.1.17.-256 {8.4 compatible formatting of doubles} \ - {expr 1e-256} \ - 9.9999999999999998e-257 -test util-16.1.17.-255 {8.4 compatible formatting of doubles} \ - {expr 1e-255} \ - 1e-255 -test util-16.1.17.-254 {8.4 compatible formatting of doubles} \ - {expr 1e-254} \ - 9.9999999999999991e-255 -test util-16.1.17.-253 {8.4 compatible formatting of doubles} \ - {expr 1e-253} \ - 1.0000000000000001e-253 -test util-16.1.17.-252 {8.4 compatible formatting of doubles} \ - {expr 1e-252} \ - 9.9999999999999994e-253 -test util-16.1.17.-251 {8.4 compatible formatting of doubles} \ - {expr 1e-251} \ - 1e-251 -test util-16.1.17.-250 {8.4 compatible formatting of doubles} \ - {expr 1e-250} \ - 1.0000000000000001e-250 -test util-16.1.17.-249 {8.4 compatible formatting of doubles} \ - {expr 1e-249} \ - 1.0000000000000001e-249 -test util-16.1.17.-248 {8.4 compatible formatting of doubles} \ - {expr 1e-248} \ - 9.9999999999999998e-249 -test util-16.1.17.-247 {8.4 compatible formatting of doubles} \ - {expr 1e-247} \ - 1e-247 -test util-16.1.17.-246 {8.4 compatible formatting of doubles} \ - {expr 1e-246} \ - 9.9999999999999996e-247 -test util-16.1.17.-245 {8.4 compatible formatting of doubles} \ - {expr 1e-245} \ - 9.9999999999999993e-246 -test util-16.1.17.-244 {8.4 compatible formatting of doubles} \ - {expr 1e-244} \ - 9.9999999999999993e-245 -test util-16.1.17.-243 {8.4 compatible formatting of doubles} \ - {expr 1e-243} \ - 1e-243 -test util-16.1.17.-242 {8.4 compatible formatting of doubles} \ - {expr 1e-242} \ - 9.9999999999999997e-243 -test util-16.1.17.-241 {8.4 compatible formatting of doubles} \ - {expr 1e-241} \ - 9.9999999999999997e-242 -test util-16.1.17.-240 {8.4 compatible formatting of doubles} \ - {expr 1e-240} \ - 9.9999999999999997e-241 -test util-16.1.17.-239 {8.4 compatible formatting of doubles} \ - {expr 1e-239} \ - 1.0000000000000001e-239 -test util-16.1.17.-238 {8.4 compatible formatting of doubles} \ - {expr 1e-238} \ - 9.9999999999999999e-239 -test util-16.1.17.-237 {8.4 compatible formatting of doubles} \ - {expr 1e-237} \ - 9.9999999999999999e-238 -test util-16.1.17.-236 {8.4 compatible formatting of doubles} \ - {expr 1e-236} \ - 1e-236 -test util-16.1.17.-235 {8.4 compatible formatting of doubles} \ - {expr 1e-235} \ - 9.9999999999999996e-236 -test util-16.1.17.-234 {8.4 compatible formatting of doubles} \ - {expr 1e-234} \ - 9.9999999999999996e-235 -test util-16.1.17.-233 {8.4 compatible formatting of doubles} \ - {expr 1e-233} \ - 9.9999999999999996e-234 -test util-16.1.17.-232 {8.4 compatible formatting of doubles} \ - {expr 1e-232} \ - 1e-232 -test util-16.1.17.-231 {8.4 compatible formatting of doubles} \ - {expr 1e-231} \ - 9.9999999999999999e-232 -test util-16.1.17.-230 {8.4 compatible formatting of doubles} \ - {expr 1e-230} \ - 1e-230 -test util-16.1.17.-229 {8.4 compatible formatting of doubles} \ - {expr 1e-229} \ - 1.0000000000000001e-229 -test util-16.1.17.-228 {8.4 compatible formatting of doubles} \ - {expr 1e-228} \ - 1e-228 -test util-16.1.17.-227 {8.4 compatible formatting of doubles} \ - {expr 1e-227} \ - 9.9999999999999994e-228 -test util-16.1.17.-226 {8.4 compatible formatting of doubles} \ - {expr 1e-226} \ - 9.9999999999999992e-227 -test util-16.1.17.-225 {8.4 compatible formatting of doubles} \ - {expr 1e-225} \ - 9.9999999999999996e-226 -test util-16.1.17.-224 {8.4 compatible formatting of doubles} \ - {expr 1e-224} \ - 1e-224 -test util-16.1.17.-223 {8.4 compatible formatting of doubles} \ - {expr 1e-223} \ - 9.9999999999999997e-224 -test util-16.1.17.-222 {8.4 compatible formatting of doubles} \ - {expr 1e-222} \ - 1e-222 -test util-16.1.17.-221 {8.4 compatible formatting of doubles} \ - {expr 1e-221} \ - 1e-221 -test util-16.1.17.-220 {8.4 compatible formatting of doubles} \ - {expr 1e-220} \ - 9.9999999999999999e-221 -test util-16.1.17.-219 {8.4 compatible formatting of doubles} \ - {expr 1e-219} \ - 1e-219 -test util-16.1.17.-218 {8.4 compatible formatting of doubles} \ - {expr 1e-218} \ - 1e-218 -test util-16.1.17.-217 {8.4 compatible formatting of doubles} \ - {expr 1e-217} \ - 1.0000000000000001e-217 -test util-16.1.17.-216 {8.4 compatible formatting of doubles} \ - {expr 1e-216} \ - 1e-216 -test util-16.1.17.-215 {8.4 compatible formatting of doubles} \ - {expr 1e-215} \ - 1e-215 -test util-16.1.17.-214 {8.4 compatible formatting of doubles} \ - {expr 1e-214} \ - 9.9999999999999991e-215 -test util-16.1.17.-213 {8.4 compatible formatting of doubles} \ - {expr 1e-213} \ - 9.9999999999999995e-214 -test util-16.1.17.-212 {8.4 compatible formatting of doubles} \ - {expr 1e-212} \ - 9.9999999999999995e-213 -test util-16.1.17.-211 {8.4 compatible formatting of doubles} \ - {expr 1e-211} \ - 1.0000000000000001e-211 -test util-16.1.17.-210 {8.4 compatible formatting of doubles} \ - {expr 1e-210} \ - 1e-210 -test util-16.1.17.-209 {8.4 compatible formatting of doubles} \ - {expr 1e-209} \ - 1e-209 -test util-16.1.17.-208 {8.4 compatible formatting of doubles} \ - {expr 1e-208} \ - 1.0000000000000001e-208 -test util-16.1.17.-207 {8.4 compatible formatting of doubles} \ - {expr 1e-207} \ - 9.9999999999999993e-208 -test util-16.1.17.-206 {8.4 compatible formatting of doubles} \ - {expr 1e-206} \ - 1e-206 -test util-16.1.17.-205 {8.4 compatible formatting of doubles} \ - {expr 1e-205} \ - 1e-205 -test util-16.1.17.-204 {8.4 compatible formatting of doubles} \ - {expr 1e-204} \ - 1e-204 -test util-16.1.17.-203 {8.4 compatible formatting of doubles} \ - {expr 1e-203} \ - 1e-203 -test util-16.1.17.-202 {8.4 compatible formatting of doubles} \ - {expr 1e-202} \ - 1e-202 -test util-16.1.17.-201 {8.4 compatible formatting of doubles} \ - {expr 1e-201} \ - 9.9999999999999995e-202 -test util-16.1.17.-200 {8.4 compatible formatting of doubles} \ - {expr 1e-200} \ - 9.9999999999999998e-201 -test util-16.1.17.-199 {8.4 compatible formatting of doubles} \ - {expr 1e-199} \ - 9.9999999999999998e-200 -test util-16.1.17.-198 {8.4 compatible formatting of doubles} \ - {expr 1e-198} \ - 9.9999999999999991e-199 -test util-16.1.17.-197 {8.4 compatible formatting of doubles} \ - {expr 1e-197} \ - 9.9999999999999999e-198 -test util-16.1.17.-196 {8.4 compatible formatting of doubles} \ - {expr 1e-196} \ - 1e-196 -test util-16.1.17.-195 {8.4 compatible formatting of doubles} \ - {expr 1e-195} \ - 1.0000000000000001e-195 -test util-16.1.17.-194 {8.4 compatible formatting of doubles} \ - {expr 1e-194} \ - 1e-194 -test util-16.1.17.-193 {8.4 compatible formatting of doubles} \ - {expr 1e-193} \ - 1e-193 -test util-16.1.17.-192 {8.4 compatible formatting of doubles} \ - {expr 1e-192} \ - 1.0000000000000001e-192 -test util-16.1.17.-191 {8.4 compatible formatting of doubles} \ - {expr 1e-191} \ - 1e-191 -test util-16.1.17.-190 {8.4 compatible formatting of doubles} \ - {expr 1e-190} \ - 1e-190 -test util-16.1.17.-189 {8.4 compatible formatting of doubles} \ - {expr 1e-189} \ - 1.0000000000000001e-189 -test util-16.1.17.-188 {8.4 compatible formatting of doubles} \ - {expr 1e-188} \ - 9.9999999999999995e-189 -test util-16.1.17.-187 {8.4 compatible formatting of doubles} \ - {expr 1e-187} \ - 1e-187 -test util-16.1.17.-186 {8.4 compatible formatting of doubles} \ - {expr 1e-186} \ - 9.9999999999999991e-187 -test util-16.1.17.-185 {8.4 compatible formatting of doubles} \ - {expr 1e-185} \ - 9.9999999999999999e-186 -test util-16.1.17.-184 {8.4 compatible formatting of doubles} \ - {expr 1e-184} \ - 1.0000000000000001e-184 -test util-16.1.17.-183 {8.4 compatible formatting of doubles} \ - {expr 1e-183} \ - 1e-183 -test util-16.1.17.-182 {8.4 compatible formatting of doubles} \ - {expr 1e-182} \ - 1e-182 -test util-16.1.17.-181 {8.4 compatible formatting of doubles} \ - {expr 1e-181} \ - 1e-181 -test util-16.1.17.-180 {8.4 compatible formatting of doubles} \ - {expr 1e-180} \ - 1e-180 -test util-16.1.17.-179 {8.4 compatible formatting of doubles} \ - {expr 1e-179} \ - 1e-179 -test util-16.1.17.-178 {8.4 compatible formatting of doubles} \ - {expr 1e-178} \ - 9.9999999999999995e-179 -test util-16.1.17.-177 {8.4 compatible formatting of doubles} \ - {expr 1e-177} \ - 9.9999999999999995e-178 -test util-16.1.17.-176 {8.4 compatible formatting of doubles} \ - {expr 1e-176} \ - 1e-176 -test util-16.1.17.-175 {8.4 compatible formatting of doubles} \ - {expr 1e-175} \ - 1e-175 -test util-16.1.17.-174 {8.4 compatible formatting of doubles} \ - {expr 1e-174} \ - 1e-174 -test util-16.1.17.-173 {8.4 compatible formatting of doubles} \ - {expr 1e-173} \ - 1e-173 -test util-16.1.17.-172 {8.4 compatible formatting of doubles} \ - {expr 1e-172} \ - 1e-172 -test util-16.1.17.-171 {8.4 compatible formatting of doubles} \ - {expr 1e-171} \ - 9.9999999999999998e-172 -test util-16.1.17.-170 {8.4 compatible formatting of doubles} \ - {expr 1e-170} \ - 9.9999999999999998e-171 -test util-16.1.17.-169 {8.4 compatible formatting of doubles} \ - {expr 1e-169} \ - 1e-169 -test util-16.1.17.-168 {8.4 compatible formatting of doubles} \ - {expr 1e-168} \ - 1e-168 -test util-16.1.17.-167 {8.4 compatible formatting of doubles} \ - {expr 1e-167} \ - 1e-167 -test util-16.1.17.-166 {8.4 compatible formatting of doubles} \ - {expr 1e-166} \ - 1e-166 -test util-16.1.17.-165 {8.4 compatible formatting of doubles} \ - {expr 1e-165} \ - 1e-165 -test util-16.1.17.-164 {8.4 compatible formatting of doubles} \ - {expr 1e-164} \ - 9.9999999999999996e-165 -test util-16.1.17.-163 {8.4 compatible formatting of doubles} \ - {expr 1e-163} \ - 9.9999999999999992e-164 -test util-16.1.17.-162 {8.4 compatible formatting of doubles} \ - {expr 1e-162} \ - 9.9999999999999995e-163 -test util-16.1.17.-161 {8.4 compatible formatting of doubles} \ - {expr 1e-161} \ - 1e-161 -test util-16.1.17.-160 {8.4 compatible formatting of doubles} \ - {expr 1e-160} \ - 9.9999999999999999e-161 -test util-16.1.17.-159 {8.4 compatible formatting of doubles} \ - {expr 1e-159} \ - 9.9999999999999999e-160 -test util-16.1.17.-158 {8.4 compatible formatting of doubles} \ - {expr 1e-158} \ - 1.0000000000000001e-158 -test util-16.1.17.-157 {8.4 compatible formatting of doubles} \ - {expr 1e-157} \ - 9.9999999999999994e-158 -test util-16.1.17.-156 {8.4 compatible formatting of doubles} \ - {expr 1e-156} \ - 1e-156 -test util-16.1.17.-155 {8.4 compatible formatting of doubles} \ - {expr 1e-155} \ - 1e-155 -test util-16.1.17.-154 {8.4 compatible formatting of doubles} \ - {expr 1e-154} \ - 9.9999999999999997e-155 -test util-16.1.17.-153 {8.4 compatible formatting of doubles} \ - {expr 1e-153} \ - 1e-153 -test util-16.1.17.-152 {8.4 compatible formatting of doubles} \ - {expr 1e-152} \ - 1.0000000000000001e-152 -test util-16.1.17.-151 {8.4 compatible formatting of doubles} \ - {expr 1e-151} \ - 9.9999999999999994e-152 -test util-16.1.17.-150 {8.4 compatible formatting of doubles} \ - {expr 1e-150} \ - 1e-150 -test util-16.1.17.-149 {8.4 compatible formatting of doubles} \ - {expr 1e-149} \ - 9.9999999999999998e-150 -test util-16.1.17.-148 {8.4 compatible formatting of doubles} \ - {expr 1e-148} \ - 9.9999999999999994e-149 -test util-16.1.17.-147 {8.4 compatible formatting of doubles} \ - {expr 1e-147} \ - 9.9999999999999997e-148 -test util-16.1.17.-146 {8.4 compatible formatting of doubles} \ - {expr 1e-146} \ - 1e-146 -test util-16.1.17.-145 {8.4 compatible formatting of doubles} \ - {expr 1e-145} \ - 9.9999999999999991e-146 -test util-16.1.17.-144 {8.4 compatible formatting of doubles} \ - {expr 1e-144} \ - 9.9999999999999995e-145 -test util-16.1.17.-143 {8.4 compatible formatting of doubles} \ - {expr 1e-143} \ - 9.9999999999999995e-144 -test util-16.1.17.-142 {8.4 compatible formatting of doubles} \ - {expr 1e-142} \ - 1e-142 -test util-16.1.17.-141 {8.4 compatible formatting of doubles} \ - {expr 1e-141} \ - 1e-141 -test util-16.1.17.-140 {8.4 compatible formatting of doubles} \ - {expr 1e-140} \ - 9.9999999999999998e-141 -test util-16.1.17.-139 {8.4 compatible formatting of doubles} \ - {expr 1e-139} \ - 1e-139 -test util-16.1.17.-138 {8.4 compatible formatting of doubles} \ - {expr 1e-138} \ - 1.0000000000000001e-138 -test util-16.1.17.-137 {8.4 compatible formatting of doubles} \ - {expr 1e-137} \ - 9.9999999999999998e-138 -test util-16.1.17.-136 {8.4 compatible formatting of doubles} \ - {expr 1e-136} \ - 1e-136 -test util-16.1.17.-135 {8.4 compatible formatting of doubles} \ - {expr 1e-135} \ - 1e-135 -test util-16.1.17.-134 {8.4 compatible formatting of doubles} \ - {expr 1e-134} \ - 1e-134 -test util-16.1.17.-133 {8.4 compatible formatting of doubles} \ - {expr 1e-133} \ - 1.0000000000000001e-133 -test util-16.1.17.-132 {8.4 compatible formatting of doubles} \ - {expr 1e-132} \ - 9.9999999999999999e-133 -test util-16.1.17.-131 {8.4 compatible formatting of doubles} \ - {expr 1e-131} \ - 9.9999999999999999e-132 -test util-16.1.17.-130 {8.4 compatible formatting of doubles} \ - {expr 1e-130} \ - 1.0000000000000001e-130 -test util-16.1.17.-129 {8.4 compatible formatting of doubles} \ - {expr 1e-129} \ - 9.9999999999999993e-130 -test util-16.1.17.-128 {8.4 compatible formatting of doubles} \ - {expr 1e-128} \ - 1.0000000000000001e-128 -test util-16.1.17.-127 {8.4 compatible formatting of doubles} \ - {expr 1e-127} \ - 1e-127 -test util-16.1.17.-126 {8.4 compatible formatting of doubles} \ - {expr 1e-126} \ - 9.9999999999999995e-127 -test util-16.1.17.-125 {8.4 compatible formatting of doubles} \ - {expr 1e-125} \ - 1e-125 -test util-16.1.17.-124 {8.4 compatible formatting of doubles} \ - {expr 1e-124} \ - 9.9999999999999993e-125 -test util-16.1.17.-123 {8.4 compatible formatting of doubles} \ - {expr 1e-123} \ - 1.0000000000000001e-123 -test util-16.1.17.-122 {8.4 compatible formatting of doubles} \ - {expr 1e-122} \ - 1.0000000000000001e-122 -test util-16.1.17.-121 {8.4 compatible formatting of doubles} \ - {expr 1e-121} \ - 9.9999999999999998e-122 -test util-16.1.17.-120 {8.4 compatible formatting of doubles} \ - {expr 1e-120} \ - 9.9999999999999998e-121 -test util-16.1.17.-119 {8.4 compatible formatting of doubles} \ - {expr 1e-119} \ - 1e-119 -test util-16.1.17.-118 {8.4 compatible formatting of doubles} \ - {expr 1e-118} \ - 9.9999999999999999e-119 -test util-16.1.17.-117 {8.4 compatible formatting of doubles} \ - {expr 1e-117} \ - 1e-117 -test util-16.1.17.-116 {8.4 compatible formatting of doubles} \ - {expr 1e-116} \ - 9.9999999999999999e-117 -test util-16.1.17.-115 {8.4 compatible formatting of doubles} \ - {expr 1e-115} \ - 1.0000000000000001e-115 -test util-16.1.17.-114 {8.4 compatible formatting of doubles} \ - {expr 1e-114} \ - 1.0000000000000001e-114 -test util-16.1.17.-113 {8.4 compatible formatting of doubles} \ - {expr 1e-113} \ - 9.9999999999999998e-114 -test util-16.1.17.-112 {8.4 compatible formatting of doubles} \ - {expr 1e-112} \ - 9.9999999999999995e-113 -test util-16.1.17.-111 {8.4 compatible formatting of doubles} \ - {expr 1e-111} \ - 1.0000000000000001e-111 -test util-16.1.17.-110 {8.4 compatible formatting of doubles} \ - {expr 1e-110} \ - 1.0000000000000001e-110 -test util-16.1.17.-109 {8.4 compatible formatting of doubles} \ - {expr 1e-109} \ - 9.9999999999999999e-110 -test util-16.1.17.-108 {8.4 compatible formatting of doubles} \ - {expr 1e-108} \ - 1e-108 -test util-16.1.17.-107 {8.4 compatible formatting of doubles} \ - {expr 1e-107} \ - 1e-107 -test util-16.1.17.-106 {8.4 compatible formatting of doubles} \ - {expr 1e-106} \ - 9.9999999999999994e-107 -test util-16.1.17.-105 {8.4 compatible formatting of doubles} \ - {expr 1e-105} \ - 9.9999999999999997e-106 -test util-16.1.17.-104 {8.4 compatible formatting of doubles} \ - {expr 1e-104} \ - 9.9999999999999993e-105 -test util-16.1.17.-103 {8.4 compatible formatting of doubles} \ - {expr 1e-103} \ - 9.9999999999999996e-104 -test util-16.1.17.-102 {8.4 compatible formatting of doubles} \ - {expr 1e-102} \ - 9.9999999999999993e-103 -test util-16.1.17.-101 {8.4 compatible formatting of doubles} \ - {expr 1e-101} \ - 1.0000000000000001e-101 -test util-16.1.17.-100 {8.4 compatible formatting of doubles} \ - {expr 1e-100} \ - 1e-100 -test util-16.1.17.-99 {8.4 compatible formatting of doubles} \ - {expr 1e-99} \ - 1e-99 -test util-16.1.17.-98 {8.4 compatible formatting of doubles} \ - {expr 1e-98} \ - 9.9999999999999994e-99 -test util-16.1.17.-97 {8.4 compatible formatting of doubles} \ - {expr 1e-97} \ - 1e-97 -test util-16.1.17.-96 {8.4 compatible formatting of doubles} \ - {expr 1e-96} \ - 9.9999999999999991e-97 -test util-16.1.17.-95 {8.4 compatible formatting of doubles} \ - {expr 1e-95} \ - 9.9999999999999999e-96 -test util-16.1.17.-94 {8.4 compatible formatting of doubles} \ - {expr 1e-94} \ - 9.9999999999999996e-95 -test util-16.1.17.-93 {8.4 compatible formatting of doubles} \ - {expr 1e-93} \ - 9.999999999999999e-94 -test util-16.1.17.-92 {8.4 compatible formatting of doubles} \ - {expr 1e-92} \ - 9.9999999999999999e-93 -test util-16.1.17.-91 {8.4 compatible formatting of doubles} \ - {expr 1e-91} \ - 1e-91 -test util-16.1.17.-90 {8.4 compatible formatting of doubles} \ - {expr 1e-90} \ - 9.9999999999999999e-91 -test util-16.1.17.-89 {8.4 compatible formatting of doubles} \ - {expr 1e-89} \ - 1e-89 -test util-16.1.17.-88 {8.4 compatible formatting of doubles} \ - {expr 1e-88} \ - 9.9999999999999993e-89 -test util-16.1.17.-87 {8.4 compatible formatting of doubles} \ - {expr 1e-87} \ - 1e-87 -test util-16.1.17.-86 {8.4 compatible formatting of doubles} \ - {expr 1e-86} \ - 1.0000000000000001e-86 -test util-16.1.17.-85 {8.4 compatible formatting of doubles} \ - {expr 1e-85} \ - 9.9999999999999998e-86 -test util-16.1.17.-84 {8.4 compatible formatting of doubles} \ - {expr 1e-84} \ - 1e-84 -test util-16.1.17.-83 {8.4 compatible formatting of doubles} \ - {expr 1e-83} \ - 1e-83 -test util-16.1.17.-82 {8.4 compatible formatting of doubles} \ - {expr 1e-82} \ - 9.9999999999999996e-83 -test util-16.1.17.-81 {8.4 compatible formatting of doubles} \ - {expr 1e-81} \ - 9.9999999999999996e-82 -test util-16.1.17.-80 {8.4 compatible formatting of doubles} \ - {expr 1e-80} \ - 9.9999999999999996e-81 -test util-16.1.17.-79 {8.4 compatible formatting of doubles} \ - {expr 1e-79} \ - 1e-79 -test util-16.1.17.-78 {8.4 compatible formatting of doubles} \ - {expr 1e-78} \ - 1e-78 -test util-16.1.17.-77 {8.4 compatible formatting of doubles} \ - {expr 1e-77} \ - 9.9999999999999993e-78 -test util-16.1.17.-76 {8.4 compatible formatting of doubles} \ - {expr 1e-76} \ - 9.9999999999999993e-77 -test util-16.1.17.-75 {8.4 compatible formatting of doubles} \ - {expr 1e-75} \ - 9.9999999999999996e-76 -test util-16.1.17.-74 {8.4 compatible formatting of doubles} \ - {expr 1e-74} \ - 9.9999999999999996e-75 -test util-16.1.17.-73 {8.4 compatible formatting of doubles} \ - {expr 1e-73} \ - 1e-73 -test util-16.1.17.-72 {8.4 compatible formatting of doubles} \ - {expr 1e-72} \ - 9.9999999999999997e-73 -test util-16.1.17.-71 {8.4 compatible formatting of doubles} \ - {expr 1e-71} \ - 9.9999999999999992e-72 -test util-16.1.17.-70 {8.4 compatible formatting of doubles} \ - {expr 1e-70} \ - 1e-70 -test util-16.1.17.-69 {8.4 compatible formatting of doubles} \ - {expr 1e-69} \ - 9.9999999999999996e-70 -test util-16.1.17.-68 {8.4 compatible formatting of doubles} \ - {expr 1e-68} \ - 1.0000000000000001e-68 -test util-16.1.17.-67 {8.4 compatible formatting of doubles} \ - {expr 1e-67} \ - 9.9999999999999994e-68 -test util-16.1.17.-66 {8.4 compatible formatting of doubles} \ - {expr 1e-66} \ - 9.9999999999999998e-67 -test util-16.1.17.-65 {8.4 compatible formatting of doubles} \ - {expr 1e-65} \ - 9.9999999999999992e-66 -test util-16.1.17.-64 {8.4 compatible formatting of doubles} \ - {expr 1e-64} \ - 9.9999999999999997e-65 -test util-16.1.17.-63 {8.4 compatible formatting of doubles} \ - {expr 1e-63} \ - 1.0000000000000001e-63 -test util-16.1.17.-62 {8.4 compatible formatting of doubles} \ - {expr 1e-62} \ - 1e-62 -test util-16.1.17.-61 {8.4 compatible formatting of doubles} \ - {expr 1e-61} \ - 1e-61 -test util-16.1.17.-60 {8.4 compatible formatting of doubles} \ - {expr 1e-60} \ - 9.9999999999999997e-61 -test util-16.1.17.-59 {8.4 compatible formatting of doubles} \ - {expr 1e-59} \ - 1e-59 -test util-16.1.17.-58 {8.4 compatible formatting of doubles} \ - {expr 1e-58} \ - 1e-58 -test util-16.1.17.-57 {8.4 compatible formatting of doubles} \ - {expr 1e-57} \ - 9.9999999999999995e-58 -test util-16.1.17.-56 {8.4 compatible formatting of doubles} \ - {expr 1e-56} \ - 1e-56 -test util-16.1.17.-55 {8.4 compatible formatting of doubles} \ - {expr 1e-55} \ - 9.9999999999999999e-56 -test util-16.1.17.-54 {8.4 compatible formatting of doubles} \ - {expr 1e-54} \ - 1e-54 -test util-16.1.17.-53 {8.4 compatible formatting of doubles} \ - {expr 1e-53} \ - 1e-53 -test util-16.1.17.-52 {8.4 compatible formatting of doubles} \ - {expr 1e-52} \ - 1e-52 -test util-16.1.17.-51 {8.4 compatible formatting of doubles} \ - {expr 1e-51} \ - 1e-51 -test util-16.1.17.-50 {8.4 compatible formatting of doubles} \ - {expr 1e-50} \ - 1e-50 -test util-16.1.17.-49 {8.4 compatible formatting of doubles} \ - {expr 1e-49} \ - 9.9999999999999994e-50 -test util-16.1.17.-48 {8.4 compatible formatting of doubles} \ - {expr 1e-48} \ - 9.9999999999999997e-49 -test util-16.1.17.-47 {8.4 compatible formatting of doubles} \ - {expr 1e-47} \ - 9.9999999999999997e-48 -test util-16.1.17.-46 {8.4 compatible formatting of doubles} \ - {expr 1e-46} \ - 1e-46 -test util-16.1.17.-45 {8.4 compatible formatting of doubles} \ - {expr 1e-45} \ - 9.9999999999999998e-46 -test util-16.1.17.-44 {8.4 compatible formatting of doubles} \ - {expr 1e-44} \ - 9.9999999999999995e-45 -test util-16.1.17.-43 {8.4 compatible formatting of doubles} \ - {expr 1e-43} \ - 1.0000000000000001e-43 -test util-16.1.17.-42 {8.4 compatible formatting of doubles} \ - {expr 1e-42} \ - 1e-42 -test util-16.1.17.-41 {8.4 compatible formatting of doubles} \ - {expr 1e-41} \ - 1e-41 -test util-16.1.17.-40 {8.4 compatible formatting of doubles} \ - {expr 1e-40} \ - 9.9999999999999993e-41 -test util-16.1.17.-39 {8.4 compatible formatting of doubles} \ - {expr 1e-39} \ - 9.9999999999999993e-40 -test util-16.1.17.-38 {8.4 compatible formatting of doubles} \ - {expr 1e-38} \ - 9.9999999999999996e-39 -test util-16.1.17.-37 {8.4 compatible formatting of doubles} \ - {expr 1e-37} \ - 1.0000000000000001e-37 -test util-16.1.17.-36 {8.4 compatible formatting of doubles} \ - {expr 1e-36} \ - 9.9999999999999994e-37 -test util-16.1.17.-35 {8.4 compatible formatting of doubles} \ - {expr 1e-35} \ - 1e-35 -test util-16.1.17.-34 {8.4 compatible formatting of doubles} \ - {expr 1e-34} \ - 9.9999999999999993e-35 -test util-16.1.17.-33 {8.4 compatible formatting of doubles} \ - {expr 1e-33} \ - 1.0000000000000001e-33 -test util-16.1.17.-32 {8.4 compatible formatting of doubles} \ - {expr 1e-32} \ - 1.0000000000000001e-32 -test util-16.1.17.-31 {8.4 compatible formatting of doubles} \ - {expr 1e-31} \ - 1.0000000000000001e-31 -test util-16.1.17.-30 {8.4 compatible formatting of doubles} \ - {expr 1e-30} \ - 1.0000000000000001e-30 -test util-16.1.17.-29 {8.4 compatible formatting of doubles} \ - {expr 1e-29} \ - 9.9999999999999994e-30 -test util-16.1.17.-28 {8.4 compatible formatting of doubles} \ - {expr 1e-28} \ - 9.9999999999999997e-29 -test util-16.1.17.-27 {8.4 compatible formatting of doubles} \ - {expr 1e-27} \ - 1e-27 -test util-16.1.17.-26 {8.4 compatible formatting of doubles} \ - {expr 1e-26} \ - 1e-26 -test util-16.1.17.-25 {8.4 compatible formatting of doubles} \ - {expr 1e-25} \ - 1e-25 -test util-16.1.17.-24 {8.4 compatible formatting of doubles} \ - {expr 1e-24} \ - 9.9999999999999992e-25 -test util-16.1.17.-23 {8.4 compatible formatting of doubles} \ - {expr 1e-23} \ - 9.9999999999999996e-24 -test util-16.1.17.-22 {8.4 compatible formatting of doubles} \ - {expr 1e-22} \ - 1e-22 -test util-16.1.17.-21 {8.4 compatible formatting of doubles} \ - {expr 1e-21} \ - 9.9999999999999991e-22 -test util-16.1.17.-20 {8.4 compatible formatting of doubles} \ - {expr 1e-20} \ - 9.9999999999999995e-21 -test util-16.1.17.-19 {8.4 compatible formatting of doubles} \ - {expr 1e-19} \ - 9.9999999999999998e-20 -test util-16.1.17.-18 {8.4 compatible formatting of doubles} \ - {expr 1e-18} \ - 1.0000000000000001e-18 -test util-16.1.17.-17 {8.4 compatible formatting of doubles} \ - {expr 1e-17} \ - 1.0000000000000001e-17 -test util-16.1.17.-16 {8.4 compatible formatting of doubles} \ - {expr 1e-16} \ - 9.9999999999999998e-17 -test util-16.1.17.-15 {8.4 compatible formatting of doubles} \ - {expr 1e-15} \ - 1.0000000000000001e-15 -test util-16.1.17.-14 {8.4 compatible formatting of doubles} \ - {expr 1e-14} \ - 1e-14 -test util-16.1.17.-13 {8.4 compatible formatting of doubles} \ - {expr 1e-13} \ - 1e-13 -test util-16.1.17.-12 {8.4 compatible formatting of doubles} \ - {expr 1e-12} \ - 9.9999999999999998e-13 -test util-16.1.17.-11 {8.4 compatible formatting of doubles} \ - {expr 1e-11} \ - 9.9999999999999994e-12 -test util-16.1.17.-10 {8.4 compatible formatting of doubles} \ - {expr 1e-10} \ - 1e-10 -test util-16.1.17.-9 {8.4 compatible formatting of doubles} \ - {expr 1e-9} \ - 1.0000000000000001e-09 -test util-16.1.17.-8 {8.4 compatible formatting of doubles} \ - {expr 1e-8} \ - 1e-08 -test util-16.1.17.-7 {8.4 compatible formatting of doubles} \ - {expr 1e-7} \ - 9.9999999999999995e-08 -test util-16.1.17.-6 {8.4 compatible formatting of doubles} \ - {expr 1e-6} \ - 9.9999999999999995e-07 -test util-16.1.17.-5 {8.4 compatible formatting of doubles} \ - {expr 1e-5} \ - 1.0000000000000001e-05 -test util-16.1.17.-4 {8.4 compatible formatting of doubles} \ - {expr 1e-4} \ - 0.0001 -test util-16.1.17.-3 {8.4 compatible formatting of doubles} \ - {expr 1e-3} \ - 0.001 -test util-16.1.17.-2 {8.4 compatible formatting of doubles} \ - {expr 1e-2} \ - 0.01 -test util-16.1.17.-1 {8.4 compatible formatting of doubles} \ - {expr 1e-1} \ - 0.10000000000000001 -test util-16.1.17.0 {8.4 compatible formatting of doubles} \ - {expr 1e0} \ - 1.0 -test util-16.1.17.1 {8.4 compatible formatting of doubles} \ - {expr 1e1} \ - 10.0 -test util-16.1.17.2 {8.4 compatible formatting of doubles} \ - {expr 1e2} \ - 100.0 -test util-16.1.17.3 {8.4 compatible formatting of doubles} \ - {expr 1e3} \ - 1000.0 -test util-16.1.17.4 {8.4 compatible formatting of doubles} \ - {expr 1e4} \ - 10000.0 -test util-16.1.17.5 {8.4 compatible formatting of doubles} \ - {expr 1e5} \ - 100000.0 -test util-16.1.17.6 {8.4 compatible formatting of doubles} \ - {expr 1e6} \ - 1000000.0 -test util-16.1.17.7 {8.4 compatible formatting of doubles} \ - {expr 1e7} \ - 10000000.0 -test util-16.1.17.8 {8.4 compatible formatting of doubles} \ - {expr 1e8} \ - 100000000.0 -test util-16.1.17.9 {8.4 compatible formatting of doubles} \ - {expr 1e9} \ - 1000000000.0 -test util-16.1.17.10 {8.4 compatible formatting of doubles} \ - {expr 1e10} \ - 10000000000.0 -test util-16.1.17.11 {8.4 compatible formatting of doubles} \ - {expr 1e11} \ - 100000000000.0 -test util-16.1.17.12 {8.4 compatible formatting of doubles} \ - {expr 1e12} \ - 1000000000000.0 -test util-16.1.17.13 {8.4 compatible formatting of doubles} \ - {expr 1e13} \ - 10000000000000.0 -test util-16.1.17.14 {8.4 compatible formatting of doubles} \ - {expr 1e14} \ - 100000000000000.0 -test util-16.1.17.15 {8.4 compatible formatting of doubles} \ - {expr 1e15} \ - 1000000000000000.0 -test util-16.1.17.16 {8.4 compatible formatting of doubles} \ - {expr 1e16} \ - 10000000000000000.0 -test util-16.1.17.17 {8.4 compatible formatting of doubles} \ - {expr 1e17} \ - 1e+17 -test util-16.1.17.18 {8.4 compatible formatting of doubles} \ - {expr 1e18} \ - 1e+18 -test util-16.1.17.19 {8.4 compatible formatting of doubles} \ - {expr 1e19} \ - 1e+19 -test util-16.1.17.20 {8.4 compatible formatting of doubles} \ - {expr 1e20} \ - 1e+20 -test util-16.1.17.21 {8.4 compatible formatting of doubles} \ - {expr 1e21} \ - 1e+21 -test util-16.1.17.22 {8.4 compatible formatting of doubles} \ - {expr 1e22} \ - 1e+22 -test util-16.1.17.23 {8.4 compatible formatting of doubles} \ - {expr 1e23} \ - 9.9999999999999992e+22 -test util-16.1.17.24 {8.4 compatible formatting of doubles} \ - {expr 1e24} \ - 9.9999999999999998e+23 -test util-16.1.17.25 {8.4 compatible formatting of doubles} \ - {expr 1e25} \ - 1.0000000000000001e+25 -test util-16.1.17.26 {8.4 compatible formatting of doubles} \ - {expr 1e26} \ - 1e+26 -test util-16.1.17.27 {8.4 compatible formatting of doubles} \ - {expr 1e27} \ - 1e+27 -test util-16.1.17.28 {8.4 compatible formatting of doubles} \ - {expr 1e28} \ - 9.9999999999999996e+27 -test util-16.1.17.29 {8.4 compatible formatting of doubles} \ - {expr 1e29} \ - 9.9999999999999991e+28 -test util-16.1.17.30 {8.4 compatible formatting of doubles} \ - {expr 1e30} \ - 1e+30 -test util-16.1.17.31 {8.4 compatible formatting of doubles} \ - {expr 1e31} \ - 9.9999999999999996e+30 -test util-16.1.17.32 {8.4 compatible formatting of doubles} \ - {expr 1e32} \ - 1.0000000000000001e+32 -test util-16.1.17.33 {8.4 compatible formatting of doubles} \ - {expr 1e33} \ - 9.9999999999999995e+32 -test util-16.1.17.34 {8.4 compatible formatting of doubles} \ - {expr 1e34} \ - 9.9999999999999995e+33 -test util-16.1.17.35 {8.4 compatible formatting of doubles} \ - {expr 1e35} \ - 9.9999999999999997e+34 -test util-16.1.17.36 {8.4 compatible formatting of doubles} \ - {expr 1e36} \ - 1e+36 -test util-16.1.17.37 {8.4 compatible formatting of doubles} \ - {expr 1e37} \ - 9.9999999999999995e+36 -test util-16.1.17.38 {8.4 compatible formatting of doubles} \ - {expr 1e38} \ - 9.9999999999999998e+37 -test util-16.1.17.39 {8.4 compatible formatting of doubles} \ - {expr 1e39} \ - 9.9999999999999994e+38 -test util-16.1.17.40 {8.4 compatible formatting of doubles} \ - {expr 1e40} \ - 1e+40 -test util-16.1.17.41 {8.4 compatible formatting of doubles} \ - {expr 1e41} \ - 1e+41 -test util-16.1.17.42 {8.4 compatible formatting of doubles} \ - {expr 1e42} \ - 1e+42 -test util-16.1.17.43 {8.4 compatible formatting of doubles} \ - {expr 1e43} \ - 1e+43 -test util-16.1.17.44 {8.4 compatible formatting of doubles} \ - {expr 1e44} \ - 1.0000000000000001e+44 -test util-16.1.17.45 {8.4 compatible formatting of doubles} \ - {expr 1e45} \ - 9.9999999999999993e+44 -test util-16.1.17.46 {8.4 compatible formatting of doubles} \ - {expr 1e46} \ - 9.9999999999999999e+45 -test util-16.1.17.47 {8.4 compatible formatting of doubles} \ - {expr 1e47} \ - 1e+47 -test util-16.1.17.48 {8.4 compatible formatting of doubles} \ - {expr 1e48} \ - 1e+48 -test util-16.1.17.49 {8.4 compatible formatting of doubles} \ - {expr 1e49} \ - 9.9999999999999995e+48 -test util-16.1.17.50 {8.4 compatible formatting of doubles} \ - {expr 1e50} \ - 1.0000000000000001e+50 -test util-16.1.17.51 {8.4 compatible formatting of doubles} \ - {expr 1e51} \ - 9.9999999999999999e+50 -test util-16.1.17.52 {8.4 compatible formatting of doubles} \ - {expr 1e52} \ - 9.9999999999999999e+51 -test util-16.1.17.53 {8.4 compatible formatting of doubles} \ - {expr 1e53} \ - 9.9999999999999999e+52 -test util-16.1.17.54 {8.4 compatible formatting of doubles} \ - {expr 1e54} \ - 1.0000000000000001e+54 -test util-16.1.17.55 {8.4 compatible formatting of doubles} \ - {expr 1e55} \ - 1e+55 -test util-16.1.17.56 {8.4 compatible formatting of doubles} \ - {expr 1e56} \ - 1.0000000000000001e+56 -test util-16.1.17.57 {8.4 compatible formatting of doubles} \ - {expr 1e57} \ - 1e+57 -test util-16.1.17.58 {8.4 compatible formatting of doubles} \ - {expr 1e58} \ - 9.9999999999999994e+57 -test util-16.1.17.59 {8.4 compatible formatting of doubles} \ - {expr 1e59} \ - 9.9999999999999997e+58 -test util-16.1.17.60 {8.4 compatible formatting of doubles} \ - {expr 1e60} \ - 9.9999999999999995e+59 -test util-16.1.17.61 {8.4 compatible formatting of doubles} \ - {expr 1e61} \ - 9.9999999999999995e+60 -test util-16.1.17.62 {8.4 compatible formatting of doubles} \ - {expr 1e62} \ - 1e+62 -test util-16.1.17.63 {8.4 compatible formatting of doubles} \ - {expr 1e63} \ - 1.0000000000000001e+63 -test util-16.1.17.64 {8.4 compatible formatting of doubles} \ - {expr 1e64} \ - 1e+64 -test util-16.1.17.65 {8.4 compatible formatting of doubles} \ - {expr 1e65} \ - 9.9999999999999999e+64 -test util-16.1.17.66 {8.4 compatible formatting of doubles} \ - {expr 1e66} \ - 9.9999999999999995e+65 -test util-16.1.17.67 {8.4 compatible formatting of doubles} \ - {expr 1e67} \ - 9.9999999999999998e+66 -test util-16.1.17.68 {8.4 compatible formatting of doubles} \ - {expr 1e68} \ - 9.9999999999999995e+67 -test util-16.1.17.69 {8.4 compatible formatting of doubles} \ - {expr 1e69} \ - 1.0000000000000001e+69 -test util-16.1.17.70 {8.4 compatible formatting of doubles} \ - {expr 1e70} \ - 1.0000000000000001e+70 -test util-16.1.17.71 {8.4 compatible formatting of doubles} \ - {expr 1e71} \ - 1e+71 -test util-16.1.17.72 {8.4 compatible formatting of doubles} \ - {expr 1e72} \ - 9.9999999999999994e+71 -test util-16.1.17.73 {8.4 compatible formatting of doubles} \ - {expr 1e73} \ - 9.9999999999999998e+72 -test util-16.1.17.74 {8.4 compatible formatting of doubles} \ - {expr 1e74} \ - 9.9999999999999995e+73 -test util-16.1.17.75 {8.4 compatible formatting of doubles} \ - {expr 1e75} \ - 9.9999999999999993e+74 -test util-16.1.17.76 {8.4 compatible formatting of doubles} \ - {expr 1e76} \ - 1e+76 -test util-16.1.17.77 {8.4 compatible formatting of doubles} \ - {expr 1e77} \ - 9.9999999999999998e+76 -test util-16.1.17.78 {8.4 compatible formatting of doubles} \ - {expr 1e78} \ - 1e+78 -test util-16.1.17.79 {8.4 compatible formatting of doubles} \ - {expr 1e79} \ - 9.9999999999999997e+78 -test util-16.1.17.80 {8.4 compatible formatting of doubles} \ - {expr 1e80} \ - 1e+80 -test util-16.1.17.81 {8.4 compatible formatting of doubles} \ - {expr 1e81} \ - 9.9999999999999992e+80 -test util-16.1.17.82 {8.4 compatible formatting of doubles} \ - {expr 1e82} \ - 9.9999999999999996e+81 -test util-16.1.17.83 {8.4 compatible formatting of doubles} \ - {expr 1e83} \ - 1e+83 -test util-16.1.17.84 {8.4 compatible formatting of doubles} \ - {expr 1e84} \ - 1.0000000000000001e+84 -test util-16.1.17.85 {8.4 compatible formatting of doubles} \ - {expr 1e85} \ - 1e+85 -test util-16.1.17.86 {8.4 compatible formatting of doubles} \ - {expr 1e86} \ - 1e+86 -test util-16.1.17.87 {8.4 compatible formatting of doubles} \ - {expr 1e87} \ - 9.9999999999999996e+86 -test util-16.1.17.88 {8.4 compatible formatting of doubles} \ - {expr 1e88} \ - 9.9999999999999996e+87 -test util-16.1.17.89 {8.4 compatible formatting of doubles} \ - {expr 1e89} \ - 9.9999999999999999e+88 -test util-16.1.17.90 {8.4 compatible formatting of doubles} \ - {expr 1e90} \ - 9.9999999999999997e+89 -test util-16.1.17.91 {8.4 compatible formatting of doubles} \ - {expr 1e91} \ - 1.0000000000000001e+91 -test util-16.1.17.92 {8.4 compatible formatting of doubles} \ - {expr 1e92} \ - 1e+92 -test util-16.1.17.93 {8.4 compatible formatting of doubles} \ - {expr 1e93} \ - 1e+93 -test util-16.1.17.94 {8.4 compatible formatting of doubles} \ - {expr 1e94} \ - 1e+94 -test util-16.1.17.95 {8.4 compatible formatting of doubles} \ - {expr 1e95} \ - 1e+95 -test util-16.1.17.96 {8.4 compatible formatting of doubles} \ - {expr 1e96} \ - 1e+96 -test util-16.1.17.97 {8.4 compatible formatting of doubles} \ - {expr 1e97} \ - 1.0000000000000001e+97 -test util-16.1.17.98 {8.4 compatible formatting of doubles} \ - {expr 1e98} \ - 1e+98 -test util-16.1.17.99 {8.4 compatible formatting of doubles} \ - {expr 1e99} \ - 9.9999999999999997e+98 -test util-16.1.17.100 {8.4 compatible formatting of doubles} \ - {expr 1e100} \ - 1e+100 -test util-16.1.17.101 {8.4 compatible formatting of doubles} \ - {expr 1e101} \ - 9.9999999999999998e+100 -test util-16.1.17.102 {8.4 compatible formatting of doubles} \ - {expr 1e102} \ - 9.9999999999999998e+101 -test util-16.1.17.103 {8.4 compatible formatting of doubles} \ - {expr 1e103} \ - 1e+103 -test util-16.1.17.104 {8.4 compatible formatting of doubles} \ - {expr 1e104} \ - 1e+104 -test util-16.1.17.105 {8.4 compatible formatting of doubles} \ - {expr 1e105} \ - 9.9999999999999994e+104 -test util-16.1.17.106 {8.4 compatible formatting of doubles} \ - {expr 1e106} \ - 1.0000000000000001e+106 -test util-16.1.17.107 {8.4 compatible formatting of doubles} \ - {expr 1e107} \ - 9.9999999999999997e+106 -test util-16.1.17.108 {8.4 compatible formatting of doubles} \ - {expr 1e108} \ - 1e+108 -test util-16.1.17.109 {8.4 compatible formatting of doubles} \ - {expr 1e109} \ - 9.9999999999999998e+108 -test util-16.1.17.110 {8.4 compatible formatting of doubles} \ - {expr 1e110} \ - 1e+110 -test util-16.1.17.111 {8.4 compatible formatting of doubles} \ - {expr 1e111} \ - 9.9999999999999996e+110 -test util-16.1.17.112 {8.4 compatible formatting of doubles} \ - {expr 1e112} \ - 9.9999999999999993e+111 -test util-16.1.17.113 {8.4 compatible formatting of doubles} \ - {expr 1e113} \ - 1e+113 -test util-16.1.17.114 {8.4 compatible formatting of doubles} \ - {expr 1e114} \ - 1e+114 -test util-16.1.17.115 {8.4 compatible formatting of doubles} \ - {expr 1e115} \ - 1e+115 -test util-16.1.17.116 {8.4 compatible formatting of doubles} \ - {expr 1e116} \ - 1e+116 -test util-16.1.17.117 {8.4 compatible formatting of doubles} \ - {expr 1e117} \ - 1.0000000000000001e+117 -test util-16.1.17.118 {8.4 compatible formatting of doubles} \ - {expr 1e118} \ - 9.9999999999999997e+117 -test util-16.1.17.119 {8.4 compatible formatting of doubles} \ - {expr 1e119} \ - 9.9999999999999994e+118 -test util-16.1.17.120 {8.4 compatible formatting of doubles} \ - {expr 1e120} \ - 9.9999999999999998e+119 -test util-16.1.17.121 {8.4 compatible formatting of doubles} \ - {expr 1e121} \ - 1e+121 -test util-16.1.17.122 {8.4 compatible formatting of doubles} \ - {expr 1e122} \ - 1e+122 -test util-16.1.17.123 {8.4 compatible formatting of doubles} \ - {expr 1e123} \ - 9.9999999999999998e+122 -test util-16.1.17.124 {8.4 compatible formatting of doubles} \ - {expr 1e124} \ - 9.9999999999999995e+123 -test util-16.1.17.125 {8.4 compatible formatting of doubles} \ - {expr 1e125} \ - 9.9999999999999992e+124 -test util-16.1.17.126 {8.4 compatible formatting of doubles} \ - {expr 1e126} \ - 9.9999999999999992e+125 -test util-16.1.17.127 {8.4 compatible formatting of doubles} \ - {expr 1e127} \ - 9.9999999999999995e+126 -test util-16.1.17.128 {8.4 compatible formatting of doubles} \ - {expr 1e128} \ - 1.0000000000000001e+128 -test util-16.1.17.129 {8.4 compatible formatting of doubles} \ - {expr 1e129} \ - 1e+129 -test util-16.1.17.130 {8.4 compatible formatting of doubles} \ - {expr 1e130} \ - 1.0000000000000001e+130 -test util-16.1.17.131 {8.4 compatible formatting of doubles} \ - {expr 1e131} \ - 9.9999999999999991e+130 -test util-16.1.17.132 {8.4 compatible formatting of doubles} \ - {expr 1e132} \ - 9.9999999999999999e+131 -test util-16.1.17.133 {8.4 compatible formatting of doubles} \ - {expr 1e133} \ - 1e+133 -test util-16.1.17.134 {8.4 compatible formatting of doubles} \ - {expr 1e134} \ - 9.9999999999999992e+133 -test util-16.1.17.135 {8.4 compatible formatting of doubles} \ - {expr 1e135} \ - 9.9999999999999996e+134 -test util-16.1.17.136 {8.4 compatible formatting of doubles} \ - {expr 1e136} \ - 1.0000000000000001e+136 -test util-16.1.17.137 {8.4 compatible formatting of doubles} \ - {expr 1e137} \ - 1e+137 -test util-16.1.17.138 {8.4 compatible formatting of doubles} \ - {expr 1e138} \ - 1e+138 -test util-16.1.17.139 {8.4 compatible formatting of doubles} \ - {expr 1e139} \ - 1e+139 -test util-16.1.17.140 {8.4 compatible formatting of doubles} \ - {expr 1e140} \ - 1.0000000000000001e+140 -test util-16.1.17.141 {8.4 compatible formatting of doubles} \ - {expr 1e141} \ - 1e+141 -test util-16.1.17.142 {8.4 compatible formatting of doubles} \ - {expr 1e142} \ - 1.0000000000000001e+142 -test util-16.1.17.143 {8.4 compatible formatting of doubles} \ - {expr 1e143} \ - 1e+143 -test util-16.1.17.144 {8.4 compatible formatting of doubles} \ - {expr 1e144} \ - 1e+144 -test util-16.1.17.145 {8.4 compatible formatting of doubles} \ - {expr 1e145} \ - 9.9999999999999999e+144 -test util-16.1.17.146 {8.4 compatible formatting of doubles} \ - {expr 1e146} \ - 9.9999999999999993e+145 -test util-16.1.17.147 {8.4 compatible formatting of doubles} \ - {expr 1e147} \ - 9.9999999999999998e+146 -test util-16.1.17.148 {8.4 compatible formatting of doubles} \ - {expr 1e148} \ - 1e+148 -test util-16.1.17.149 {8.4 compatible formatting of doubles} \ - {expr 1e149} \ - 1e+149 -test util-16.1.17.150 {8.4 compatible formatting of doubles} \ - {expr 1e150} \ - 9.9999999999999998e+149 -test util-16.1.17.151 {8.4 compatible formatting of doubles} \ - {expr 1e151} \ - 1e+151 -test util-16.1.17.152 {8.4 compatible formatting of doubles} \ - {expr 1e152} \ - 1e+152 -test util-16.1.17.153 {8.4 compatible formatting of doubles} \ - {expr 1e153} \ - 1e+153 -test util-16.1.17.154 {8.4 compatible formatting of doubles} \ - {expr 1e154} \ - 1e+154 -test util-16.1.17.155 {8.4 compatible formatting of doubles} \ - {expr 1e155} \ - 1e+155 -test util-16.1.17.156 {8.4 compatible formatting of doubles} \ - {expr 1e156} \ - 9.9999999999999998e+155 -test util-16.1.17.157 {8.4 compatible formatting of doubles} \ - {expr 1e157} \ - 9.9999999999999998e+156 -test util-16.1.17.158 {8.4 compatible formatting of doubles} \ - {expr 1e158} \ - 9.9999999999999995e+157 -test util-16.1.17.159 {8.4 compatible formatting of doubles} \ - {expr 1e159} \ - 9.9999999999999993e+158 -test util-16.1.17.160 {8.4 compatible formatting of doubles} \ - {expr 1e160} \ - 1e+160 -test util-16.1.17.161 {8.4 compatible formatting of doubles} \ - {expr 1e161} \ - 1e+161 -test util-16.1.17.162 {8.4 compatible formatting of doubles} \ - {expr 1e162} \ - 9.9999999999999994e+161 -test util-16.1.17.163 {8.4 compatible formatting of doubles} \ - {expr 1e163} \ - 9.9999999999999994e+162 -test util-16.1.17.164 {8.4 compatible formatting of doubles} \ - {expr 1e164} \ - 1e+164 -test util-16.1.17.165 {8.4 compatible formatting of doubles} \ - {expr 1e165} \ - 9.999999999999999e+164 -test util-16.1.17.166 {8.4 compatible formatting of doubles} \ - {expr 1e166} \ - 9.9999999999999994e+165 -test util-16.1.17.167 {8.4 compatible formatting of doubles} \ - {expr 1e167} \ - 1e+167 -test util-16.1.17.168 {8.4 compatible formatting of doubles} \ - {expr 1e168} \ - 9.9999999999999993e+167 -test util-16.1.17.169 {8.4 compatible formatting of doubles} \ - {expr 1e169} \ - 9.9999999999999993e+168 -test util-16.1.17.170 {8.4 compatible formatting of doubles} \ - {expr 1e170} \ - 1e+170 -test util-16.1.17.171 {8.4 compatible formatting of doubles} \ - {expr 1e171} \ - 9.9999999999999995e+170 -test util-16.1.17.172 {8.4 compatible formatting of doubles} \ - {expr 1e172} \ - 1.0000000000000001e+172 -test util-16.1.17.173 {8.4 compatible formatting of doubles} \ - {expr 1e173} \ - 1e+173 -test util-16.1.17.174 {8.4 compatible formatting of doubles} \ - {expr 1e174} \ - 1.0000000000000001e+174 -test util-16.1.17.175 {8.4 compatible formatting of doubles} \ - {expr 1e175} \ - 9.9999999999999994e+174 -test util-16.1.17.176 {8.4 compatible formatting of doubles} \ - {expr 1e176} \ - 1e+176 -test util-16.1.17.177 {8.4 compatible formatting of doubles} \ - {expr 1e177} \ - 1e+177 -test util-16.1.17.178 {8.4 compatible formatting of doubles} \ - {expr 1e178} \ - 1.0000000000000001e+178 -test util-16.1.17.179 {8.4 compatible formatting of doubles} \ - {expr 1e179} \ - 9.9999999999999998e+178 -test util-16.1.17.180 {8.4 compatible formatting of doubles} \ - {expr 1e180} \ - 1e+180 -test util-16.1.17.181 {8.4 compatible formatting of doubles} \ - {expr 1e181} \ - 9.9999999999999992e+180 -test util-16.1.17.182 {8.4 compatible formatting of doubles} \ - {expr 1e182} \ - 1.0000000000000001e+182 -test util-16.1.17.183 {8.4 compatible formatting of doubles} \ - {expr 1e183} \ - 9.9999999999999995e+182 -test util-16.1.17.184 {8.4 compatible formatting of doubles} \ - {expr 1e184} \ - 1e+184 -test util-16.1.17.185 {8.4 compatible formatting of doubles} \ - {expr 1e185} \ - 9.9999999999999998e+184 -test util-16.1.17.186 {8.4 compatible formatting of doubles} \ - {expr 1e186} \ - 9.9999999999999998e+185 -test util-16.1.17.187 {8.4 compatible formatting of doubles} \ - {expr 1e187} \ - 9.9999999999999991e+186 -test util-16.1.17.188 {8.4 compatible formatting of doubles} \ - {expr 1e188} \ - 1e+188 -test util-16.1.17.189 {8.4 compatible formatting of doubles} \ - {expr 1e189} \ - 1e+189 -test util-16.1.17.190 {8.4 compatible formatting of doubles} \ - {expr 1e190} \ - 1.0000000000000001e+190 -test util-16.1.17.191 {8.4 compatible formatting of doubles} \ - {expr 1e191} \ - 1.0000000000000001e+191 -test util-16.1.17.192 {8.4 compatible formatting of doubles} \ - {expr 1e192} \ - 1e+192 -test util-16.1.17.193 {8.4 compatible formatting of doubles} \ - {expr 1e193} \ - 1.0000000000000001e+193 -test util-16.1.17.194 {8.4 compatible formatting of doubles} \ - {expr 1e194} \ - 9.9999999999999994e+193 -test util-16.1.17.195 {8.4 compatible formatting of doubles} \ - {expr 1e195} \ - 9.9999999999999998e+194 -test util-16.1.17.196 {8.4 compatible formatting of doubles} \ - {expr 1e196} \ - 9.9999999999999995e+195 -test util-16.1.17.197 {8.4 compatible formatting of doubles} \ - {expr 1e197} \ - 9.9999999999999995e+196 -test util-16.1.17.198 {8.4 compatible formatting of doubles} \ - {expr 1e198} \ - 1e+198 -test util-16.1.17.199 {8.4 compatible formatting of doubles} \ - {expr 1e199} \ - 1.0000000000000001e+199 -test util-16.1.17.200 {8.4 compatible formatting of doubles} \ - {expr 1e200} \ - 9.9999999999999997e+199 -test util-16.1.17.201 {8.4 compatible formatting of doubles} \ - {expr 1e201} \ - 1e+201 -test util-16.1.17.202 {8.4 compatible formatting of doubles} \ - {expr 1e202} \ - 9.999999999999999e+201 -test util-16.1.17.203 {8.4 compatible formatting of doubles} \ - {expr 1e203} \ - 9.9999999999999999e+202 -test util-16.1.17.204 {8.4 compatible formatting of doubles} \ - {expr 1e204} \ - 9.9999999999999999e+203 -test util-16.1.17.205 {8.4 compatible formatting of doubles} \ - {expr 1e205} \ - 1e+205 -test util-16.1.17.206 {8.4 compatible formatting of doubles} \ - {expr 1e206} \ - 1e+206 -test util-16.1.17.207 {8.4 compatible formatting of doubles} \ - {expr 1e207} \ - 1e+207 -test util-16.1.17.208 {8.4 compatible formatting of doubles} \ - {expr 1e208} \ - 9.9999999999999998e+207 -test util-16.1.17.209 {8.4 compatible formatting of doubles} \ - {expr 1e209} \ - 1.0000000000000001e+209 -test util-16.1.17.210 {8.4 compatible formatting of doubles} \ - {expr 1e210} \ - 9.9999999999999993e+209 -test util-16.1.17.211 {8.4 compatible formatting of doubles} \ - {expr 1e211} \ - 9.9999999999999996e+210 -test util-16.1.17.212 {8.4 compatible formatting of doubles} \ - {expr 1e212} \ - 9.9999999999999991e+211 -test util-16.1.17.213 {8.4 compatible formatting of doubles} \ - {expr 1e213} \ - 9.9999999999999998e+212 -test util-16.1.17.214 {8.4 compatible formatting of doubles} \ - {expr 1e214} \ - 9.9999999999999995e+213 -test util-16.1.17.215 {8.4 compatible formatting of doubles} \ - {expr 1e215} \ - 9.9999999999999991e+214 -test util-16.1.17.216 {8.4 compatible formatting of doubles} \ - {expr 1e216} \ - 1e+216 -test util-16.1.17.217 {8.4 compatible formatting of doubles} \ - {expr 1e217} \ - 9.9999999999999996e+216 -test util-16.1.17.218 {8.4 compatible formatting of doubles} \ - {expr 1e218} \ - 1.0000000000000001e+218 -test util-16.1.17.219 {8.4 compatible formatting of doubles} \ - {expr 1e219} \ - 9.9999999999999997e+218 -test util-16.1.17.220 {8.4 compatible formatting of doubles} \ - {expr 1e220} \ - 1e+220 -test util-16.1.17.221 {8.4 compatible formatting of doubles} \ - {expr 1e221} \ - 1e+221 -test util-16.1.17.222 {8.4 compatible formatting of doubles} \ - {expr 1e222} \ - 1e+222 -test util-16.1.17.223 {8.4 compatible formatting of doubles} \ - {expr 1e223} \ - 1e+223 -test util-16.1.17.224 {8.4 compatible formatting of doubles} \ - {expr 1e224} \ - 9.9999999999999997e+223 -test util-16.1.17.225 {8.4 compatible formatting of doubles} \ - {expr 1e225} \ - 9.9999999999999993e+224 -test util-16.1.17.226 {8.4 compatible formatting of doubles} \ - {expr 1e226} \ - 9.9999999999999996e+225 -test util-16.1.17.227 {8.4 compatible formatting of doubles} \ - {expr 1e227} \ - 1.0000000000000001e+227 -test util-16.1.17.228 {8.4 compatible formatting of doubles} \ - {expr 1e228} \ - 9.9999999999999992e+227 -test util-16.1.17.229 {8.4 compatible formatting of doubles} \ - {expr 1e229} \ - 9.9999999999999999e+228 -test util-16.1.17.230 {8.4 compatible formatting of doubles} \ - {expr 1e230} \ - 1.0000000000000001e+230 -test util-16.1.17.231 {8.4 compatible formatting of doubles} \ - {expr 1e231} \ - 1.0000000000000001e+231 -test util-16.1.17.232 {8.4 compatible formatting of doubles} \ - {expr 1e232} \ - 1.0000000000000001e+232 -test util-16.1.17.233 {8.4 compatible formatting of doubles} \ - {expr 1e233} \ - 9.9999999999999997e+232 -test util-16.1.17.234 {8.4 compatible formatting of doubles} \ - {expr 1e234} \ - 1e+234 -test util-16.1.17.235 {8.4 compatible formatting of doubles} \ - {expr 1e235} \ - 1.0000000000000001e+235 -test util-16.1.17.236 {8.4 compatible formatting of doubles} \ - {expr 1e236} \ - 1.0000000000000001e+236 -test util-16.1.17.237 {8.4 compatible formatting of doubles} \ - {expr 1e237} \ - 9.9999999999999994e+236 -test util-16.1.17.238 {8.4 compatible formatting of doubles} \ - {expr 1e238} \ - 1e+238 -test util-16.1.17.239 {8.4 compatible formatting of doubles} \ - {expr 1e239} \ - 9.9999999999999999e+238 -test util-16.1.17.240 {8.4 compatible formatting of doubles} \ - {expr 1e240} \ - 1e+240 -test util-16.1.17.241 {8.4 compatible formatting of doubles} \ - {expr 1e241} \ - 1.0000000000000001e+241 -test util-16.1.17.242 {8.4 compatible formatting of doubles} \ - {expr 1e242} \ - 1.0000000000000001e+242 -test util-16.1.17.243 {8.4 compatible formatting of doubles} \ - {expr 1e243} \ - 1.0000000000000001e+243 -test util-16.1.17.244 {8.4 compatible formatting of doubles} \ - {expr 1e244} \ - 1.0000000000000001e+244 -test util-16.1.17.245 {8.4 compatible formatting of doubles} \ - {expr 1e245} \ - 1e+245 -test util-16.1.17.246 {8.4 compatible formatting of doubles} \ - {expr 1e246} \ - 1.0000000000000001e+246 -test util-16.1.17.247 {8.4 compatible formatting of doubles} \ - {expr 1e247} \ - 9.9999999999999995e+246 -test util-16.1.17.248 {8.4 compatible formatting of doubles} \ - {expr 1e248} \ - 1e+248 -test util-16.1.17.249 {8.4 compatible formatting of doubles} \ - {expr 1e249} \ - 9.9999999999999992e+248 -test util-16.1.17.250 {8.4 compatible formatting of doubles} \ - {expr 1e250} \ - 9.9999999999999992e+249 -test util-16.1.17.251 {8.4 compatible formatting of doubles} \ - {expr 1e251} \ - 1e+251 -test util-16.1.17.252 {8.4 compatible formatting of doubles} \ - {expr 1e252} \ - 1.0000000000000001e+252 -test util-16.1.17.253 {8.4 compatible formatting of doubles} \ - {expr 1e253} \ - 9.9999999999999994e+252 -test util-16.1.17.254 {8.4 compatible formatting of doubles} \ - {expr 1e254} \ - 9.9999999999999994e+253 -test util-16.1.17.255 {8.4 compatible formatting of doubles} \ - {expr 1e255} \ - 9.9999999999999999e+254 -test util-16.1.17.256 {8.4 compatible formatting of doubles} \ - {expr 1e256} \ - 1e+256 -test util-16.1.17.257 {8.4 compatible formatting of doubles} \ - {expr 1e257} \ - 1e+257 -test util-16.1.17.258 {8.4 compatible formatting of doubles} \ - {expr 1e258} \ - 1.0000000000000001e+258 -test util-16.1.17.259 {8.4 compatible formatting of doubles} \ - {expr 1e259} \ - 9.9999999999999993e+258 -test util-16.1.17.260 {8.4 compatible formatting of doubles} \ - {expr 1e260} \ - 1.0000000000000001e+260 -test util-16.1.17.261 {8.4 compatible formatting of doubles} \ - {expr 1e261} \ - 9.9999999999999993e+260 -test util-16.1.17.262 {8.4 compatible formatting of doubles} \ - {expr 1e262} \ - 1e+262 -test util-16.1.17.263 {8.4 compatible formatting of doubles} \ - {expr 1e263} \ - 1e+263 -test util-16.1.17.264 {8.4 compatible formatting of doubles} \ - {expr 1e264} \ - 1e+264 -test util-16.1.17.265 {8.4 compatible formatting of doubles} \ - {expr 1e265} \ - 1.0000000000000001e+265 -test util-16.1.17.266 {8.4 compatible formatting of doubles} \ - {expr 1e266} \ - 1e+266 -test util-16.1.17.267 {8.4 compatible formatting of doubles} \ - {expr 1e267} \ - 9.9999999999999997e+266 -test util-16.1.17.268 {8.4 compatible formatting of doubles} \ - {expr 1e268} \ - 9.9999999999999997e+267 -test util-16.1.17.269 {8.4 compatible formatting of doubles} \ - {expr 1e269} \ - 1e+269 -test util-16.1.17.270 {8.4 compatible formatting of doubles} \ - {expr 1e270} \ - 1e+270 -test util-16.1.17.271 {8.4 compatible formatting of doubles} \ - {expr 1e271} \ - 9.9999999999999995e+270 -test util-16.1.17.272 {8.4 compatible formatting of doubles} \ - {expr 1e272} \ - 1.0000000000000001e+272 -test util-16.1.17.273 {8.4 compatible formatting of doubles} \ - {expr 1e273} \ - 9.9999999999999995e+272 -test util-16.1.17.274 {8.4 compatible formatting of doubles} \ - {expr 1e274} \ - 9.9999999999999992e+273 -test util-16.1.17.275 {8.4 compatible formatting of doubles} \ - {expr 1e275} \ - 9.9999999999999996e+274 -test util-16.1.17.276 {8.4 compatible formatting of doubles} \ - {expr 1e276} \ - 1.0000000000000001e+276 -test util-16.1.17.277 {8.4 compatible formatting of doubles} \ - {expr 1e277} \ - 1e+277 -test util-16.1.17.278 {8.4 compatible formatting of doubles} \ - {expr 1e278} \ - 9.9999999999999996e+277 -test util-16.1.17.279 {8.4 compatible formatting of doubles} \ - {expr 1e279} \ - 1.0000000000000001e+279 -test util-16.1.17.280 {8.4 compatible formatting of doubles} \ - {expr 1e280} \ - 1e+280 -test util-16.1.17.281 {8.4 compatible formatting of doubles} \ - {expr 1e281} \ - 1e+281 -test util-16.1.17.282 {8.4 compatible formatting of doubles} \ - {expr 1e282} \ - 1e+282 -test util-16.1.17.283 {8.4 compatible formatting of doubles} \ - {expr 1e283} \ - 9.9999999999999996e+282 -test util-16.1.17.284 {8.4 compatible formatting of doubles} \ - {expr 1e284} \ - 1.0000000000000001e+284 -test util-16.1.17.285 {8.4 compatible formatting of doubles} \ - {expr 1e285} \ - 9.9999999999999998e+284 -test util-16.1.17.286 {8.4 compatible formatting of doubles} \ - {expr 1e286} \ - 1e+286 -test util-16.1.17.287 {8.4 compatible formatting of doubles} \ - {expr 1e287} \ - 1.0000000000000001e+287 -test util-16.1.17.288 {8.4 compatible formatting of doubles} \ - {expr 1e288} \ - 1e+288 -test util-16.1.17.289 {8.4 compatible formatting of doubles} \ - {expr 1e289} \ - 1.0000000000000001e+289 -test util-16.1.17.290 {8.4 compatible formatting of doubles} \ - {expr 1e290} \ - 1.0000000000000001e+290 -test util-16.1.17.291 {8.4 compatible formatting of doubles} \ - {expr 1e291} \ - 9.9999999999999996e+290 -test util-16.1.17.292 {8.4 compatible formatting of doubles} \ - {expr 1e292} \ - 1e+292 -test util-16.1.17.293 {8.4 compatible formatting of doubles} \ - {expr 1e293} \ - 9.9999999999999992e+292 -test util-16.1.17.294 {8.4 compatible formatting of doubles} \ - {expr 1e294} \ - 1.0000000000000001e+294 -test util-16.1.17.295 {8.4 compatible formatting of doubles} \ - {expr 1e295} \ - 9.9999999999999998e+294 -test util-16.1.17.296 {8.4 compatible formatting of doubles} \ - {expr 1e296} \ - 9.9999999999999998e+295 -test util-16.1.17.297 {8.4 compatible formatting of doubles} \ - {expr 1e297} \ - 1e+297 -test util-16.1.17.298 {8.4 compatible formatting of doubles} \ - {expr 1e298} \ - 9.9999999999999996e+297 -test util-16.1.17.299 {8.4 compatible formatting of doubles} \ - {expr 1e299} \ - 1.0000000000000001e+299 -test util-16.1.17.300 {8.4 compatible formatting of doubles} \ - {expr 1e300} \ - 1.0000000000000001e+300 -test util-16.1.17.301 {8.4 compatible formatting of doubles} \ - {expr 1e301} \ - 1.0000000000000001e+301 -test util-16.1.17.302 {8.4 compatible formatting of doubles} \ - {expr 1e302} \ - 1.0000000000000001e+302 -test util-16.1.17.303 {8.4 compatible formatting of doubles} \ - {expr 1e303} \ - 1e+303 -test util-16.1.17.304 {8.4 compatible formatting of doubles} \ - {expr 1e304} \ - 9.9999999999999994e+303 -test util-16.1.17.305 {8.4 compatible formatting of doubles} \ - {expr 1e305} \ - 9.9999999999999994e+304 -test util-16.1.17.306 {8.4 compatible formatting of doubles} \ - {expr 1e306} \ - 1e+306 -test util-16.1.17.307 {8.4 compatible formatting of doubles} \ - {expr 1e307} \ - 9.9999999999999999e+306 - test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} { set r {} foreach {input} { @@ -4040,8 +2139,6 @@ test util-18.12 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %Id" 65537 } {65537 65537} -set ::tcl_precision $saved_precision - # cleanup ::tcltest::cleanupTests return -- cgit v0.12 From 3f1dfde45f60e800df7a1ac981cf91fa2b25874b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2017 12:17:33 +0000 Subject: Don't do same test twice --- generic/tclStringObj.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index da2f06f..a5b289c 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1968,7 +1968,6 @@ Tcl_AppendFormatToObj( ch = 'd'; } } - if (mp_cmp_d(&big, 0) == MP_EQ) gotHash = 0; #ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { -- cgit v0.12 From 21877b851cd37a74cf2bff60aeea082cdfa0bafd Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 6 Dec 2017 13:28:12 +0000 Subject: Adapt the bytearray accommodation of Tcl_CharLength() for 8.7+. --- generic/tclStringObj.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 85cac83..385ce4f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -421,13 +421,14 @@ Tcl_GetCharLength( * Optimize the case where we're really dealing with a bytearray object; * we don't need to convert to a string to perform the get-length operation. * - * NOTE that we do not need the bytearray to be "pure". A ByteArray value - * with a string rep cannot be trusted to represent the same value as the - * string rep, but it *can* be trusted to have the same character length - * as the string rep, which is all this routine cares about. + * Starting in Tcl 8.7, we check for a "pure" bytearray, because the + * machinery behind that test is using a proper bytearray ObjType. We + * could also compute length of an improper bytearray without shimmering + * but there's no value in that. We *want* to shimmer an improper bytearray + * because improper bytearrays have worthless internal reps. */ - if (objPtr->typePtr == &tclByteArrayType) { + if (TclIsPureByteArray(objPtr)) { int length; (void) Tcl_GetByteArrayFromObj(objPtr, &length); -- cgit v0.12 From acb6a88df555fe8bdf2271bdbddb5fe19046b6c2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2017 15:40:52 +0000 Subject: doc fixes --- doc/Utf.3 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/Utf.3 b/doc/Utf.3 index 82760aa..31784a9 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -31,10 +31,10 @@ int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int -\fBTcl_UniCharNcmp\fR(\fIucs, uct, length\fR) +\fBTcl_UniCharNcmp\fR(\fIucs, uct, uniLength\fR) .sp int -\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, length\fR) +\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, uniLength\fR) .sp int \fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR) @@ -96,7 +96,7 @@ A null-terminated Unicode string. A null-terminated Unicode string. .AP size_t length in The length of the UTF-8 string in bytes (not UTF-8 characters). If -negative, all bytes up to the first null byte are used. +-1, all bytes up to the first null byte are used. .AP size_t uniLength in The length of the Unicode string in characters. Must be greater than or equal to 0. @@ -167,7 +167,7 @@ the number of Unicode characters (not bytes) in that string. \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accept two null-terminated Unicode strings and the number of characters -to compare. Both strings are assumed to be at least \fIlength\fR characters +to compare. Both strings are assumed to be at least \fIuniLength\fR characters long. \fBTcl_UniCharNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal -- cgit v0.12 From e58661a87eef32ac9433350b64c803fdc99d063a Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 10 Dec 2017 00:01:01 +0000 Subject: Ensure that an automatically-named TclOO object has the same name as its namespace. --- generic/tclOO.c | 3 +++ tests/oo.test | 4 ++++ 2 files changed, 7 insertions(+) diff --git a/generic/tclOO.c b/generic/tclOO.c index 84380e0..1d7ecb6 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -655,6 +655,9 @@ AllocObject( if (!nameStr) { nameStr = oPtr->namespacePtr->name; nsPtr = (Namespace *)oPtr->namespacePtr; + if (nsPtr->parentPtr != NULL) { + nsPtr = nsPtr->parentPtr; + } } oPtr->command = TclCreateObjCommandInNs(interp, nameStr, (Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL); diff --git a/tests/oo.test b/tests/oo.test index b9c5067..a8257fd 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -131,6 +131,10 @@ test oo-1.4 {basic test of OO functionality} -body { test oo-1.4.1 {fully-qualified nested name} -body { oo::object create ::one::two::three } -result {::one::two::three} +test oo-1.4.2 {automatic command name has same name as namespace} -body { + set obj [oo::object new] + expr {[info object namespace $obj] == $obj} +} -result 1 test oo-1.5 {basic test of OO functionality} -body { oo::object doesnotexist } -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new} -- cgit v0.12 From dfeacc8edb1494b531c9bdbe41a83aa89a557198 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 10 Dec 2017 14:35:02 +0000 Subject: Fix [040586323610be22f8617962377324f4ddc9bc02|0405863236]: wrong field checked in struct pollfd in TclUnixWaitForFile --- unix/tclUnixNotfy.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 5bc753a..b7df740 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -532,13 +532,13 @@ TclUnixWaitForFile( numFound = poll(pollFds, 1, pollTimeout); if (numFound == 1) { result = 0; - if (pollFds[0].events & (POLLIN | POLLHUP)) { + if (pollFds[0].revents & (POLLIN | POLLHUP)) { result |= TCL_READABLE; } - if (pollFds[0].events & POLLOUT) { + if (pollFds[0].revents & POLLOUT) { result |= TCL_WRITABLE; } - if (pollFds[0].events & POLLERR) { + if (pollFds[0].revents & POLLERR) { result |= TCL_EXCEPTION; } if (result) { -- cgit v0.12 From 2555e0d7e6f980833f0369e83b81b0c37050c3f5 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 10 Dec 2017 21:45:26 +0000 Subject: Streamline TclOO object cleanup routines. --- generic/tclBasic.c | 2 + generic/tclOO.c | 619 ++++++++++++++++++---------------------------- generic/tclOOBasic.c | 5 - generic/tclOOCall.c | 4 +- generic/tclOODefineCmds.c | 62 ++++- generic/tclOOInt.h | 46 ++-- tests/oo.test | 13 +- 7 files changed, 326 insertions(+), 425 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index eceea31..a23100e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3152,6 +3152,8 @@ Tcl_DeleteCommandFromToken( */ cmdPtr->nsPtr->refCount++; + + cmdPtr->nsPtr->refCount++; if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); diff --git a/generic/tclOO.c b/generic/tclOO.c index 84380e0..ae1ae3f 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -60,8 +60,6 @@ static const struct { static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj); static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, Namespace *nsPtr, const char *nsNameStr); -static void ClearMixins(Class *clsPtr); -static void ClearSuperclasses(Class *clsPtr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); @@ -73,6 +71,7 @@ static void DeletedHelpersNamespace(ClientData clientData); static Tcl_NRPostProc FinalizeAlloc; static Tcl_NRPostProc FinalizeNext; static Tcl_NRPostProc FinalizeObjectCall; +static void initClassPath(Tcl_Interp * interp, Class *clsPtr); static int InitFoundation(Tcl_Interp *interp); static void KillFoundation(ClientData clientData, Tcl_Interp *interp); @@ -82,6 +81,7 @@ static void ObjectRenamedTrace(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); +static void DeleteDescendants(Tcl_Interp *interp,Object *oPtr); static inline void SquelchCachedName(Object *oPtr); static int PublicObjectCmd(ClientData clientData, @@ -96,6 +96,8 @@ static int PrivateObjectCmd(ClientData clientData, static int PrivateNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +static void RemoveClass(Class ** list, int num, int idx); +static void RemoveObject(Object ** list, int num, int idx); /* * Methods in the oo::object and oo::class classes. First, we define a helper @@ -228,10 +230,14 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; * ROOT_CLASS respectively. */ -#define Deleted(oPtr) (((Object *)(oPtr))->command == NULL) +#define Deleted(oPtr) ((oPtr)->flags & OBJECT_DELETED) #define IsRootObject(ocPtr) ((ocPtr)->flags & ROOT_OBJECT) #define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS) #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) + +#define RemoveItem(type, lst, i) \ + Remove ## type ((lst).list, (lst).num, i); \ + (lst).num-- /* * ---------------------------------------------------------------------- @@ -313,6 +319,10 @@ InitFoundation( Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); Foundation *fPtr = ckalloc(sizeof(Foundation)); Tcl_Obj *namePtr, *argsPtr, *bodyPtr; + + Class fakeCls; + Object fakeObject; + Tcl_DString buffer; Command *cmdPtr; int i; @@ -379,24 +389,43 @@ InitFoundation( * spliced manually. */ + /* Stand up a phony class for bootstrapping. */ + fPtr->objectCls = &fakeCls; + /* referenced in AllocClass to increment the refCount. */ + fakeCls.thisPtr = &fakeObject; + fPtr->objectCls = AllocClass(interp, AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); fPtr->classCls = AllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); + + /* Rewire bootstrapped objects. */ fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; + fPtr->classCls->thisPtr->selfCls = fPtr->classCls; + + AddRef(fPtr->objectCls->thisPtr); + AddRef(fPtr->classCls->thisPtr); + AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr); + AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr); + + /* special initialization for the primordial objects */ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; + + /* This is why it is unnecessary in this routine to make up for the + * incremented reference count of fPtr->objectCls that was sallwed by + * fakeObject. */ fPtr->objectCls->superclasses.num = 0; ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; - fPtr->classCls->thisPtr->selfCls = fPtr->classCls; + fPtr->classCls->thisPtr->flags |= ROOT_CLASS; fPtr->classCls->flags |= ROOT_CLASS; + + /* Standard initialization for new Objects */ TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); - AddRef(fPtr->objectCls->thisPtr); - AddRef(fPtr->objectCls); /* * Basic method declarations for the core classes. @@ -522,8 +551,6 @@ KillFoundation( { Foundation *fPtr = GetFoundation(interp); - DelRef(fPtr->objectCls->thisPtr); - DelRef(fPtr->objectCls); TclDecrRefCount(fPtr->unknownMethodNameObj); TclDecrRefCount(fPtr->constructorName); TclDecrRefCount(fPtr->destructorName); @@ -538,8 +565,11 @@ KillFoundation( * AllocObject -- * * Allocate an object of basic type. Does not splice the object into its - * class's instance list. The caller must set the classPtr on the object, - * either to a class or to NULL. + * class's instance list. The caller must set the classPtr on the object + * to either a class or NULL, call TclOOAddToInstances to add the object + * to the class's instance list, and if the object itself is a class, use + * call TclOOAddToSubclasses() to add it to the right class's list of + * subclasses. * * ---------------------------------------------------------------------- */ @@ -564,7 +594,7 @@ AllocObject( Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - int creationEpoch, ignored; + int creationEpoch; oPtr = ckalloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); @@ -641,9 +671,15 @@ AllocObject( */ oPtr->fPtr = fPtr; - oPtr->selfCls = fPtr->objectCls; oPtr->creationEpoch = creationEpoch; - oPtr->refCount = 1; + + /* + * An object starts life with a refCount of 2 to mark the two stages of + * destruction it occur: A call to ObjectRenamedTrace(), and a call to + * ObjectNamespaceDeleted(). + */ + oPtr->refCount = 2; + oPtr->flags = USE_CLASS_CACHE; /* @@ -655,6 +691,10 @@ AllocObject( if (!nameStr) { nameStr = oPtr->namespacePtr->name; nsPtr = (Namespace *)oPtr->namespacePtr; + if (nsPtr->parentPtr != NULL) { + nsPtr = nsPtr->parentPtr; + } + } oPtr->command = TclCreateObjCommandInNs(interp, nameStr, (Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL); @@ -673,26 +713,8 @@ AllocObject( tracePtr->nextPtr = NULL; tracePtr->refCount = 1; - /* - * Access the namespace command table directly when creating "my" to avoid - * a bottleneck in string manipulation. Another abstraction-buster. - */ - - cmdPtr = ckalloc(sizeof(Command)); - memset(cmdPtr, 0, sizeof(Command)); - cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr; - cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my", - &ignored); - cmdPtr->refCount = 1; - cmdPtr->objProc = PrivateObjectCmd; - cmdPtr->deleteProc = MyDeleted; - cmdPtr->objClientData = cmdPtr->deleteData = oPtr; - cmdPtr->proc = TclInvokeObjectCommand; - cmdPtr->clientData = cmdPtr; - cmdPtr->nreProc = PrivateNRObjectCmd; - Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr); - oPtr->myCommand = (Tcl_Command) cmdPtr; - + oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr, + PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted); return oPtr; } @@ -774,88 +796,20 @@ ObjectRenamedTrace( /* * The namespace is only deleted if it hasn't already been deleted. [Bug - * 2950259]. If the namespace has already been deleted, then - * ObjectNamespaceDeleted() has already cleaned up this command. + * 2950259]. */ - if (oPtr->namespacePtr == NULL) { - /* - * ObjectNamespaceDeleted() has already done all the cleanup, but - * detected that the command was in the process of being deleted, and - * left the pointer allocated for us. - */ - DelRef(oPtr); - } else { - if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc == NULL) { - /* - * ObjectNamespaceDeleted() called us, and still has some work to - * do, so we leave the pointer allocated for it to finish, and then - * it will deallocate the pointer. - */ - } else { - Tcl_DeleteNamespace(oPtr->namespacePtr); - /* - * ObjectNamespaceDeleted() doesn't know it was us that just - * called, so it left the pointer allocated. - */ - DelRef(oPtr); - } + if (!Deleted(oPtr)) { + Tcl_DeleteNamespace(oPtr->namespacePtr); } + oPtr->command = NULL; + TclOODecrRefCount(oPtr); return; } /* * ---------------------------------------------------------------------- * - * ClearMixins, ClearSuperclasses -- - * - * Utility functions for correctly clearing the list of mixins or - * superclasses of a class. Will ckfree() the list storage. - * - * ---------------------------------------------------------------------- - */ - -static void -ClearMixins( - Class *clsPtr) -{ - int i; - Class *mixinPtr; - - if (clsPtr->mixins.num == 0) { - return; - } - - FOREACH(mixinPtr, clsPtr->mixins) { - TclOORemoveFromMixinSubs(clsPtr, mixinPtr); - } - ckfree(clsPtr->mixins.list); - clsPtr->mixins.list = NULL; - clsPtr->mixins.num = 0; -} - -static void -ClearSuperclasses( - Class *clsPtr) -{ - int i; - Class *superPtr; - - if (clsPtr->superclasses.num == 0) { - return; - } - - FOREACH(superPtr, clsPtr->superclasses) { - TclOORemoveFromSubclasses(clsPtr, superPtr); - } - ckfree(clsPtr->superclasses.list); - clsPtr->superclasses.list = NULL; - clsPtr->superclasses.num = 0; -} - -/* - * ---------------------------------------------------------------------- - * * ReleaseClassContents -- * * Tear down the special class data structure, including deleting all @@ -865,122 +819,39 @@ ClearSuperclasses( */ static void -ReleaseClassContents( +DeleteDescendants( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { - FOREACH_HASH_DECLS; - int i; - Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr; + Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr; Object *instancePtr; - Method *mPtr; - Foundation *fPtr = oPtr->fPtr; - Tcl_Obj *variableObj; - - /* - * Sanity check! - */ - - if (!Deleted(oPtr)) { - if (IsRootClass(oPtr)) { - Tcl_Panic("deleting class structure for non-deleted %s", - "::oo::class"); - } else if (IsRootObject(oPtr)) { - Tcl_Panic("deleting class structure for non-deleted %s", - "::oo::object"); - } else { - Tcl_Panic("deleting class structure for non-deleted %s", - "general object"); - } - } - - /* - * Lock a number of dependent objects until we've stopped putting our - * fingers in them. - */ - - FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) { - if (mixinSubclassPtr != NULL) { - AddRef(mixinSubclassPtr); - AddRef(mixinSubclassPtr->thisPtr); - } - } - FOREACH(subclassPtr, clsPtr->subclasses) { - if (subclassPtr != NULL && !IsRoot(subclassPtr)) { - AddRef(subclassPtr); - AddRef(subclassPtr->thisPtr); - } - } - if (!IsRootClass(oPtr)) { - FOREACH(instancePtr, clsPtr->instances) { - if (instancePtr != oPtr) { - int j; - if (instancePtr->selfCls == clsPtr) { - instancePtr->flags |= CLASS_GONE; - } - for(j=0 ; jmixins.num ; j++) { - Class *mixin = instancePtr->mixins.list[j]; - Class *nextMixin = NULL; - if (mixin == clsPtr) { - if (j < instancePtr->mixins.num - 1) { - nextMixin = instancePtr->mixins.list[j+1]; - } - if (j == 0) { - instancePtr->mixins.num = 0; - instancePtr->mixins.list = NULL; - } else { - instancePtr->mixins.list[j-1] = nextMixin; - } - instancePtr->mixins.num -= 1; - } - } - if (instancePtr != NULL && !IsRoot(instancePtr)) { - AddRef(instancePtr); - } - } - } - } + int i; /* * Squelch classes that this class has been mixed into. */ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) { - if (mixinSubclassPtr != clsPtr) { - if (!Deleted(mixinSubclassPtr->thisPtr)) { - Tcl_DeleteCommandFromToken(interp, - mixinSubclassPtr->thisPtr->command); - } - ClearMixins(mixinSubclassPtr); - DelRef(mixinSubclassPtr->thisPtr); - DelRef(mixinSubclassPtr); + /* This condition also covers the case where mixinSubclassPtr == + * clsPtr + */ + if (!Deleted(mixinSubclassPtr->thisPtr)) { + Tcl_DeleteCommandFromToken(interp, + mixinSubclassPtr->thisPtr->command); } + i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); + TclOODecrRefCount(mixinSubclassPtr->thisPtr); } - if (clsPtr->mixinSubs.list != NULL) { - ckfree(clsPtr->mixinSubs.list); - clsPtr->mixinSubs.list = NULL; - clsPtr->mixinSubs.num = 0; - } - /* * Squelch subclasses of this class. */ FOREACH(subclassPtr, clsPtr->subclasses) { - if (IsRoot(subclassPtr)) { - continue; - } - if (!Deleted(subclassPtr->thisPtr)) { + if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } - ClearSuperclasses(subclassPtr); - DelRef(subclassPtr->thisPtr); - DelRef(subclassPtr); - } - if (clsPtr->subclasses.list != NULL) { - ckfree(clsPtr->subclasses.list); - clsPtr->subclasses.list = NULL; - clsPtr->subclasses.num = 0; + i -= TclOORemoveFromSubclasses(subclassPtr, clsPtr); + TclOODecrRefCount(subclassPtr->thisPtr); } /* @@ -989,35 +860,43 @@ ReleaseClassContents( if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { - if (instancePtr != oPtr) { - if (instancePtr == NULL || IsRoot(instancePtr)) { - continue; - } - if (!Deleted(instancePtr)) { - Tcl_DeleteCommandFromToken(interp, instancePtr->command); - /* - * Tcl_DeleteCommandFromToken() may have done to whole - * job for us. Roll back and check again. - */ - i--; - continue; - } - DelRef(instancePtr); + /* This condition also covers the case where instancePtr == oPtr */ + if (!Deleted(instancePtr) && !IsRoot(instancePtr)) { + Tcl_DeleteCommandFromToken(interp, instancePtr->command); } + i -= TclOORemoveFromInstances(instancePtr, clsPtr); } } - if (clsPtr->instances.list != NULL) { - ckfree(clsPtr->instances.list); - clsPtr->instances.list = NULL; - clsPtr->instances.num = 0; - } +} + + +static void +ReleaseClassContents( + Tcl_Interp *interp, /* The interpreter containing the class. */ + Object *oPtr) /* The object representing the class. */ +{ + FOREACH_HASH_DECLS; + int i; + Class *clsPtr = oPtr->classPtr, *tmpClsPtr; + Method *mPtr; + Foundation *fPtr = oPtr->fPtr; + Tcl_Obj *variableObj; /* - * Special: We delete these after everything else. + * Sanity check! */ - if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) { - Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command); + if (!Deleted(oPtr)) { + if (IsRootClass(oPtr)) { + Tcl_Panic("deleting class structure for non-deleted %s", + "::oo::class"); + } else if (IsRootObject(oPtr)) { + Tcl_Panic("deleting class structure for non-deleted %s", + "::oo::object"); + } else { + Tcl_Panic("deleting class structure for non-deleted %s", + "general object"); + } } /* @@ -1073,8 +952,12 @@ ReleaseClassContents( clsPtr->metadataPtr = NULL; } - ClearMixins(clsPtr); - ClearSuperclasses(clsPtr); + FOREACH(tmpClsPtr, clsPtr->mixins) { + TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); + } + FOREACH(tmpClsPtr, clsPtr->superclasses) { + TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); + } FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { TclOODelMethodRef(mPtr); @@ -1090,12 +973,9 @@ ReleaseClassContents( ckfree(clsPtr->variables.list); } - /* Tell oPtr that it's class is gone so that it doesn't try to remove - * itself from it's classe's list of instances - */ - oPtr->flags |= CLASS_GONE; - DelRef(clsPtr); - + if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) { + Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command); + } } /* @@ -1123,13 +1003,26 @@ ObjectNamespaceDeleted( Method *mPtr; Tcl_Obj *filterObj, *variableObj; Tcl_Interp *interp = oPtr->fPtr->interp; - int finished = 0, i; + int i; + if (Deleted(oPtr)) { + /* To do: Can ObjectNamespaceDeleted ever be called twice? If not, + * this guard could be removed. + */ + return; + } - AddRef(fPtr->classCls); - AddRef(fPtr->objectCls); - AddRef(fPtr->classCls->thisPtr); - AddRef(fPtr->objectCls->thisPtr); + /* + * One rule for the teardown routines is that if an object is in the + * process of being deleted, nothing else may modify its bookeeping + * records. This is the flag that + */ + oPtr->flags |= OBJECT_DELETED; + + /* Let the dominoes fall */ + if (oPtr->classPtr) { + DeleteDescendants(interp, oPtr); + } /* * We do not run destructors on the core class objects when the @@ -1137,15 +1030,14 @@ ObjectNamespaceDeleted( * in that case when the destructor is partially deleted before the uses * of it have gone. [Bug 2949397] */ - - if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) { + if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); int result; Tcl_InterpState state; - oPtr->flags |= DESTRUCTOR_CALLED; + if (contextPtr != NULL) { contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; @@ -1167,7 +1059,7 @@ ObjectNamespaceDeleted( * points into freed memory. */ - if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) { + if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) { /* * Something has already started the command deletion process. We can * go ahead and clean up the the namespace, @@ -1178,9 +1070,7 @@ ObjectNamespaceDeleted( * as well. */ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); - finished = 1; } - oPtr->command = NULL; if (oPtr->myCommand) { Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand); @@ -1191,14 +1081,13 @@ ObjectNamespaceDeleted( * methods on the object. */ - if (!IsRootObject(oPtr) && !(oPtr->flags & CLASS_GONE)) { - TclOORemoveFromInstances(oPtr, oPtr->selfCls); - } + /* To do: Get dkf to weigh in on wether this should be protected with a + * !IsRoot() condition. + */ + TclOORemoveFromInstances(oPtr, oPtr->selfCls); FOREACH(mixinPtr, oPtr->mixins) { - if (mixinPtr && mixinPtr != oPtr->classPtr) { - TclOORemoveFromInstances(oPtr, mixinPtr); - } + i -= TclOORemoveFromInstances(oPtr, mixinPtr); } if (i) { ckfree(oPtr->mixins.list); @@ -1258,8 +1147,9 @@ ObjectNamespaceDeleted( * classes, if one goes the other must too and yet the tangle can * sometimes not go away automatically; we force it here. [Bug 2962664] */ - if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr) - && !Deleted(fPtr->classCls->thisPtr)) { + if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr) + && !Tcl_InterpDeleted(interp)) { + Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } @@ -1267,35 +1157,59 @@ ObjectNamespaceDeleted( ReleaseClassContents(interp, oPtr); } - /* * Delete the object structure itself. */ - oPtr->classPtr = NULL; oPtr->namespacePtr = NULL; - - DelRef(fPtr->classCls->thisPtr); - DelRef(fPtr->objectCls->thisPtr); - DelRef(fPtr->classCls); - DelRef(fPtr->objectCls); - if (finished) { - /* - * ObjectRenamedTrace called us, and not the other way around. - */ - DelRef(oPtr); - } else { - /* - * ObjectRenamedTrace will call DelRef(oPtr). - */ - } + oPtr->selfCls = NULL; + TclOODecrRefCount(oPtr); return; - } /* * ---------------------------------------------------------------------- * + * TclOODecrRef -- + * + * Decrement the refcount of an object and deallocate storage then object + * is no longer referenced. Returns 1 if storage was deallocated, and 0 + * otherwise. + * + * ---------------------------------------------------------------------- + */ +int TclOODecrRefCount(Object *oPtr) { + if (oPtr->refCount-- <= 1) { + Class *clsPtr = oPtr->classPtr; + if (oPtr->classPtr != NULL) { + ckfree(clsPtr->superclasses.list); + ckfree(clsPtr->subclasses.list); + ckfree(clsPtr->instances.list); + ckfree(clsPtr->mixinSubs.list); + ckfree(clsPtr->mixins.list); + ckfree(oPtr->classPtr); + } + ckfree(oPtr); + return 1; + } + return 0; +} + +/* setting the "empty" location to NULL makes debugging a little easier */ +#define REMOVEBODY { \ + for (; idx < num - 1; idx++) { \ + list[idx] = list[idx+1]; \ + } \ + list[idx] = NULL; \ + return; \ +} +void RemoveClass(Class **list, int num, int idx) REMOVEBODY + +void RemoveObject(Object **list, int num, int idx) REMOVEBODY + +/* + * ---------------------------------------------------------------------- + * * TclOORemoveFromInstances -- * * Utility function to remove an object from the list of instances within @@ -1304,36 +1218,27 @@ ObjectNamespaceDeleted( * ---------------------------------------------------------------------- */ -void +int TclOORemoveFromInstances( Object *oPtr, /* The instance to remove. */ Class *clsPtr) /* The class (possibly) containing the * reference to the instance. */ { - int i; + int i, res = 0; Object *instPtr; + if (Deleted(clsPtr->thisPtr)) { + return res; + } FOREACH(instPtr, clsPtr->instances) { if (oPtr == instPtr) { - goto removeInstance; - } - } - return; - - removeInstance: - if (Deleted(clsPtr->thisPtr)) { - if (!IsRootClass(clsPtr)) { - DelRef(clsPtr->instances.list[i]); - } - clsPtr->instances.list[i] = NULL; - } else { - clsPtr->instances.num--; - if (i < clsPtr->instances.num) { - clsPtr->instances.list[i] = - clsPtr->instances.list[clsPtr->instances.num]; + RemoveItem(Object, clsPtr->instances, i); + TclOODecrRefCount(oPtr); + res++; + break; } - clsPtr->instances.list[clsPtr->instances.num] = NULL; } + return res; } /* @@ -1354,9 +1259,6 @@ TclOOAddToInstances( * assumed that the class is not already * present as an instance in the class. */ { - if (Deleted(clsPtr->thisPtr)) { - return; - } if (clsPtr->instances.num >= clsPtr->instances.size) { clsPtr->instances.size += ALLOC_CHUNK; if (clsPtr->instances.size == ALLOC_CHUNK) { @@ -1367,6 +1269,7 @@ TclOOAddToInstances( } } clsPtr->instances.list[clsPtr->instances.num++] = oPtr; + AddRef(oPtr); } /* @@ -1375,36 +1278,31 @@ TclOOAddToInstances( * TclOORemoveFromSubclasses -- * * Utility function to remove a class from the list of subclasses within - * another class. + * another class. Returns the number of removals performed. * * ---------------------------------------------------------------------- */ -void +int TclOORemoveFromSubclasses( Class *subPtr, /* The subclass to remove. */ Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - int i; + int i, res = 0; Class *subclsPtr; + if (Deleted(superPtr->thisPtr)) { + return res; + } FOREACH(subclsPtr, superPtr->subclasses) { if (subPtr == subclsPtr) { - goto removeSubclass; - } - } - return; - - removeSubclass: - if (!Deleted(superPtr->thisPtr)) { - superPtr->subclasses.num--; - if (i < superPtr->subclasses.num) { - superPtr->subclasses.list[i] = - superPtr->subclasses.list[superPtr->subclasses.num]; + RemoveItem(Class, superPtr->subclasses, i); + TclOODecrRefCount(subPtr->thisPtr); + res++; } - superPtr->subclasses.list[superPtr->subclasses.num] = NULL; } + return res; } /* @@ -1431,13 +1329,13 @@ TclOOAddToSubclasses( if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { - superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK); + superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, - sizeof(Class *) * superPtr->subclasses.size); + superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size); } } superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr; + AddRef(subPtr->thisPtr); } /* @@ -1451,31 +1349,28 @@ TclOOAddToSubclasses( * ---------------------------------------------------------------------- */ -void +int TclOORemoveFromMixinSubs( Class *subPtr, /* The subclass to remove. */ Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - int i; + int i, res = 0; Class *subclsPtr; - FOREACH(subclsPtr, superPtr->mixinSubs) { - if (subPtr == subclsPtr) { - goto removeSubclass; - } + if (Deleted(superPtr->thisPtr)) { + return res; } - return; - removeSubclass: - if (!Deleted(superPtr->thisPtr)) { - superPtr->mixinSubs.num--; - if (i < superPtr->mixinSubs.num) { - superPtr->mixinSubs.list[i] = - superPtr->mixinSubs.list[superPtr->mixinSubs.num]; + FOREACH(subclsPtr, superPtr->mixinSubs) { + if (subPtr == subclsPtr) { + RemoveItem(Class, superPtr->mixinSubs, i); + TclOODecrRefCount(subPtr->thisPtr); + res++; + break; } - superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL; } + return res; } /* @@ -1509,6 +1404,7 @@ TclOOAddToMixinSubs( } } superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; + AddRef(subPtr->thisPtr); } /* @@ -1516,7 +1412,7 @@ TclOOAddToMixinSubs( * * AllocClass -- * - * Allocate a basic class. Does not splice the class object into its + * Allocate a basic class. Does not add class to its * class's instance list. * * ---------------------------------------------------------------------- @@ -1527,44 +1423,18 @@ AllocClass( Tcl_Interp *interp, /* Interpreter within which to allocate the * class. */ Object *useThisObj) /* Object that is to act as the class - * representation, or NULL if a new object - * with automatic name is to be used. */ + * representation. */ { Foundation *fPtr = GetFoundation(interp); Class *clsPtr = ckalloc(sizeof(Class)); - /* - * Make an object if we haven't been given one. - */ - memset(clsPtr, 0, sizeof(Class)); - if (useThisObj == NULL) { - clsPtr->thisPtr = AllocObject(interp, NULL, NULL, NULL); - } else { - clsPtr->thisPtr = useThisObj; - } + clsPtr->thisPtr = useThisObj; /* * Configure the namespace path for the class's object. */ - - if (fPtr->helpersNs != NULL) { - Tcl_Namespace *path[2]; - - path[0] = fPtr->helpersNs; - path[1] = fPtr->ooNs; - TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path); - } else { - TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1, - &fPtr->ooNs); - } - - /* - * Class objects inherit from the class of classes unless they inherit - * from some subclass of it. Enforce this right now. - */ - - clsPtr->thisPtr->selfCls = fPtr->classCls; + initClassPath(interp, clsPtr); /* * Classes are subclasses of oo::object, i.e. the objects they create are @@ -1574,6 +1444,7 @@ AllocClass( clsPtr->superclasses.num = 1; clsPtr->superclasses.list = ckalloc(sizeof(Class *)); clsPtr->superclasses.list[0] = fPtr->objectCls; + AddRef(fPtr->objectCls->thisPtr); /* * Finish connecting the class structure to the object structure. @@ -1586,10 +1457,22 @@ AllocClass( * fields. */ - clsPtr->refCount = 1; Tcl_InitObjHashTable(&clsPtr->classMethods); return clsPtr; } +static void +initClassPath(Tcl_Interp *interp, Class *clsPtr) { + Foundation *fPtr = GetFoundation(interp); + if (fPtr->helpersNs != NULL) { + Tcl_Namespace *path[2]; + path[0] = fPtr->helpersNs; + path[1] = fPtr->ooNs; + TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path); + } else { + TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1, + &fPtr->ooNs); + } +} /* * ---------------------------------------------------------------------- @@ -1640,7 +1523,7 @@ Tcl_NewObjectInstance( contextPtr->skip = skip; /* - * Adjust the ensmble tracking record if necessary. [Bug 3514761] + * Adjust the ensemble tracking record if necessary. [Bug 3514761] */ isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv); @@ -1656,7 +1539,6 @@ Tcl_NewObjectInstance( clientData[2] = state; clientData[3] = &oPtr; - AddRef(oPtr); result = FinalizeAlloc(clientData, interp, result); if (result != TCL_OK) { return NULL; @@ -1723,7 +1605,6 @@ TclNRNewObjectInstance( * Fire off the constructors non-recursively. */ - AddRef(oPtr); TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); TclPushTailcallPoint(interp); @@ -1771,18 +1652,9 @@ TclNewObjectInstanceCommon( * Create the object. */ - /* - * The command for the object could have the same name as the command - * associated with classPtr, so protect the structure from deallocation - * here. - */ - AddRef(classPtr); - oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); - DelRef(classPtr); oPtr->selfCls = classPtr; TclOOAddToInstances(oPtr, classPtr); - /* * Check to see if we're really creating a class. If so, allocate the * class structure as well. @@ -1797,7 +1669,6 @@ TclNewObjectInstanceCommon( */ AllocClass(interp, oPtr); - oPtr->selfCls = classPtr; TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); } else { oPtr->classPtr = NULL; @@ -1829,7 +1700,6 @@ FinalizeAlloc( Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } - TclOODeleteContext(contextPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); @@ -1843,12 +1713,14 @@ FinalizeAlloc( (void) TclOOObjectName(interp, oPtr); Tcl_DeleteCommandFromToken(interp, oPtr->command); } - DelRef(oPtr); + /* This decrements the refcount of oPtr */ + TclOODeleteContext(contextPtr); return TCL_ERROR; } Tcl_RestoreInterpState(interp, state); *objectPtr = (Tcl_Object) oPtr; - DelRef(oPtr); + /* This decrements the refcount of oPtr */ + TclOODeleteContext(contextPtr); return TCL_OK; } @@ -1956,8 +1828,7 @@ Tcl_CopyObjectInstance( */ o2Ptr->flags = oPtr->flags & ~( - OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); - + OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. */ @@ -2969,7 +2840,7 @@ int Tcl_ObjectDeleted( Tcl_Object object) { - return Deleted(object) ? 1 : 0; + return Deleted((Object *)object) ? 1 : 0; } Tcl_Object diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b2c06a7..84f414d 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -340,11 +340,6 @@ TclOO_Object_Destroy( Object *oPtr = (Object *) Tcl_ObjectContextObject(context); CallContext *contextPtr; - if (objc != Tcl_ObjectContextSkippedArgs(context)) { - Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, - NULL); - return TCL_ERROR; - } if (!(oPtr->flags & DESTRUCTOR_CALLED)) { oPtr->flags |= DESTRUCTOR_CALLED; contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index d4e1e34..c71425b 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -110,7 +110,8 @@ TclOODeleteContext( TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); - DelRef(oPtr); + /* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */ + TclOODecrRefCount(oPtr); } } @@ -1171,6 +1172,7 @@ TclOOGetCallContext( returnContext: contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; + /* Corresponding TclOODecrRefCount() in TclOODeleteContext */ AddRef(oPtr); contextPtr->callPtr = callPtr; contextPtr->skip = 2; diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index b0bfd9c..7f3ea18 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -326,9 +326,7 @@ TclOOObjectSetMixins( if (numMixins == 0) { if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { - if (mixinPtr) { - TclOORemoveFromInstances(oPtr, mixinPtr); - } + TclOORemoveFromInstances(oPtr, mixinPtr); } ckfree(oPtr->mixins.list); oPtr->mixins.num = 0; @@ -352,6 +350,10 @@ TclOOObjectSetMixins( FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr != oPtr->selfCls) { TclOOAddToInstances(oPtr, mixinPtr); + /* Corresponding TclOODecrRefCount() is in the caller of this + * function. + */ + TclOODecrRefCount(mixinPtr->thisPtr); } } } @@ -399,6 +401,10 @@ TclOOClassSetMixins( memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); + /* Corresponding TclOODecrRefCount() is in the caller of this + * function + */ + TclOODecrRefCount(mixinPtr->thisPtr); } } BumpGlobalEpoch(interp, classPtr); @@ -914,7 +920,7 @@ TclOODefineObjCmd( } else { result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv); } - DelRef(oPtr); + TclOODecrRefCount(oPtr); /* * Restore the previous "current" namespace. @@ -981,7 +987,7 @@ TclOOObjDefObjCmd( } else { result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv); } - DelRef(oPtr); + TclOODecrRefCount(oPtr); /* * Restore the previous "current" namespace. @@ -1048,7 +1054,7 @@ TclOODefineSelfObjCmd( } else { result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv); } - DelRef(oPtr); + TclOODecrRefCount(oPtr); /* * Restore the previous "current" namespace. @@ -1168,11 +1174,11 @@ TclOODefineClassObjCmd( if (oPtr->selfCls != clsPtr) { TclOORemoveFromInstances(oPtr, oPtr->selfCls); + + /* Reference count already incremented 3 lines up. */ oPtr->selfCls = clsPtr; + TclOOAddToInstances(oPtr, oPtr->selfCls); - if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) { - oPtr->flags &= ~CLASS_GONE; - } if (oPtr->classPtr != NULL) { BumpGlobalEpoch(interp, oPtr->classPtr); } else { @@ -1628,6 +1634,10 @@ TclOODefineMixinObjCmd( goto freeAndError; } mixins[i-1] = clsPtr; + /* Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins, + * TclOOClassSetMixinsk, or just below if this function fails. + */ + AddRef(mixins[i-1]->thisPtr); } if (isInstanceMixin) { @@ -1640,6 +1650,9 @@ TclOODefineMixinObjCmd( return TCL_OK; freeAndError: + while (--i > 0) { + TclOODecrRefCount(mixins[i]->thisPtr); + } TclStackFree(interp, mixins); return TCL_ERROR; } @@ -2055,6 +2068,7 @@ ClassMixinSet( mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { + i--; goto freeAndError; } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { @@ -2063,6 +2077,10 @@ ClassMixinSet( Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } + /* Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or just + * below if this function fails + */ + AddRef(mixins[i]->thisPtr); } TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins); @@ -2070,6 +2088,9 @@ ClassMixinSet( return TCL_OK; freeAndError: + while (i-- > 0) { + TclOODecrRefCount(mixins[i]->thisPtr); + } TclStackFree(interp, mixins); return TCL_ERROR; } @@ -2172,16 +2193,20 @@ ClassSuperSet( if (superc == 0) { superclasses = ckrealloc(superclasses, sizeof(Class *)); - superclasses[0] = oPtr->fPtr->objectCls; - superc = 1; if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; + } else { + superclasses[0] = oPtr->fPtr->objectCls; } + superc = 1; + /* Corresponding TclOODecrRefCount is near the end of this function */ + AddRef(superclasses[0]->thisPtr); } else { for (i=0 ; i 0; i--) { + TclOODecrRefCount(superclasses[i]->thisPtr); + } ckfree(superclasses); return TCL_ERROR; } + /* Corresponding TclOODecrRefCount() is near the end of this + * function */ + AddRef(superclasses[i]->thisPtr); } } @@ -2221,6 +2252,8 @@ ClassSuperSet( oPtr->classPtr->superclasses.num = superc; FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOOAddToSubclasses(oPtr->classPtr, superPtr); + /* To account for the AddRef() earlier in this function */ + TclOODecrRefCount(superPtr->thisPtr); } BumpGlobalEpoch(interp, oPtr->classPtr); @@ -2511,9 +2544,16 @@ ObjMixinSet( mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { + while (i-- > 0) { + TclOODecrRefCount(mixins[i]->thisPtr); + } TclStackFree(interp, mixins); return TCL_ERROR; } + /* Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or + * just above if this function fails. + */ + AddRef(mixins[i]->thisPtr); } TclOOObjectSetMixins(oPtr, mixinc, mixins); diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 83b4d58..084c026 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -193,9 +193,10 @@ typedef struct Object { * destroyed. */ #define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been * called. */ -#define CLASS_GONE 4 /* Indicates that the class of this object has - * been deleted, and so the object should not - * attempt to remove itself from its class. */ +#define CLASS_GONE 4 /* Obsolete. Indicates that the class of this + * object has been deleted, and so the object + * should not attempt to remove itself from its + * class. */ #define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of * the class hierarchy and should be treated * specially during teardown. */ @@ -222,10 +223,6 @@ typedef struct Object { typedef struct Class { Object *thisPtr; /* Reference to the object associated with * this class. */ - int refCount; /* Number of strong references to this class. - * Weak references are not counted; the - * purpose of this is to avoid Tcl_Preserve as - * that is quite slow. */ int flags; /* Assorted flags. */ LIST_STATIC(struct Class *) superclasses; /* List of superclasses, used for generation @@ -499,6 +496,7 @@ MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, const char *nameStr, const char *nsNameStr); +MODULE_SCOPE int TclOODecrRefCount(Object *oPtr); MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr); MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr); MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr); @@ -528,10 +526,10 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); -MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr); -MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr, +MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr); +MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr, Class *mixinPtr); -MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr, +MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp, CallChain *callPtr); @@ -546,18 +544,21 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #include "tclOOIntDecls.h" /* + * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release. + */ + +#define AddRef(ptr) ((ptr)->refCount++) + +/* * A convenience macro for iterating through the lists used in the internal - * memory management of objects. This is a bit gnarly because we want to do - * the assignment of the picked-out value only when the body test succeeds, - * but we cannot rely on the assigned value being useful, forcing us to do - * some nasty stuff with the comma operator. The compiler's optimizer should - * be able to sort it all out! - * + * memory management of objects. * REQUIRES DECLARATION: int i; */ #define FOREACH(var,ary) \ - for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++) + for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ + continue; \ + } else if (var = (ary).list[i], 1) /* * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS @@ -592,17 +593,6 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); } \ } while(0) -/* - * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release. - */ - -#define AddRef(ptr) ((ptr)->refCount++) -#define DelRef(ptr) do { \ - if ((ptr)->refCount-- <= 1) { \ - ckfree(ptr); \ - } \ - } while(0) - #endif /* TCL_OO_INTERNAL_H */ /* diff --git a/tests/oo.test b/tests/oo.test index b9c5067..3be5f79 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -47,7 +47,7 @@ test oo-0.2 {basic test of OO's ability to clean up its initial state} { } {} test oo-0.3 {basic test of OO's ability to clean up its initial state} -body { leaktest { - [oo::object new] destroy + [oo::object new] destroy } } -constraints memory -result 0 test oo-0.4 {basic test of OO's ability to clean up its initial state} -body { @@ -131,6 +131,10 @@ test oo-1.4 {basic test of OO functionality} -body { test oo-1.4.1 {fully-qualified nested name} -body { oo::object create ::one::two::three } -result {::one::two::three} +test oo-1.4.2 {automatic command name has same name as namespace} -body { + set obj [oo::object new] + expr {[info object namespace $obj] == $obj} +} -result 1 test oo-1.5 {basic test of OO functionality} -body { oo::object doesnotexist } -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new} @@ -1514,9 +1518,9 @@ test oo-11.6 { # No segmentation fault return done -} -cleanup { +} -result done -cleanup { rename obj1 {} -} -result done +} test oo-12.1 {OO: filters} { oo::class create Aclass @@ -3891,9 +3895,6 @@ test oo-35.6 { rename obj {} } -result done - - - test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object -- cgit v0.12 From bf868c1c56292a44ff5faeef5b348408554cab1a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Dec 2017 14:19:48 +0000 Subject: Initial implementation of TIP #491. Not tested yet. --- generic/tcl.h | 4 ++++ generic/tclInt.h | 4 ++++ unix/configure.ac | 6 ------ win/configure.ac | 6 ------ win/rules.vc | 43 ++++--------------------------------------- win/tcl.rc | 8 +------- win/tclsh.rc | 8 +------- 7 files changed, 14 insertions(+), 65 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index a6a8c94..b7d4e90 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -91,6 +91,10 @@ extern "C" { #endif #endif /* !TCL_NO_DEPRECATED */ +#ifndef TCL_THREADS +# define TCL_THREADS 1 +#endif + /* * A special definition used to allow this header file to be included from * windows resource files so that they can obtain version information. diff --git a/generic/tclInt.h b/generic/tclInt.h index ad1d9c6..1fd252f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4149,6 +4149,10 @@ typedef const char *TclDTraceStr; } \ } +#if TCL_THREADS && !defined(USE_THREAD_ALLOC) +# define USE_THREAD_ALLOC 1 +#endif + #if defined(PURIFY) /* diff --git a/unix/configure.ac b/unix/configure.ac index e14d85e..5b982e8 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -120,12 +120,6 @@ if test -z "$no_pipe" && test -n "$GCC"; then fi #------------------------------------------------------------------------ -# Threads support -#------------------------------------------------------------------------ - -SC_ENABLE_THREADS - -#------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ diff --git a/win/configure.ac b/win/configure.ac index d03695c..179f151 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -78,12 +78,6 @@ AC_PROG_MAKE_SET AC_OBJEXT AC_EXEEXT -#-------------------------------------------------------------------- -# Check whether --enable-threads or --disable-threads was given. -#-------------------------------------------------------------------- - -SC_ENABLE_THREADS - #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ diff --git a/win/rules.vc b/win/rules.vc index 9b917b6..890618c 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -626,7 +626,6 @@ LINKERFLAGS = $(LINKERFLAGS) -ltcg # The following macros are defined by this section based on OPTS # STATIC_BUILD - 0 -> Tcl is to be built as a shared library # 1 -> build as a static library and shell -# TCL_THREADS - legacy but always 1 on Windows since winsock requires it. # DEBUG - 1 -> debug build, 0 -> release builds # SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's # PROFILE - 1 -> generate profiling info, 0 -> no profiling @@ -648,7 +647,6 @@ LINKERFLAGS = $(LINKERFLAGS) -ltcg # Default values for all the above STATIC_BUILD = 0 -TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 PROFILE = 0 @@ -703,15 +701,6 @@ TCL_USE_STATIC_PACKAGES = 1 TCL_USE_STATIC_PACKAGES = 0 !endif -!if [nmakehlp -f $(OPTS) "nothreads"] -!message *** Compile explicitly for non-threaded tcl -TCL_THREADS = 0 -USE_THREAD_ALLOC= 0 -!else -TCL_THREADS = 1 -USE_THREAD_ALLOC= 1 -!endif - !if [nmakehlp -f $(OPTS) "symbols"] !message *** Doing symbols DEBUG = 1 @@ -747,12 +736,6 @@ PGO = 0 !message *** Warning: ignoring option "loimpact" - deprecated on modern Windows. !endif -# TBD - should get rid of this option -!if [nmakehlp -f $(OPTS) "thrdalloc"] -!message *** Doing thrdalloc -USE_THREAD_ALLOC = 1 -!endif - !if [nmakehlp -f $(OPTS) "tclalloc"] USE_THREAD_ALLOC = 0 !endif @@ -943,7 +926,6 @@ VERSION = $(DOTVERSION:.=) # different compilers, build configurations etc., # # Naming convention (suffixes): -# t = full thread support. # s = static library (as opposed to an import library) # g = linked to the debug enabled C run-time. # x = special static build when it links to the dynamic C run-time. @@ -965,7 +947,7 @@ VERSION = $(DOTVERSION:.=) # PRJSTUBLIB - output path of the generated project stubs library # RESFILE - output resource file (only if not static build) -SUFX = tsgx +SUFX = sgx !if $(DEBUG) BUILDDIRTOP = Debug @@ -984,7 +966,7 @@ BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) SUFX = $(SUFX:g=) !endif -TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX +TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_DynamicStaticX !if !$(STATIC_BUILD) TMP_DIRFULL = $(TMP_DIRFULL:Static=) @@ -1001,11 +983,6 @@ SUFX = $(SUFX:x=) !endif !endif -!if !$(TCL_THREADS) -TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) -SUFX = $(SUFX:t=) -!endif - !ifndef TMP_DIR TMP_DIR = $(TMP_DIRFULL) !ifndef OUT_DIR @@ -1049,9 +1026,6 @@ TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" !if $(TCLINSTALL) # Building against an installed Tcl TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe -!if !exist("$(TCLSH)") && $(TCL_THREADS) -TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe -!endif TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib TCL_LIBRARY = $(_TCLDIR)\lib @@ -1063,9 +1037,6 @@ TCL_INCLUDES = -I"$(_TCLDIR)\include" !else # Building against Tcl sources TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe -!if !exist($(TCLSH)) && $(TCL_THREADS) -TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe -!endif TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib TCL_LIBRARY = $(_TCLDIR)\library @@ -1205,11 +1176,8 @@ OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS !endif -!if $(TCL_THREADS) -OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 -!if $(USE_THREAD_ALLOC) -OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 -!endif +!if $(USE_THREAD_ALLOC)==0 +OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=0 !endif !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD @@ -1662,9 +1630,6 @@ TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake" !if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" !error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). !endif -!if defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) -!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)). -!endif !if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) !message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)). !endif diff --git a/win/tcl.rc b/win/tcl.rc index be5e0a7..477512d 100644 --- a/win/tcl.rc +++ b/win/tcl.rc @@ -7,19 +7,13 @@ // // build-up the name suffix that defines the type of build this is. // -#if TCL_THREADS -#define SUFFIX_THREADS "t" -#else -#define SUFFIX_THREADS "" -#endif - #if DEBUG && !UNCHECKED #define SUFFIX_DEBUG "g" #else #define SUFFIX_DEBUG "" #endif -#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG +#define SUFFIX SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ diff --git a/win/tclsh.rc b/win/tclsh.rc index 161da50..bd1a4da 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -8,12 +8,6 @@ // // build-up the name suffix that defines the type of build this is. // -#if TCL_THREADS -#define SUFFIX_THREADS "t" -#else -#define SUFFIX_THREADS "" -#endif - #if STATIC_BUILD #define SUFFIX_STATIC "s" #else @@ -26,7 +20,7 @@ #define SUFFIX_DEBUG "" #endif -#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG +#define SUFFIX SUFFIX_STATIC SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ -- cgit v0.12 From 0239e7e77f3f12c24179f6c021d3f7b40dfcf981 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 11 Dec 2017 23:50:22 +0000 Subject: Add the check for wrong arguments back to TclOO_Object_Destroy, remove inadvertant increment of Namespace->refCount. --- generic/tclBasic.c | 1 - generic/tclOO.c | 4 +++- generic/tclOOBasic.c | 5 +++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a23100e..ce46cd4 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3153,7 +3153,6 @@ Tcl_DeleteCommandFromToken( cmdPtr->nsPtr->refCount++; - cmdPtr->nsPtr->refCount++; if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); diff --git a/generic/tclOO.c b/generic/tclOO.c index ae1ae3f..1a9bfc4 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -236,8 +236,10 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) #define RemoveItem(type, lst, i) \ + do { \ Remove ## type ((lst).list, (lst).num, i); \ - (lst).num-- + (lst).num-- \ + } while 0 /* * ---------------------------------------------------------------------- diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 84f414d..b2c06a7 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -340,6 +340,11 @@ TclOO_Object_Destroy( Object *oPtr = (Object *) Tcl_ObjectContextObject(context); CallContext *contextPtr; + if (objc != Tcl_ObjectContextSkippedArgs(context)) { + Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, + NULL); + return TCL_ERROR; + } if (!(oPtr->flags & DESTRUCTOR_CALLED)) { oPtr->flags |= DESTRUCTOR_CALLED; contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); -- cgit v0.12 From 3ddcb1cfb5dd70afa094e3113ab1946df9cbe222 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 13 Dec 2017 12:56:02 +0000 Subject: Fix syntax error in previous commit. --- generic/tclOO.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 1a9bfc4..0243c15 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -238,8 +238,8 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; #define RemoveItem(type, lst, i) \ do { \ Remove ## type ((lst).list, (lst).num, i); \ - (lst).num-- \ - } while 0 + (lst).num--; \ + } while (0) /* * ---------------------------------------------------------------------- -- cgit v0.12 From 556dc3036e36d2449fe4feaece94487adfd745b8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Dec 2017 12:02:13 +0000 Subject: Fix (harmless) compiler warning with Visual Studio --- generic/tclStubInit.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 544c28e..6c20340 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -110,7 +110,7 @@ static unsigned short TclWinNToHS(unsigned short ns) { } #define TclWinGetPlatformId winGetPlatformId static int -TclWinGetPlatformId() +TclWinGetPlatformId(void) { return 2; /* VER_PLATFORM_WIN32_NT */; } -- cgit v0.12 From 5c4f8d88b5491e7656dedeab904b42b437b83e01 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Dec 2017 14:38:30 +0000 Subject: fix comment --- win/rules.vc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index f22a2dc..2ee8f0e 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -957,7 +957,7 @@ VERSION = $(DOTVERSION:.=) # different compilers, build configurations etc., # # Naming convention (suffixes): -# t = full thread support. (Not used for Tcl >= 8.6) +# t = full thread support. (Not used for Tcl >= 8.7) # s = static library (as opposed to an import library) # g = linked to the debug enabled C run-time. # x = special static build when it links to the dynamic C run-time. @@ -1048,7 +1048,7 @@ STUBPREFIX = $(PROJECT)stub # Set up paths to various Tcl executables and libraries needed by extensions !if $(DOING_TCL) -TCLSHNAME = $(PROJECT)sh$(TCL_VERSION)$(SUFX).exe +TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) -- cgit v0.12 From 3f03f8189e6b4da3ff496bfbb4faa921124b76f9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Dec 2017 13:04:15 +0000 Subject: Oops, couldn't build tclWinPanic.o. Fixed now. --- win/makefile.vc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/makefile.vc b/win/makefile.vc index 1d61f28..d270447 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -741,7 +741,7 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(stubscflags) -Fo$@ $? -$(TMP_DIR)\tclWinPanic.obj: $(GENERICDIR)\tclWinPanic.c +$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in -- cgit v0.12 From 4fb66d5d55a3239a342ae799da586966fe8326cf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Dec 2017 14:46:11 +0000 Subject: Mark TclPrecTraceProc() as deprecated, and remove it when compiling with -DTCL_NO_DEPRECATED. See TIP #488 --- generic/tclBasic.c | 2 ++ generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 5 +++-- generic/tclStubInit.c | 1 + generic/tclUtil.c | 2 ++ 5 files changed, 9 insertions(+), 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index eceea31..406d0b1 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -954,9 +954,11 @@ Tcl_CreateInterp(void) Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); +#endif /* !TCL_NO_DEPRECATED */ TclpSetVariables(interp); #ifdef TCL_THREADS diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 33bf0b3..175ea9c 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -355,7 +355,7 @@ declare 81 { # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } -declare 88 { +declare 88 {deprecated {}} { char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags) } diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5848bb3..bc8f7b8 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -233,7 +233,8 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size); /* Slot 86 is reserved */ /* Slot 87 is reserved */ /* 88 */ -EXTERN char * TclPrecTraceProc(ClientData clientData, +TCL_DEPRECATED("") +char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 89 */ @@ -743,7 +744,7 @@ typedef struct TclIntStubs { void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); - char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ + TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6c20340..bd0971b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -64,6 +64,7 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclGetStartupScriptPath 0 # define TclSetStartupScriptFileName 0 # define TclGetStartupScriptFileName 0 +# define TclPrecTraceProc 0 # define TclpInetNtoa 0 # define TclWinGetServByName 0 # define TclWinGetSockOpt 0 diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 51af016..d84163c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3298,6 +3298,7 @@ Tcl_PrintDouble( *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* ARGSUSED */ char * TclPrecTraceProc( @@ -3355,6 +3356,7 @@ TclPrecTraceProc( *precisionPtr = prec; return NULL; } +#endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- -- cgit v0.12 From 67f6f5cdb190d17b5178a5d5c8d090440bbc1005 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 15 Dec 2017 16:50:50 +0000 Subject: Revert the (int -> size_t) transition of the "cmdEpoch" field of the struct Command that was part of [ff3f6a12a8d099ef], and related changes. This change broke the ability of Itcl 3.4 built against Tcl 8.6 headers to successfully [load] into and operate in a Tcl 8.7 interp. "Command" is a private struct, and Itcl 3 should have respected that, but it has not, and changing the size of the cmdEpoch field broke the ability of Itcl 3 to operate on later fields of the struct, notably the deleteProc, which it makes extensive use of. I believe we should keep the change in the Tcl 9 sources. --- generic/tclBasic.c | 2 +- generic/tclInt.h | 2 +- generic/tclObj.c | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 406d0b1..292b466 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4789,7 +4789,7 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); diff --git a/generic/tclInt.h b/generic/tclInt.h index ad1d9c6..49d88aa 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1639,7 +1639,7 @@ typedef struct Command { * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - size_t cmdEpoch; /* Incremented to invalidate any references + int cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL diff --git a/generic/tclObj.c b/generic/tclObj.c index 1a00011..1aa24f2 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -354,7 +354,7 @@ typedef struct ResolvedCmdName { * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - size_t cmdEpoch; /* Value of the command's cmdEpoch when this + int cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, -- cgit v0.12 From aecff8b1e70292e4c7e77d9200b086f7af4cfa33 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Dec 2017 21:27:14 +0000 Subject: Revert a few more (int -> size_t) transitions, which could effect extensions (such as Itcl 3.4) which use internal Tcl header files. Better wait until 9.0 for this. What we _can_ do is change some (internal) fields to 'unsigned': that doubles the epoch range without further danger. Thanks, Don, for pointing this out! --- generic/tclBasic.c | 2 +- generic/tclCompile.h | 2 +- generic/tclEncoding.c | 2 +- generic/tclEnsemble.c | 2 +- generic/tclExecute.c | 6 +++--- generic/tclInt.h | 22 +++++++++++----------- generic/tclNamesp.c | 2 +- generic/tclObj.c | 6 +++--- generic/tclUtil.c | 8 ++++---- unix/tclUnixInit.c | 2 +- unix/tclUnixSock.c | 2 +- win/tclWinInit.c | 6 +++--- win/tclWinSock.c | 2 +- 13 files changed, 32 insertions(+), 32 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 292b466..5fd9e28 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4789,7 +4789,7 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index bd7aaab..7f01436 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -425,7 +425,7 @@ typedef struct ByteCode { * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this + unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e1e26d3..46db12c 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3609,7 +3609,7 @@ unilen( static void InitializeEncodingSearchPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 580ea5c..e7bfbac 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -92,7 +92,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - size_t epoch; /* Used to confirm when the data in this + unsigned int epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 95664d0..f2cda0c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -9476,9 +9476,9 @@ PrintByteCodeInfo( Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; - fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%p (epoch %" TCL_LL_MODIFIER "u)\n", - codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr, - (Tcl_WideInt)iPtr->compileEpoch); + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", + codePtr, (Tcl_WideInt)codePtr->refCount, codePtr->compileEpoch, iPtr, + iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); diff --git a/generic/tclInt.h b/generic/tclInt.h index 49d88aa..91deb9d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -265,7 +265,7 @@ typedef struct Namespace { * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - size_t nsId; /* Unique id for the namespace. */ + unsigned long nsId; /* Unique id for the namespace. */ Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status @@ -299,12 +299,12 @@ typedef struct Namespace { * registered using "namespace export". */ int maxExportPatterns; /* Mumber of export patterns for which space * is currently allocated. */ - size_t cmdRefEpoch; /* Incremented if a newly added command + unsigned int cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - size_t resolverEpoch; /* Incremented whenever (a) the name + unsigned int resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -331,7 +331,7 @@ typedef struct Namespace { * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ - size_t exportLookupEpoch; /* Incremented whenever a command is added to + unsigned int exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be @@ -432,7 +432,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - size_t epoch; /* The epoch at which this ensemble's table of + unsigned int epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -1634,12 +1634,12 @@ typedef struct Command { * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ - int refCount; /* 1 if in command hashtable plus 1 for each + unsigned int refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - int cmdEpoch; /* Incremented to invalidate any references + unsigned int cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL @@ -2626,7 +2626,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -2638,9 +2638,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, */ typedef struct ProcessGlobalValue { - size_t epoch; /* Epoch counter to detect changes in the + unsigned int epoch; /* Epoch counter to detect changes in the * master value. */ - size_t numBytes; /* Length of the master string. */ + unsigned int numBytes; /* Length of the master string. */ char *value; /* The master string value. */ Tcl_Encoding encoding; /* system encoding when master string was * initialized. */ @@ -3125,7 +3125,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - size_t *lengthPtr, Tcl_Encoding *encodingPtr); + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d661856..d212de1 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -32,7 +32,7 @@ */ typedef struct { - size_t numNsCreated; /* Count of the number of namespaces created + unsigned long numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be * per-interp because the nsId is used to diff --git a/generic/tclObj.c b/generic/tclObj.c index 1aa24f2..4ec0a57 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -344,17 +344,17 @@ typedef struct ResolvedCmdName { * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ - size_t refNsId; /* refNsPtr's unique namespace id. Used to + unsigned long refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - size_t refNsCmdEpoch; /* Value of the referencing namespace's + unsigned int refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - int cmdEpoch; /* Value of the command's cmdEpoch when this + unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, diff --git a/generic/tclUtil.c b/generic/tclUtil.c index d84163c..15018de 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4012,7 +4012,7 @@ TclSetProcessGlobalValue( Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); - hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy); + hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(size_t)(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } @@ -4038,7 +4038,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - size_t epoch = pgvPtr->epoch; + unsigned int epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4072,7 +4072,7 @@ TclGetProcessGlobalValue( } } cacheMap = GetThreadHash(&pgvPtr->key); - hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch)); + hPtr = Tcl_FindHashEntry(cacheMap, (void *)(size_t)epoch); if (NULL == hPtr) { int dummy; @@ -4105,7 +4105,7 @@ TclGetProcessGlobalValue( value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, - (void *)(pgvPtr->epoch), &dummy); + (void *)(size_t)(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index feeffa6..e57136d 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -453,7 +453,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 45abc01..980ab4d 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -217,7 +217,7 @@ printaddrinfo( static void InitializeHostName( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 9d37a41..dc8bba7 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -182,7 +182,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 @@ -345,7 +345,7 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -396,7 +396,7 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index ee6be96..1c004838 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -360,7 +360,7 @@ printaddrinfolist( void InitializeHostName( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; -- cgit v0.12 From 71cf0dba4023ab771a4923f6e741c5b6ac19217a Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 16 Dec 2017 03:22:04 +0000 Subject: Re-arranging code and providing forward prototypes to allow the C infrastructure of Zipfs to be activated from withing the first call to TclZipfs_Mount(). This keeps up from having to expose TclZipfs_Init in the stubs table. --- generic/tclZipfs.c | 145 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 88 insertions(+), 57 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 2370980..ca10b4f 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -306,6 +306,73 @@ static const unsigned long crc32tab[256] = { const char *zipfs_literal_tcl_library=NULL; +/* Function prototypes */ +static int Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr); +static Tcl_Obj *Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr); +static Tcl_Obj *Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr); +static int Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +static int Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode); +static Tcl_Channel Zip_FSOpenFileChannelProc( + Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode, int permissions +); +static int Zip_FSMatchInDirectoryProc( + Tcl_Interp* interp, Tcl_Obj *result, + Tcl_Obj *pathPtr, const char *pattern, + Tcl_GlobTypeData *types +); +static Tcl_Obj *Zip_FSListVolumesProc(void); +static const char *const *Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef); +static int Zip_FSFileAttrsGetProc( + Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef +); +static int Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr); +static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, + Tcl_FSUnloadFileProc **unloadProcPtr, int flags); +static void TclZipfs_C_Init(void); + +/* + * Define the ZIP filesystem dispatch table. + */ + +MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; + +const Tcl_Filesystem zipfsFilesystem = { + "zipfs", + sizeof (Tcl_Filesystem), + TCL_FILESYSTEM_VERSION_2, + Zip_FSPathInFilesystemProc, + NULL, /* dupInternalRepProc */ + NULL, /* freeInternalRepProc */ + NULL, /* internalToNormalizedProc */ + NULL, /* createInternalRepProc */ + NULL, /* normalizePathProc */ + Zip_FSFilesystemPathTypeProc, + Zip_FSFilesystemSeparatorProc, + Zip_FSStatProc, + Zip_FSAccessProc, + Zip_FSOpenFileChannelProc, + Zip_FSMatchInDirectoryProc, + NULL, /* utimeProc */ + NULL, /* linkProc */ + Zip_FSListVolumesProc, + Zip_FSFileAttrStringsProc, + Zip_FSFileAttrsGetProc, + Zip_FSFileAttrsSetProc, + NULL, /* createDirectoryProc */ + NULL, /* removeDirectoryProc */ + NULL, /* deleteFileProc */ + NULL, /* copyFileProc */ + NULL, /* renameFileProc */ + NULL, /* copyDirectoryProc */ + NULL, /* lstatProc */ + (Tcl_FSLoadFileProc *) Zip_FSLoadFile, + NULL, /* getCwdProc */ + NULL, /* chdirProc*/ +}; + + /* *------------------------------------------------------------------------- @@ -1039,6 +1106,25 @@ error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; } + +static void TclZipfs_C_Init(void) { + static const Tcl_Time t = { 0, 0 }; + if (!ZipFS.initialized) { +#ifdef TCL_THREADS + /* + * Inflate condition variable. + */ + Tcl_MutexLock(&ZipFSMutex); + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); + Tcl_MutexUnlock(&ZipFSMutex); +#endif + Tcl_FSRegister(NULL, &zipfsFilesystem); + Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); + ZipFS.initialized = ZipFS.idCount = 1; + } +} + /* *------------------------------------------------------------------------- @@ -1077,9 +1163,7 @@ TclZipfs_Mount( ReadLock(); if (!ZipFS.initialized) { - ZIPFS_ERROR(interp,"not initialized"); - Unlock(); - return TCL_ERROR; + TclZipfs_C_Init(); } if (zipname == NULL) { Tcl_HashSearch search; @@ -3924,47 +4008,6 @@ Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, #endif } - -/* - * Define the ZIP filesystem dispatch table. - */ - -MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; - -const Tcl_Filesystem zipfsFilesystem = { - "zipfs", - sizeof (Tcl_Filesystem), - TCL_FILESYSTEM_VERSION_2, - Zip_FSPathInFilesystemProc, - NULL, /* dupInternalRepProc */ - NULL, /* freeInternalRepProc */ - NULL, /* internalToNormalizedProc */ - NULL, /* createInternalRepProc */ - NULL, /* normalizePathProc */ - Zip_FSFilesystemPathTypeProc, - Zip_FSFilesystemSeparatorProc, - Zip_FSStatProc, - Zip_FSAccessProc, - Zip_FSOpenFileChannelProc, - Zip_FSMatchInDirectoryProc, - NULL, /* utimeProc */ - NULL, /* linkProc */ - Zip_FSListVolumesProc, - Zip_FSFileAttrStringsProc, - Zip_FSFileAttrsGetProc, - Zip_FSFileAttrsSetProc, - NULL, /* createDirectoryProc */ - NULL, /* removeDirectoryProc */ - NULL, /* deleteFileProc */ - NULL, /* copyFileProc */ - NULL, /* renameFileProc */ - NULL, /* copyDirectoryProc */ - NULL, /* lstatProc */ - (Tcl_FSLoadFileProc *) Zip_FSLoadFile, - NULL, /* getCwdProc */ - NULL, /* chdirProc*/ -}; - #endif /* HAVE_ZLIB */ @@ -3994,19 +4037,7 @@ TclZipfs_Init(Tcl_Interp *interp) WriteLock(); Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); if (!ZipFS.initialized) { -#ifdef TCL_THREADS - static const Tcl_Time t = { 0, 0 }; - /* - * Inflate condition variable. - */ - Tcl_MutexLock(&ZipFSMutex); - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); - Tcl_MutexUnlock(&ZipFSMutex); -#endif - Tcl_FSRegister(NULL, &zipfsFilesystem); - Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); - ZipFS.initialized = ZipFS.idCount = 1; + TclZipfs_C_Init(); } Unlock(); if(interp != NULL) { -- cgit v0.12 From 45a3c74a04c973ba863d5914abedb96b85d17e1b Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 16 Dec 2017 03:24:21 +0000 Subject: Removing static package declaration of zipfs. --- generic/tclZipfs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index ca10b4f..45ba8e2 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4035,7 +4035,7 @@ TclZipfs_Init(Tcl_Interp *interp) #ifdef HAVE_ZLIB /* one-time initialization */ WriteLock(); - Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); + /* Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); */ if (!ZipFS.initialized) { TclZipfs_C_Init(); } -- cgit v0.12 From 7f1c241ea2bb3908c647d517e512816b219771dd Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Sat, 16 Dec 2017 03:30:58 +0000 Subject: Update the config.test with new keys needed for zipfs --- tests/config.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/config.test b/tests/config.test index d14837e..468a1df 100644 --- a/tests/config.test +++ b/tests/config.test @@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { test pkgconfig-1.1 {query keys} { lsort [::tcl::pkgconfig list] -} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded} +} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime} test pkgconfig-1.2 {query keys multiple times} { string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list] } 0 -- cgit v0.12 From dbe18af9ea851bd0e954036eff3fcd21bccf5291 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Dec 2017 14:33:11 +0000 Subject: No need any more to check for "Windows NT" here, since the minimum is XP now. --- library/init.tcl | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index 794b68b..530ce58 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -653,10 +653,7 @@ proc auto_execok name { set windir $env(WINDIR) } if {[info exists windir]} { - if {$tcl_platform(os) eq "Windows NT"} { - append path "$windir/system32;" - } - append path "$windir/system;$windir;" + append path "$windir/system32;$windir/system;$windir;" } foreach var {PATH Path path} { -- cgit v0.12 From f64bba0499c121428187fe686da131dca5905e50 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Dec 2017 11:21:33 +0000 Subject: Minor simplification on Cygwin, since we only support Windows NT now --- unix/tclUnixInit.c | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index e57136d..cc66569 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -39,11 +39,6 @@ DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); -#define NUMPLATFORMS 4 -static const char *const platforms[NUMPLATFORMS] = { - "Win32s", "Windows 95", "Windows NT", "Windows CE" -}; - #define NUMPROCESSORS 11 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", @@ -890,10 +885,7 @@ TclpSetVariables( GetSystemInfo(&sysInfo); - if (osInfo.dwPlatformId < NUMPLATFORMS) { - Tcl_SetVar2(interp, "tcl_platform", "os", - platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); - } + Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { -- cgit v0.12 From ee66488c3683d1e2b6ac36f523638c42c5649433 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Dec 2017 11:23:13 +0000 Subject: Make TclEnsureNamespace() MODULE_SCOPE. Also change some refCount fields from type "int" to "unsigned int" for increased range. --- generic/tclCompile.h | 4 ++-- generic/tclDisassemble.c | 4 ++-- generic/tclInt.h | 25 ++++++++++++------------- generic/tclNamesp.c | 4 ++-- generic/tclProc.c | 2 +- 5 files changed, 19 insertions(+), 20 deletions(-) diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 7f01436..f20ecfd 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -425,11 +425,11 @@ typedef struct ByteCode { * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this + unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ - int refCount; /* Reference count: set 1 when created plus 1 + unsigned int refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index d61ed42..e07080a 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -254,7 +254,7 @@ DisassembleByteCodeObj( Tcl_Obj *bufferObj, *fileObj; TclNewObj(bufferObj); - if (codePtr->refCount <= 0) { + if (!codePtr->refCount) { return bufferObj; /* Already freed. */ } @@ -312,7 +312,7 @@ DisassembleByteCodeObj( int numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %d, args %d, compiled locals %d\n", + " Proc %p, refCt %u, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 91deb9d..de22924 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -274,7 +274,7 @@ typedef struct Namespace { * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ - int refCount; /* Count of references by namespaceName + unsigned int refCount; /* Count of references by namespaceName * objects. The namespace can't be freed until * refCount becomes zero. */ Tcl_HashTable cmdTable; /* Contains all the commands currently @@ -299,7 +299,7 @@ typedef struct Namespace { * registered using "namespace export". */ int maxExportPatterns; /* Mumber of export patterns for which space * is currently allocated. */ - unsigned int cmdRefEpoch; /* Incremented if a newly added command + unsigned int cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to @@ -545,7 +545,7 @@ typedef struct CommandTrace { struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - int refCount; /* Used to ensure this structure is not + unsigned int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ @@ -618,7 +618,7 @@ typedef struct Var { typedef struct VarInHash { Var var; - int refCount; /* Counts number of active uses of this + unsigned int refCount; /* Counts number of active uses of this * variable: 1 for the entry in the hash * table, 1 for each additional variable whose * linkPtr points here, 1 for each nested @@ -950,7 +950,7 @@ typedef struct CompiledLocal { typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ - int refCount; /* Reference count: 1 if still present in + unsigned int refCount; /* Reference count: 1 if still present in * command table plus 1 for each call to the * procedure that is currently active. This * structure can be freed when refCount @@ -1067,7 +1067,7 @@ typedef struct AssocData { */ typedef struct LocalCache { - int refCount; + unsigned int refCount; int numVars; Tcl_Obj *varName0; } LocalCache; @@ -1229,7 +1229,7 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ - int refCount; /* Number of times the word is on the + unsigned int refCount; /* Number of times the word is on the * stack. */ } CFWord; @@ -1634,12 +1634,12 @@ typedef struct Command { * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ - unsigned int refCount; /* 1 if in command hashtable plus 1 for each + unsigned int refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - unsigned int cmdEpoch; /* Incremented to invalidate any references + unsigned int cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL @@ -2384,7 +2384,7 @@ typedef enum TclEolTranslation { */ typedef struct List { - int refCount; + unsigned int refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was @@ -2640,7 +2640,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng typedef struct ProcessGlobalValue { unsigned int epoch; /* Epoch counter to detect changes in the * master value. */ - unsigned int numBytes; /* Length of the master string. */ + unsigned int numBytes; /* Length of the master string. */ char *value; /* The master string value. */ Tcl_Encoding encoding; /* system encoding when master string was * initialized. */ @@ -2960,8 +2960,7 @@ MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); -Tcl_Namespace * TclEnsureNamespace( - Tcl_Interp *interp, +MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d212de1..269d06b 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -402,7 +402,7 @@ Tcl_PopCallFrame( } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); - if (--framePtr->localCachePtr->refCount == 0) { + if (framePtr->localCachePtr->refCount-- <= 1) { TclFreeLocalCache(interp, framePtr->localCachePtr); } framePtr->localCachePtr = NULL; @@ -1052,7 +1052,7 @@ Tcl_DeleteNamespace( * Otherwise, mark it as "dead" so that it can't be used. */ - if (nsPtr->refCount == 0) { + if (!nsPtr->refCount) { NamespaceFree(nsPtr); } else { nsPtr->flags |= NS_DEAD; diff --git a/generic/tclProc.c b/generic/tclProc.c index b89357c..70dc4dc 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2380,7 +2380,7 @@ FreeLambdaInternalRep( Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2; - if (procPtr->refCount-- == 1) { + if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } TclDecrRefCount(nsObjPtr); -- cgit v0.12 From 07c71d17a255fb07143dbb73659a64a589a214f6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Dec 2017 15:20:32 +0000 Subject: Somewhat better backwards compatibility on 64-bit platforms. --- generic/tclObj.c | 4 ++-- generic/tclTestObj.c | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 183ad7f..8ec95ce 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -262,10 +262,10 @@ const Tcl_ObjType tclDoubleType = { SetDoubleFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclIntType = { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG) "int", /* name */ #else - "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 */ + "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/ #endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 6b08761..547792a 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1088,7 +1088,9 @@ TestobjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { typeName = objv[2]->typePtr->name; +#ifndef TCL_WIDE_INT_IS_LONG if (!strcmp(typeName, "wideInt")) typeName = "int"; +#endif Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1)); } } else if (strcmp(subCmd, "refcount") == 0) { @@ -1116,9 +1118,11 @@ TestobjCmd( } if (varPtr[varIndex]->typePtr == NULL) { /* a string! */ Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1); +#ifndef TCL_WIDE_INT_IS_LONG } else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) { Tcl_AppendToObj(Tcl_GetObjResult(interp), "int", -1); +#endif } else { Tcl_AppendToObj(Tcl_GetObjResult(interp), varPtr[varIndex]->typePtr->name, -1); -- cgit v0.12 From 2bfe68441a03d2363dddceaaf87bf7e059c59e38 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 20 Dec 2017 09:19:59 +0000 Subject: Fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion trace deletes its namespace: segmentation fault. --- generic/tclNamesp.c | 17 +++++++---------- tests/namespace.test | 13 +++++++++++++ 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 7395216..0e40745 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -916,6 +916,11 @@ Tcl_DeleteNamespace( Command *cmdPtr; /* + * Ensure that this namespace doesn't get deallocated in the meantime. + */ + nsPtr->refCount++; + + /* * Give anyone interested - notably TclOO - a chance to use this namespace * normally despite the fact that the namespace is going to go. Allows the * calling of destructors. Will only be called once (unless re-established @@ -1047,16 +1052,8 @@ Tcl_DeleteNamespace( #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); - /* - * If the reference count is 0, then discard the namespace. - * Otherwise, mark it as "dead" so that it can't be used. - */ - - if (!nsPtr->refCount) { - NamespaceFree(nsPtr); - } else { - nsPtr->flags |= NS_DEAD; - } + nsPtr ->flags |= NS_DEAD; + TclNsDecrRefCount(nsPtr); } else { /* * Restore the ::errorInfo and ::errorCode traces. diff --git a/tests/namespace.test b/tests/namespace.test index ed1eed6..a6c4932 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -196,6 +196,19 @@ test namespace-7.7 {Bug 1655305} -setup { interp delete slave } -result {} +test namespace-7.8 {Bug ba1419303b4c} -setup { + namespace eval ns1 { + namespace ensemble create + } + + trace add command ns1 delete { + namespace delete ns1 + } +} -body { + # No segmentation fault given --enable-symbols=mem. + namespace delete ns1 +} -result {} + test namespace-8.1 {TclTeardownNamespace, delete global namespace} { catch {interp delete test_interp} interp create test_interp -- cgit v0.12 From dc40e6f7975ff3abcea929e29493bdc7e44c1843 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 20 Dec 2017 11:28:25 +0000 Subject: Fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion trace deletes its namespace: segmentation fault. --- generic/tclNamesp.c | 17 +++++++---------- tests/namespace.test | 13 +++++++++++++ 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 269d06b..de10fae 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -916,6 +916,11 @@ Tcl_DeleteNamespace( Command *cmdPtr; /* + * Ensure that this namespace doesn't get deallocated in the meantime. + */ + nsPtr->refCount++; + + /* * Give anyone interested - notably TclOO - a chance to use this namespace * normally despite the fact that the namespace is going to go. Allows the * calling of destructors. Will only be called once (unless re-established @@ -1047,16 +1052,8 @@ Tcl_DeleteNamespace( #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); - /* - * If the reference count is 0, then discard the namespace. - * Otherwise, mark it as "dead" so that it can't be used. - */ - - if (!nsPtr->refCount) { - NamespaceFree(nsPtr); - } else { - nsPtr->flags |= NS_DEAD; - } + nsPtr ->flags |= NS_DEAD; + TclNsDecrRefCount(nsPtr); } else { /* * Restore the ::errorInfo and ::errorCode traces. diff --git a/tests/namespace.test b/tests/namespace.test index 9fa9331..b9e6ead 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -196,6 +196,19 @@ test namespace-7.7 {Bug 1655305} -setup { interp delete slave } -result {} +test namespace-7.8 {Bug ba1419303b4c} -setup { + namespace eval ns1 { + namespace ensemble create + } + + trace add command ns1 delete { + namespace delete ns1 + } +} -body { + # No segmentation fault given --enable-symbols=mem. + namespace delete ns1 +} -result {} + test namespace-8.1 {TclTeardownNamespace, delete global namespace} { catch {interp delete test_interp} interp create test_interp -- cgit v0.12 From 1b40a626117127b6161f9c9edd7b60c345051b05 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Dec 2017 12:02:34 +0000 Subject: Change hash/index/mask fields to type "unsigned int", because that's how hash values are generally stored. This eliminates the need for PTR2UINT/UINT2PTR in various places. --- generic/tcl.h | 6 ++---- generic/tclHash.c | 31 ++++++++++++++++--------------- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 688d678..197aa9b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1127,9 +1127,7 @@ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ - void *hash; /* Hash value, stored as pointer to ensure - * that the offsets of the fields in this - * structure are not changed. */ + unsigned int hash; /* Hash value. */ ClientData clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ @@ -1224,10 +1222,10 @@ struct Tcl_HashTable { * table. */ int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ + unsigned int mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ - int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the diff --git a/generic/tclHash.c b/generic/tclHash.c index 32c9aec..193a56b 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -35,7 +35,7 @@ */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. @@ -274,7 +274,7 @@ CreateHashEntry( register Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; unsigned int hash; - int index; + unsigned int index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -308,7 +308,7 @@ CreateHashEntry( for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) { @@ -321,7 +321,7 @@ CreateHashEntry( } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (key == hPtr->key.oneWordValue) { @@ -351,7 +351,7 @@ CreateHashEntry( } hPtr->tablePtr = tablePtr; - hPtr->hash = UINT2PTR(hash); + hPtr->hash = hash; hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; tablePtr->numEntries++; @@ -393,7 +393,7 @@ Tcl_DeleteHashEntry( const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; - int index; + unsigned int index; tablePtr = entryPtr->tablePtr; @@ -410,9 +410,9 @@ Tcl_DeleteHashEntry( if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); + index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -767,14 +767,14 @@ HashArrayKey( void *keyPtr) /* Key from which to compute hash value. */ { register const int *array = (const int *) keyPtr; - register unsigned int result; + register TCL_HASH_TYPE result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; } - return (TCL_HASH_TYPE) result; + return result; } /* @@ -863,7 +863,7 @@ HashStringKey( void *keyPtr) /* Key from which to compute hash value. */ { register const char *string = keyPtr; - register unsigned int result; + register TCL_HASH_TYPE result; register char c; /* @@ -903,7 +903,7 @@ HashStringKey( result += (result << 3) + UCHAR(c); } } - return (TCL_HASH_TYPE) result; + return result; } /* @@ -985,7 +985,8 @@ static void RebuildTable( register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - int count, index, oldSize = tablePtr->numBuckets; + int count, oldSize = tablePtr->numBuckets; + unsigned int index; Tcl_HashEntry **oldBuckets = tablePtr->buckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; @@ -1038,9 +1039,9 @@ RebuildTable( *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); + index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = PTR2UINT(hPtr->hash) & tablePtr->mask; + index = hPtr->hash & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; -- cgit v0.12 From a15b801bfb5d91ea33543a69ca112cfdd4a848bb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Dec 2017 12:30:23 +0000 Subject: Remove the Tcl_FindHashEntry/Tcl_CreateHashEntry stub entries, as those are actually macro's. --- generic/tcl.decls | 26 ++++++++++++++------------ generic/tcl.h | 2 -- generic/tclDecls.h | 18 ++++++------------ generic/tclHash.c | 30 ++---------------------------- generic/tclStubInit.c | 4 ++-- 5 files changed, 24 insertions(+), 56 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index b47268f..05b29f0 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -946,11 +946,11 @@ declare 265 { declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } -# Removed in 9.0 +# Removed in 9.0: #declare 267 { # void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) #} -# Removed in 9.0 +# Removed in 9.0: #declare 268 { # void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) #} @@ -979,18 +979,18 @@ declare 274 { CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact) } -# Removed in 9.0 +# Removed in 9.0: #declare 275 { # void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) #} -# Removed in 9.0 +# Removed in 9.0: #declare 276 { # int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) #} declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } -# Removed in 9.0 +# Removed in 9.0: #declare 278 { # TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) #} @@ -1499,13 +1499,15 @@ declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase) } -declare 421 { - Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) -} -declare 422 { - Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr) -} +# Removed in 9.0, as it is actually a macro: +#declare 421 { +# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) +#} +# Removed in 9.0, as it is actually a macro: +#declare 422 { +# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +# const void *key, int *newPtr) +#} declare 423 { void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr) diff --git a/generic/tcl.h b/generic/tcl.h index 197aa9b..8d175ef 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2538,10 +2538,8 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * hash tables: */ -#undef Tcl_FindHashEntry #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) -#undef Tcl_CreateHashEntry #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8873dbf..4478a20 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1211,12 +1211,8 @@ EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, /* 420 */ EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); -/* 421 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, - const void *key); -/* 422 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr); +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); @@ -2274,8 +2270,8 @@ typedef struct TclStubs { int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ - Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ + void (*reserved421)(void); + void (*reserved422)(void); void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ @@ -3348,10 +3344,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ -#define Tcl_FindHashEntry \ - (tclStubsPtr->tcl_FindHashEntry) /* 421 */ -#define Tcl_CreateHashEntry \ - (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ diff --git a/generic/tclHash.c b/generic/tclHash.c index 193a56b..bf8da23 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -14,13 +14,6 @@ #include "tclInt.h" /* - * Prevent macros from clashing with function definitions. - */ - -#undef Tcl_FindHashEntry -#undef Tcl_CreateHashEntry - -/* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ @@ -200,7 +193,7 @@ Tcl_InitCustomHashTable( /* *---------------------------------------------------------------------- * - * Tcl_FindHashEntry -- + * FindHashEntry -- * * Given a hash table find the entry with a matching key. * @@ -214,14 +207,6 @@ Tcl_InitCustomHashTable( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_FindHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key) /* Key to use to find matching entry. */ -{ - return (*((tablePtr)->findProc))(tablePtr, key); -} - static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ @@ -234,7 +219,7 @@ FindHashEntry( /* *---------------------------------------------------------------------- * - * Tcl_CreateHashEntry -- + * CreateHashEntry -- * * Given a hash table with string keys, and a string key, find the entry * with a matching key. If there is no matching entry, then create a new @@ -252,17 +237,6 @@ FindHashEntry( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_CreateHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key, /* Key to use to find or create matching - * entry. */ - int *newPtr) /* Store info here telling whether a new entry - * was created. */ -{ - return (*((tablePtr)->createProc))(tablePtr, key, newPtr); -} - static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index fdde1a6..d26b67c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1176,8 +1176,8 @@ const TclStubs tclStubs = { Tcl_IsChannelExisting, /* 418 */ Tcl_UniCharNcasecmp, /* 419 */ Tcl_UniCharCaseMatch, /* 420 */ - Tcl_FindHashEntry, /* 421 */ - Tcl_CreateHashEntry, /* 422 */ + 0, /* 421 */ + 0, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ -- cgit v0.12 From 7835ba29c7f535499e58023579e61eaf1232c799 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 20 Dec 2017 18:22:59 +0000 Subject: Further fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion trace deletes its namespace: segmentation fault. --- generic/tclNamesp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 0e40745..f510fed 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1053,7 +1053,6 @@ Tcl_DeleteNamespace( Tcl_DeleteHashTable(&nsPtr->cmdTable); nsPtr ->flags |= NS_DEAD; - TclNsDecrRefCount(nsPtr); } else { /* * Restore the ::errorInfo and ::errorCode traces. @@ -1070,6 +1069,7 @@ Tcl_DeleteNamespace( nsPtr->flags &= ~(NS_DYING|NS_KILLED); } } + TclNsDecrRefCount(nsPtr); } /* -- cgit v0.12 From 5e11793221791b79a9aa3140e6a77c1fe64ec2e9 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 20 Dec 2017 18:25:08 +0000 Subject: Further fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion trace deletes its namespace: segmentation fault. --- generic/tclNamesp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index de10fae..f82d23d 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1053,7 +1053,6 @@ Tcl_DeleteNamespace( Tcl_DeleteHashTable(&nsPtr->cmdTable); nsPtr ->flags |= NS_DEAD; - TclNsDecrRefCount(nsPtr); } else { /* * Restore the ::errorInfo and ::errorCode traces. @@ -1070,6 +1069,7 @@ Tcl_DeleteNamespace( nsPtr->flags &= ~(NS_DYING|NS_KILLED); } } + TclNsDecrRefCount(nsPtr); } /* -- cgit v0.12 From 5a190dd003f0caaee265f6664bd1bbee842a2d66 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Dec 2017 13:23:38 +0000 Subject: Remove use of compiler option "opt:nowin98". Don't use "t" as suffix any more when building extensions (but still use it for Tcl and Tk). --- win/rules.vc | 40 ++++++++++++++-------------------------- 1 file changed, 14 insertions(+), 26 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index 7fc51c1..fac9af9 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -394,7 +394,7 @@ MSG = ^ # If INSTALLDIR set to tcl installation root dir then reset to the -# lib dir for installing extensions +# lib dir for installing extensions !if exist("$(_INSTALLDIR)\include\tcl.h") _INSTALLDIR=$(_INSTALLDIR)\lib !endif @@ -547,7 +547,7 @@ NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c # The following macros are set: # OPTIMIZATIONS - the compiler flags to be used for optimized builds # DEBUGFLAGS - the compiler flags to be used for debug builds -# LINKERFLAGS - Flags passed to the linker +# LINKERFLAGS - Flags passed to the linker # # Note that these are the compiler settings *available*, not those # that will be *used*. The latter depends on the OPTS macro settings @@ -1063,7 +1063,7 @@ STUBPREFIX = $(PROJECT)stub # Set up paths to various Tcl executables and libraries needed by extensions !if $(DOING_TCL) -TCLSHNAME = $(PROJECT)sh$(TCL_VERSION)$(SUFX).exe +TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) @@ -1153,8 +1153,8 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" !endif # $(DOING_TK) || $(NEED_TK) # Various output paths -PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib -PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) +PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib +PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT) PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib @@ -1291,7 +1291,7 @@ USE_WIDECHAR_API = 0 !endif !if $(USE_WIDECHAR_API) -COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE +COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE !endif # Like the TEA system only set this non empty for non-Tk extensions @@ -1301,7 +1301,7 @@ COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ -DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \ - -DMODULE_SCOPE=extern + -DMODULE_SCOPE=extern !endif # crt picks the C run time based on selected OPTS @@ -1394,7 +1394,7 @@ pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) # compiled with another VC version. Check for this and fix accordingly. stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES) -# Link flags +# Link flags !if $(DEBUG) ldebug = -debug -debugtype:cv @@ -1410,25 +1410,13 @@ ldebug = $(ldebug) -debug -debugtype:cv ldebug= $(ldebug) -profile !endif -### Declarations common to all linker versions +### Declarations common to all linker versions lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) !if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 lflags = $(lflags) -nodefaultlib:libucrt.lib !endif -# Old linkers (Visual C++ 6 in particular) will link for fast loading -# on Win98. Since we do not support Win98 any more, we specify nowin98 -# as recommended for NT and later. However, this is only required by -# IX86 on older compilers and only needed if we are not doing a static build. - -!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD) -!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)] -# Align sections for PE size savings. -lflags = $(lflags) -opt:nowin98 -!endif -!endif - dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows @@ -1473,9 +1461,9 @@ RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -DCOMMAVERSION=$(DOTVERSION:.=,),0 \ -DDOTVERSION=\"$(DOTVERSION)\" \ -DVERSION=\"$(VERSION)\" \ - -DSUFX=\"$(SUFX)\" \ - -DPROJECT=\"$(PROJECT)\" \ - -DPRJLIBNAME=\"$(PRJLIBNAME)\" + -DSUFX=\"$(SUFX:t=)\" \ + -DPROJECT=\"$(PROJECT)\" \ + -DPRJLIBNAME=\"$(PRJLIBNAME)\" !ifndef DEFAULT_BUILD_TARGET DEFAULT_BUILD_TARGET = $(PROJECT) @@ -1572,7 +1560,7 @@ default-shell: default-setup $(PROJECT) @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)" $(DEBUGGER) $(TCLSH) -# Generation of Windows version resource +# Generation of Windows version resource !ifdef RCFILE # Note: don't use $** in below rule because there may be other dependencies @@ -1611,7 +1599,7 @@ BEGIN VALUE "OriginalFilename", PRJLIBNAME VALUE "FileVersion", DOTVERSION VALUE "ProductName", "Package " PROJECT " for Tcl" - VALUE "ProductVersion", DOTVERSION + VALUE "ProductVersion", DOTVERSION END END BLOCK "VarFileInfo" -- cgit v0.12 From 189c6453b43325f74f5b004694c79c5786d918c1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Dec 2017 15:45:05 +0000 Subject: Change a few (internal) refCount/mask variables to unsigned type. --- generic/tclInt.h | 9 ++++----- generic/tclLiteral.c | 23 ++++++++++++----------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index de22924..2ba0493 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -545,7 +545,7 @@ typedef struct CommandTrace { struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - unsigned int refCount; /* Used to ensure this structure is not + size_t refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ @@ -1492,11 +1492,11 @@ typedef struct LiteralEntry { * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ - int refCount; /* If in an interpreter's global literal + size_t refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to - * 0. If in a local literal table, -1. */ + * 0. If in a local literal table, (size_t)-1. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce @@ -1516,7 +1516,7 @@ typedef struct LiteralTable { * table. */ int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - int mask; /* Mask value used in hashing function. */ + unsigned int mask; /* Mask value used in hashing function. */ } LiteralTable; /* @@ -2962,7 +2962,6 @@ MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); - MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 7acc9ad..003884d 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -186,7 +186,7 @@ TclCreateLiteral( { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; - int globalHash; + unsigned int globalHash; Tcl_Obj *objPtr; /* @@ -393,7 +393,8 @@ TclRegisterLiteral( LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; unsigned hash; - int localHash, objIndex, new; + unsigned int localHash; + int objIndex, new; Namespace *nsPtr; if (length < 0) { @@ -537,7 +538,8 @@ TclHideLiteral( { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - int localHash, length; + unsigned int localHash; + int length; const char *bytes; Tcl_Obj *newObjPtr; @@ -556,7 +558,7 @@ TclHideLiteral( lPtr->objPtr = newObjPtr; bytes = TclGetStringFromObj(newObjPtr, &length); - localHash = (HashString(bytes, length) & localTablePtr->mask); + localHash = HashString(bytes, length) & localTablePtr->mask; nextPtrPtr = &localTablePtr->buckets[localHash]; for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) { @@ -612,7 +614,7 @@ TclAddLiteralObj( lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = -1; /* i.e., unused */ + lPtr->refCount = (size_t)-1; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { @@ -809,7 +811,8 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; register LiteralEntry *entryPtr, *prevPtr; const char *bytes; - int length, index; + int length; + unsigned int index; if (iPtr == NULL) { goto done; @@ -828,15 +831,13 @@ TclReleaseLiteral( for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index]; entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { - entryPtr->refCount--; - /* * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ - if (entryPtr->refCount == 0) { + if (entryPtr->refCount-- <= 1) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { @@ -954,8 +955,8 @@ RebuildLiteralTable( register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - unsigned int oldSize; - int count, index, length; + unsigned int oldSize, index; + int count, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; -- cgit v0.12 From 9a9b619c9f29470dab9e33b0c593b7e648224515 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 26 Dec 2017 12:27:14 +0000 Subject: TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. --- generic/tclOOBasic.c | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b2c06a7..d874cba 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1206,22 +1206,10 @@ TclOOCopyObjectCmd( o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { const char *name, *namespaceName; - Tcl_DString buffer; name = TclGetString(objv[2]); - Tcl_DStringInit(&buffer); if (name[0] == '\0') { name = NULL; - } else if (name[0]!=':' || name[1]!=':') { - Interp *iPtr = (Interp *) interp; - - if (iPtr->varFramePtr != NULL) { - Tcl_DStringAppend(&buffer, - iPtr->varFramePtr->nsPtr->fullName, -1); - } - TclDStringAppendLiteral(&buffer, "::"); - Tcl_DStringAppend(&buffer, name, -1); - name = Tcl_DStringValue(&buffer); } /* @@ -1243,7 +1231,6 @@ TclOOCopyObjectCmd( } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); - Tcl_DStringFree(&buffer); } if (o2Ptr == NULL) { -- cgit v0.12 From 63224df965c165226da5226eba2d0036d0b6d2b3 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 26 Dec 2017 12:54:00 +0000 Subject: TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. --- generic/tclOOBasic.c | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b2c06a7..d874cba 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1206,22 +1206,10 @@ TclOOCopyObjectCmd( o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { const char *name, *namespaceName; - Tcl_DString buffer; name = TclGetString(objv[2]); - Tcl_DStringInit(&buffer); if (name[0] == '\0') { name = NULL; - } else if (name[0]!=':' || name[1]!=':') { - Interp *iPtr = (Interp *) interp; - - if (iPtr->varFramePtr != NULL) { - Tcl_DStringAppend(&buffer, - iPtr->varFramePtr->nsPtr->fullName, -1); - } - TclDStringAppendLiteral(&buffer, "::"); - Tcl_DStringAppend(&buffer, name, -1); - name = Tcl_DStringValue(&buffer); } /* @@ -1243,7 +1231,6 @@ TclOOCopyObjectCmd( } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); - Tcl_DStringFree(&buffer); } if (o2Ptr == NULL) { -- cgit v0.12 From 69be965a23d98385d4acac0644ae83c5c24c1662 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Dec 2017 11:32:40 +0000 Subject: change ClientData -> void * in a lot of places (mainly header files) --- generic/tcl.decls | 138 +++++++++++----------- generic/tcl.h | 132 +++++++++++---------- generic/tclCompile.h | 22 ++-- generic/tclDecls.h | 298 +++++++++++++++++++++++------------------------- generic/tclFileSystem.h | 2 +- generic/tclIO.h | 2 +- generic/tclInt.decls | 28 ++--- generic/tclInt.h | 286 +++++++++++++++++++++++----------------------- generic/tclIntDecls.h | 35 +++--- generic/tclOO.decls | 22 ++-- generic/tclOO.h | 10 +- generic/tclOODecls.h | 28 ++--- generic/tclOOInt.h | 68 +++++------ generic/tclOOIntDecls.h | 28 ++--- win/tclWinInt.h | 4 +- 15 files changed, 542 insertions(+), 561 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 89c7cd4..b453b47 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -65,7 +65,7 @@ declare 8 { declare 9 unix { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, - ClientData clientData) + void *clientData) } declare 10 unix { void Tcl_DeleteFileHandler(int fd) @@ -268,7 +268,7 @@ declare 70 { } declare 71 { Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - ClientData clientData) + void *clientData) } declare 72 { void Tcl_AsyncDelete(Tcl_AsyncHandler async) @@ -295,10 +295,10 @@ declare 78 { } declare 79 { void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, - ClientData clientData) + void *clientData) } declare 80 { - void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData) + void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData) } declare 81 { int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) @@ -328,27 +328,27 @@ declare 87 { } declare 88 { Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, ClientData instanceData, int mask) + const char *chanName, void *instanceData, int mask) } declare 89 { void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, ClientData clientData) + Tcl_ChannelProc *proc, void *clientData) } declare 90 { void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - ClientData clientData) + void *clientData) } declare 91 { Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_CmdProc *proc, ClientData clientData, + Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 92 { void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, ClientData clientData) + Tcl_EventCheckProc *checkProc, void *clientData) } declare 93 { - void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) @@ -356,12 +356,12 @@ declare 94 { declare 95 { void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, - Tcl_MathProc *proc, ClientData clientData) + Tcl_MathProc *proc, void *clientData) } declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_ObjCmdProc *proc, ClientData clientData, + Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 97 { @@ -370,22 +370,22 @@ declare 97 { } declare 98 { Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, ClientData clientData) + Tcl_TimerProc *proc, void *clientData) } declare 99 { Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, ClientData clientData) + Tcl_CmdTraceProc *proc, void *clientData) } declare 100 { void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name) } declare 101 { void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, - ClientData clientData) + void *clientData) } declare 102 { void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - ClientData clientData) + void *clientData) } declare 103 { int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName) @@ -394,14 +394,14 @@ declare 104 { int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command) } declare 105 { - void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData) + void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, void *clientData) } declare 106 { void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, ClientData clientData) + Tcl_EventCheckProc *checkProc, void *clientData) } declare 107 { - void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 108 { void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr) @@ -423,13 +423,13 @@ declare 113 { } declare 114 { void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, ClientData clientData) + Tcl_InterpDeleteProc *proc, void *clientData) } declare 115 { int Tcl_DoOneEvent(int flags) } declare 116 { - void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) + void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData) } declare 117 { char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length) @@ -478,7 +478,7 @@ declare 130 { # int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) #} declare 132 { - void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc) + void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc) } declare 133 { TCL_NORETURN void Tcl_Exit(int status) @@ -539,7 +539,7 @@ declare 149 { int *objcPtr, Tcl_Obj ***objv) } declare 150 { - ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, + void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 { @@ -551,10 +551,10 @@ declare 152 { } declare 153 { int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - ClientData *handlePtr) + void **handlePtr) } declare 154 { - ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan) + void *Tcl_GetChannelInstanceData(Tcl_Channel chan) } declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) @@ -601,7 +601,7 @@ declare 166 { declare 167 unix { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr) + int checkUsage, void **filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified # and therefore usually faster. @@ -679,13 +679,13 @@ declare 187 { # } declare 189 { - Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode) + Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode) } declare 190 { int Tcl_MakeSafe(Tcl_Interp *interp) } declare 191 { - Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) + Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket) } declare 192 { char *Tcl_Merge(int argc, CONST84 char *const *argv) @@ -720,10 +720,10 @@ declare 199 { declare 200 { Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + void *callbackData) } declare 201 { - void Tcl_Preserve(ClientData data) + void Tcl_Preserve(void *data) } declare 202 { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) @@ -771,7 +771,7 @@ declare 215 { CONST84 char **startPtr, CONST84 char **endPtr) } declare 216 { - void Tcl_Release(ClientData clientData) + void Tcl_Release(void *clientData) } declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) @@ -794,7 +794,7 @@ declare 222 { } declare 223 { void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, - Tcl_InterpDeleteProc *proc, ClientData clientData) + Tcl_InterpDeleteProc *proc, void *clientData) } declare 224 { void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz) @@ -876,11 +876,11 @@ declare 245 { #} declare 247 { int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, ClientData clientData) + Tcl_VarTraceProc *proc, void *clientData) } declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, - int flags, Tcl_VarTraceProc *proc, ClientData clientData) + int flags, Tcl_VarTraceProc *proc, void *clientData) } declare 249 { char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, @@ -904,12 +904,12 @@ declare 254 { } declare 255 { void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, ClientData clientData) + Tcl_VarTraceProc *proc, void *clientData) } declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - ClientData clientData) + void *clientData) } declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) @@ -926,13 +926,13 @@ declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } declare 261 { - ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) + void *Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, + int flags, Tcl_VarTraceProc *procPtr, void *prevClientData) } declare 262 { - ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, + void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData) + void *prevClientData) } declare 263 { int Tcl_Write(Tcl_Channel chan, const char *s, int slen) @@ -1018,7 +1018,7 @@ declare 280 { declare 281 { Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, - const Tcl_ChannelType *typePtr, ClientData instanceData, + const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan) } declare 282 { @@ -1046,10 +1046,10 @@ declare 287 { Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr) } declare 288 { - void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 289 { - void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 290 { void Tcl_DiscardResult(Tcl_SavedResult *statePtr) @@ -1082,7 +1082,7 @@ declare 297 { void Tcl_FinalizeThread(void) } declare 298 { - void Tcl_FinalizeNotifier(ClientData clientData) + void Tcl_FinalizeNotifier(void *clientData) } declare 299 { void Tcl_FreeEncoding(Tcl_Encoding encoding) @@ -1112,7 +1112,7 @@ declare 306 { const char *part2, int flags) } declare 307 { - ClientData Tcl_InitNotifier(void) + void *Tcl_InitNotifier(void) } declare 308 { void Tcl_MutexLock(Tcl_Mutex *mutexPtr) @@ -1228,7 +1228,7 @@ declare 342 { void Tcl_SetDefaultEncodingDir(const char *path) } declare 343 { - void Tcl_AlertNotifier(ClientData clientData) + void Tcl_AlertNotifier(void *clientData) } declare 344 { void Tcl_ServiceModeHook(int mode) @@ -1387,7 +1387,7 @@ declare 389 { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern) } declare 390 { - int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, + int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 391 { @@ -1398,7 +1398,7 @@ declare 392 { } declare 393 { int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, - ClientData clientData, int stackSize, int flags) + void *clientData, int stackSize, int flags) } # Introduced in 8.3.2 @@ -1517,17 +1517,17 @@ declare 424 { void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) } declare 425 { - ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, + void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - ClientData prevClientData) + void *prevClientData) } declare 426 { int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, ClientData clientData) + Tcl_CommandTraceProc *proc, void *clientData) } declare 427 { void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, - int flags, Tcl_CommandTraceProc *proc, ClientData clientData) + int flags, Tcl_CommandTraceProc *proc, void *clientData) } declare 428 { void *Tcl_AttemptAlloc(size_t size) @@ -1560,7 +1560,7 @@ declare 434 { declare 435 { int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, ClientData *clientDataPtr) + Tcl_MathProc **procPtr, void **clientDataPtr) } declare 436 { Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) @@ -1665,7 +1665,7 @@ declare 464 { Tcl_Obj *const objv[]) } declare 465 { - ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, + void *Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr) } declare 466 { @@ -1676,7 +1676,7 @@ declare 467 { } declare 468 { Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem, - ClientData clientData) + void *clientData) } declare 469 { const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr) @@ -1691,13 +1691,13 @@ declare 472 { Tcl_Obj *Tcl_FSListVolumes(void) } declare 473 { - int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr) + int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr) } declare 474 { int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr) } declare 475 { - ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr) + void *Tcl_FSData(const Tcl_Filesystem *fsPtr) } declare 476 { const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, @@ -1732,7 +1732,7 @@ declare 482 { # TIP#32 (object-enabled traces) kbk declare 483 { Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, - Tcl_CmdObjTraceProc *objProc, ClientData clientData, + Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc) } declare 484 { @@ -1830,7 +1830,7 @@ declare 505 { # dkf, API by Brent Welch? declare 506 { Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) + void *clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 507 { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) @@ -1887,12 +1887,12 @@ declare 519 { # TIP#143 (resource limits) dkf declare 520 { void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, ClientData clientData, + Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc) } declare 521 { void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, ClientData clientData) + Tcl_LimitHandlerProc *handlerProc, void *clientData) } declare 522 { int Tcl_LimitReady(Tcl_Interp *interp) @@ -2005,12 +2005,12 @@ declare 551 { declare 552 { void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) } declare 553 { void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) } # TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4 @@ -2124,7 +2124,7 @@ declare 579 { # TIP #285 (script cancellation support) jmistachkin declare 580 { int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, - ClientData clientData, int flags) + void *clientData, int flags) } declare 581 { int Tcl_Canceled(Tcl_Interp *interp, int flags) @@ -2140,7 +2140,7 @@ declare 582 { declare 583 { Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, ClientData clientData, + Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 584 { @@ -2156,14 +2156,14 @@ declare 586 { } declare 587 { void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, - ClientData data0, ClientData data1, ClientData data2, - ClientData data3) + void *data0, void *data1, void *data2, + void *data3) } # For use by NR extenders, to have a simple way to also provide a (required!) # classic objProc declare 588 { int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, - ClientData clientData, int objc, Tcl_Obj *const objv[]) + void *clientData, int objc, Tcl_Obj *const objv[]) } # TIP#316 (Tcl_StatBuf reader functions) dkf @@ -2339,7 +2339,7 @@ declare 630 { declare 631 { Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + void *callbackData) } # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tcl.h b/generic/tcl.h index f2f0f79..d5346cd 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -335,12 +335,8 @@ typedef long LONG; * Miscellaneous declarations. */ -#ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif +#if !defined(_CLIENTDATA) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 10 + typedef void *ClientData; # define _CLIENTDATA #endif @@ -514,9 +510,9 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream; */ #if defined _WIN32 -typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData); +typedef unsigned (__stdcall Tcl_ThreadCreateProc) (void *clientData); #else -typedef void (Tcl_ThreadCreateProc) (ClientData clientData); +typedef void (Tcl_ThreadCreateProc) (void *clientData); #endif /* @@ -671,62 +667,62 @@ struct Tcl_Obj; */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); -typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp, int code); -typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); -typedef void (Tcl_CloseProc) (ClientData data); -typedef void (Tcl_CmdDeleteProc) (ClientData clientData); -typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_ChannelProc) (void *clientData, int mask); +typedef void (Tcl_CloseProc) (void *data); +typedef void (Tcl_CmdDeleteProc) (void *clientData); +typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[]); -typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, CONST84 char *argv[]); -typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, + void *cmdClientData, int argc, CONST84 char *argv[]); +typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); -typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); +typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); -typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, +typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); #define Tcl_EncodingFreeProc Tcl_FreeProc typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); -typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); -typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); -typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); +typedef void (Tcl_EventCheckProc) (void *clientData, int flags); +typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); +typedef void (Tcl_EventSetupProc) (void *clientData, int flags); #define Tcl_ExitProc Tcl_FreeProc -typedef void (Tcl_FileProc) (ClientData clientData, int mask); +typedef void (Tcl_FileProc) (void *clientData, int mask); #define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_FreeProc) (void *blockPtr); -typedef void (Tcl_IdleProc) (ClientData clientData); -typedef void (Tcl_InterpDeleteProc) (ClientData clientData, +typedef void (Tcl_IdleProc) (void *clientData); +typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); -typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_MathProc) (void *clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); -typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); -typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_NamespaceDeleteProc) (void *clientData); +typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp); typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); -typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, +typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); -typedef void (Tcl_TimerProc) (ClientData clientData); +typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); -typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2, int flags); -typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, - ClientData clientData); + void *clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); -typedef void (Tcl_AlertNotifierProc) (ClientData clientData); +typedef void (Tcl_AlertNotifierProc) (void *clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); -typedef ClientData (Tcl_InitNotifierProc) (void); -typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData); +typedef void *(Tcl_InitNotifierProc) (void); +typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); /* @@ -836,7 +832,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - ClientData clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -908,13 +904,13 @@ typedef struct Tcl_CmdInfo { * Tcl_SetCmdInfo does not modify this * field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ - ClientData objClientData; /* ClientData for object proc. */ + void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - ClientData clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - ClientData deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -1356,8 +1352,8 @@ typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); * TIP #233 (Virtualized Time) */ -typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData); -typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); +typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, void *clientData); +typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData); /* *---------------------------------------------------------------------------- @@ -1416,40 +1412,40 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); * Typedefs for the various operations in a channel type: */ -typedef int (Tcl_DriverBlockModeProc) (ClientData instanceData, int mode); -typedef int (Tcl_DriverCloseProc) (ClientData instanceData, +typedef int (Tcl_DriverBlockModeProc) (void *instanceData, int mode); +typedef int (Tcl_DriverCloseProc) (void *instanceData, Tcl_Interp *interp); -typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, +typedef int (Tcl_DriverClose2Proc) (void *instanceData, Tcl_Interp *interp, int flags); -typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, +typedef int (Tcl_DriverInputProc) (void *instanceData, char *buf, int toRead, int *errorCodePtr); -typedef int (Tcl_DriverOutputProc) (ClientData instanceData, +typedef int (Tcl_DriverOutputProc) (void *instanceData, CONST84 char *buf, int toWrite, int *errorCodePtr); -typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, +typedef int (Tcl_DriverSeekProc) (void *instanceData, long offset, int mode, int *errorCodePtr); -typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, +typedef int (Tcl_DriverSetOptionProc) (void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); -typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, +typedef int (Tcl_DriverGetOptionProc) (void *instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr); -typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); -typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, - int direction, ClientData *handlePtr); -typedef int (Tcl_DriverFlushProc) (ClientData instanceData); -typedef int (Tcl_DriverHandlerProc) (ClientData instanceData, +typedef void (Tcl_DriverWatchProc) (void *instanceData, int mask); +typedef int (Tcl_DriverGetHandleProc) (void *instanceData, + int direction, void **handlePtr); +typedef int (Tcl_DriverFlushProc) (void *instanceData); +typedef int (Tcl_DriverHandlerProc) (void *instanceData, int interestMask); -typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData, +typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr); /* * TIP #218, Channel Thread Actions */ -typedef void (Tcl_DriverThreadActionProc) (ClientData instanceData, +typedef void (Tcl_DriverThreadActionProc) (void *instanceData, int action); /* * TIP #208, File Truncation (etc.) */ -typedef int (Tcl_DriverTruncateProc) (ClientData instanceData, +typedef int (Tcl_DriverTruncateProc) (void *instanceData, Tcl_WideInt length); /* @@ -1631,13 +1627,13 @@ typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, - ClientData *clientDataPtr); + void **clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); #define Tcl_FSFreeInternalRepProc Tcl_FreeProc -typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); -typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); -typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); +typedef void *(Tcl_FSDupInternalRepProc) (void *clientData); +typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (void *clientData); +typedef void *(Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); typedef struct Tcl_FSVersion_ *Tcl_FSVersion; @@ -2043,7 +2039,7 @@ typedef struct Tcl_EncodingType { Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - ClientData clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ int nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2197,8 +2193,8 @@ typedef struct Tcl_Config { * command- or time-limit is exceeded by an interpreter. */ -typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); -typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); +typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp); +typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData); /* *---------------------------------------------------------------------------- @@ -2229,7 +2225,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - ClientData clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2252,9 +2248,9 @@ typedef struct { * argument types: */ -typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr, +typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr, void *dstPtr); -typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, void *dstPtr); /* @@ -2331,7 +2327,7 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, * Single public declaration for NRE. */ -typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, +typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, int result); /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index d6b9fa3..90c15eb 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -217,9 +217,9 @@ typedef struct { * the AuxData structure. */ -typedef ClientData (AuxDataDupProc) (ClientData clientData); -typedef void (AuxDataFreeProc) (ClientData clientData); -typedef void (AuxDataPrintProc)(ClientData clientData, +typedef void *(AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc)(void *clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); @@ -266,7 +266,7 @@ typedef struct AuxDataType { typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ - ClientData clientData; /* The compilation data itself. */ + void *clientData; /* The compilation data itself. */ } AuxData; /* @@ -1092,7 +1092,7 @@ MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); -MODULE_SCOPE int TclCreateAuxData(ClientData clientData, +MODULE_SCOPE int TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); @@ -1164,16 +1164,16 @@ MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); -MODULE_SCOPE int TclSingleOpCmd(ClientData clientData, +MODULE_SCOPE int TclSingleOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclSortingOpCmd(ClientData clientData, +MODULE_SCOPE int TclSortingOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData, +MODULE_SCOPE int TclVariadicOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData, +MODULE_SCOPE int TclNoIdentOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #ifdef TCL_COMPILE_DEBUG @@ -1189,7 +1189,7 @@ MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); -MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, +MODULE_SCOPE int TclPushProcCallFrame(void *clientData, register Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); @@ -1204,7 +1204,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, /* * Simplified form to access AuxData. * - * ClientData TclFetchAuxData(CompileEng *envPtr, int index); + * void *TclFetchAuxData(CompileEng *envPtr, int index); */ #define TclFetchAuxData(envPtr, index) \ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 182f6c1..ffb8d3f 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -75,12 +75,12 @@ EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t size, #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ @@ -252,7 +252,7 @@ EXTERN void Tcl_AppendElement(Tcl_Interp *interp, EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - ClientData clientData); + void *clientData); /* 72 */ EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ @@ -270,11 +270,10 @@ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionList); /* 79 */ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, - ClientData clientData); + Tcl_InterpDeleteProc *proc, void *clientData); /* 80 */ EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, - ClientData clientData); + void *clientData); /* 81 */ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ @@ -299,57 +298,56 @@ EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave, Tcl_Obj *const objv[]); /* 88 */ EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, - ClientData instanceData, int mask); + const char *chanName, void *instanceData, + int mask); /* 89 */ EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, ClientData clientData); + Tcl_ChannelProc *proc, void *clientData); /* 90 */ EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, ClientData clientData); + Tcl_CloseProc *proc, void *clientData); /* 91 */ EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - ClientData clientData); + void *clientData); /* 93 */ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); /* 95 */ EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, - ClientData clientData); + void *clientData); /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName, int isSafe); /* 98 */ EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, ClientData clientData); + Tcl_TimerProc *proc, void *clientData); /* 99 */ EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, - ClientData clientData); + Tcl_CmdTraceProc *proc, void *clientData); /* 100 */ EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, - Tcl_ChannelProc *proc, ClientData clientData); + Tcl_ChannelProc *proc, void *clientData); /* 102 */ EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, ClientData clientData); + Tcl_CloseProc *proc, void *clientData); /* 103 */ EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); @@ -358,14 +356,14 @@ EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, - ClientData clientData); + void *clientData); /* 106 */ EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - ClientData clientData); + void *clientData); /* 107 */ EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 108 */ EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ @@ -380,13 +378,11 @@ EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, - ClientData clientData); + Tcl_InterpDeleteProc *proc, void *clientData); /* 115 */ EXTERN int Tcl_DoOneEvent(int flags); /* 116 */ -EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, - ClientData clientData); +EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData); /* 117 */ EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length); @@ -422,7 +418,7 @@ EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); /* Slot 131 is reserved */ /* 132 */ -EXTERN void Tcl_EventuallyFree(ClientData clientData, +EXTERN void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc); /* 133 */ EXTERN TCL_NORETURN void Tcl_Exit(int status); @@ -477,7 +473,7 @@ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ -EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, +EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ @@ -487,9 +483,9 @@ EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - ClientData *handlePtr); + void **handlePtr); /* 154 */ -EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); +EXTERN void * Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ @@ -523,13 +519,13 @@ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr); + int checkUsage, void **filePtr); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr); + int checkUsage, void **filePtr); #endif /* MACOSX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); @@ -582,11 +578,11 @@ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr, int type); /* Slot 188 is reserved */ /* 189 */ -EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); +EXTERN Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode); /* 190 */ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ -EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); +EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket); /* 192 */ EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv); /* 193 */ @@ -615,9 +611,9 @@ EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData); + void *callbackData); /* 201 */ -EXTERN void Tcl_Preserve(ClientData data); +EXTERN void Tcl_Preserve(void *data); /* 202 */ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); @@ -657,7 +653,7 @@ EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 216 */ -EXTERN void Tcl_Release(ClientData clientData); +EXTERN void Tcl_Release(void *clientData); /* 217 */ EXTERN void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ @@ -673,7 +669,7 @@ EXTERN int Tcl_ServiceEvent(int flags); /* 223 */ EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, - ClientData clientData); + void *clientData); /* 224 */ EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ @@ -740,12 +736,11 @@ EXTERN int Tcl_StringMatch(const char *str, const char *pattern); /* 247 */ EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, - ClientData clientData); + void *clientData); /* 248 */ EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, - Tcl_VarTraceProc *proc, - ClientData clientData); + Tcl_VarTraceProc *proc, void *clientData); /* 249 */ EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); @@ -767,13 +762,12 @@ EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, /* 255 */ EXTERN void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, - ClientData clientData); + Tcl_VarTraceProc *proc, void *clientData); /* 256 */ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - ClientData clientData); + void *clientData); /* 257 */ EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); @@ -788,15 +782,15 @@ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, /* 260 */ EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); /* 261 */ -EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, +EXTERN void * Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 262 */ -EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, +EXTERN void * Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 263 */ EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); /* 264 */ @@ -841,7 +835,7 @@ EXTERN void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, - ClientData instanceData, int mask, + void *instanceData, int mask, Tcl_Channel prevChan); /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, @@ -858,10 +852,10 @@ EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 290 */ EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); /* 291 */ @@ -889,7 +883,7 @@ EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, /* 297 */ EXTERN void Tcl_FinalizeThread(void); /* 298 */ -EXTERN void Tcl_FinalizeNotifier(ClientData clientData); +EXTERN void Tcl_FinalizeNotifier(void *clientData); /* 299 */ EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ @@ -912,7 +906,7 @@ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ -EXTERN ClientData Tcl_InitNotifier(void); +EXTERN void * Tcl_InitNotifier(void); /* 308 */ EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ @@ -1001,7 +995,7 @@ EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); /* 342 */ EXTERN void Tcl_SetDefaultEncodingDir(const char *path); /* 343 */ -EXTERN void Tcl_AlertNotifier(ClientData clientData); +EXTERN void Tcl_AlertNotifier(void *clientData); /* 344 */ EXTERN void Tcl_ServiceModeHook(int mode); /* 345 */ @@ -1123,18 +1117,16 @@ EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ -EXTERN int Tcl_ProcObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +EXTERN int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* 391 */ EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, - ClientData clientData, int stackSize, - int flags); + Tcl_ThreadCreateProc *proc, void *clientData, + int stackSize, int flags); /* 394 */ EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead); @@ -1216,20 +1208,18 @@ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, /* 424 */ EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ -EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, +EXTERN void * Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 426 */ EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, - ClientData clientData); + Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, - ClientData clientData); + Tcl_CommandTraceProc *proc, void *clientData); /* 428 */ EXTERN void * Tcl_AttemptAlloc(size_t size); /* 429 */ @@ -1252,8 +1242,7 @@ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - ClientData *clientDataPtr); + Tcl_MathProc **procPtr, void **clientDataPtr); /* 436 */ EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern); @@ -1337,7 +1326,7 @@ EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ -EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, +EXTERN void * Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, @@ -1347,7 +1336,7 @@ EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ EXTERN Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, - ClientData clientData); + void *clientData); /* 469 */ EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ @@ -1357,12 +1346,12 @@ EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ EXTERN Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ -EXTERN int Tcl_FSRegister(ClientData clientData, +EXTERN int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr); /* 474 */ EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ -EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); +EXTERN void * Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); @@ -1382,7 +1371,7 @@ EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, - ClientData clientData, + void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, @@ -1453,7 +1442,7 @@ EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp, const char *valEncoding); /* 506 */ EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, - const char *name, ClientData clientData, + const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); @@ -1494,12 +1483,12 @@ EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - ClientData clientData, + void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - ClientData clientData); + void *clientData); /* 522 */ EXTERN int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ @@ -1582,11 +1571,11 @@ EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, /* 552 */ EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData); + void *clientData); /* 553 */ EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData); + void **clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); @@ -1663,7 +1652,7 @@ EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ EXTERN int Tcl_CancelEval(Tcl_Interp *interp, - Tcl_Obj *resultObjPtr, ClientData clientData, + Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 581 */ EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); @@ -1674,8 +1663,7 @@ EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, /* 583 */ EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, - ClientData clientData, + Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -1688,14 +1676,12 @@ EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, - Tcl_NRPostProc *postProcPtr, - ClientData data0, ClientData data1, - ClientData data2, ClientData data3); + Tcl_NRPostProc *postProcPtr, void *data0, + void *data1, void *data2, void *data3); /* 588 */ EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, - Tcl_ObjCmdProc *objProc, - ClientData clientData, int objc, - Tcl_Obj *const objv[]); + Tcl_ObjCmdProc *objProc, void *clientData, + int objc, Tcl_Obj *const objv[]); /* 589 */ EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ @@ -1811,7 +1797,7 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData); + void *callbackData); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -1833,13 +1819,13 @@ typedef struct TclStubs { void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ + void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved9)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ + void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ @@ -1910,7 +1896,7 @@ typedef struct TclStubs { void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ - Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */ + Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, void *clientData); /* 71 */ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */ int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ @@ -1918,8 +1904,8 @@ typedef struct TclStubs { void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ void (*reserved77)(void); int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ - void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ - void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ + void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */ + void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */ @@ -1927,35 +1913,35 @@ typedef struct TclStubs { int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ - Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ - void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ - void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */ - Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ - void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ - void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ + Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, void *instanceData, int mask); /* 88 */ + void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, void *clientData); /* 89 */ + void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 90 */ + Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ + void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */ + void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ - void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ - Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ + void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, void *clientData); /* 95 */ + Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */ - Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */ - Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */ + Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */ + Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */ void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */ - void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */ - void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */ + void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */ + void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */ int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */ int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */ - void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */ - void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */ - void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */ + void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */ + void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */ + void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 107 */ void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */ void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */ void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */ void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */ void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */ void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */ - void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */ + void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 114 */ int (*tcl_DoOneEvent) (int flags); /* 115 */ - void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */ + void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, void *clientData); /* 116 */ char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, size_t length); /* 117 */ char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */ void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */ @@ -1971,7 +1957,7 @@ typedef struct TclStubs { int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ void (*reserved131)(void); - void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ + void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */ @@ -1989,11 +1975,11 @@ typedef struct TclStubs { void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ - ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ + void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ - int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ - ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ + int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */ + void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ @@ -2007,13 +1993,13 @@ typedef struct TclStubs { const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ + int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved167)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ + int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ #endif /* MACOSX */ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */ int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ @@ -2036,9 +2022,9 @@ typedef struct TclStubs { char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */ void (*reserved188)(void); - Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ + Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ - Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ + Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */ char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ @@ -2047,8 +2033,8 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ - Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ - void (*tcl_Preserve) (ClientData data); /* 201 */ + Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */ + void (*tcl_Preserve) (void *data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ @@ -2063,14 +2049,14 @@ typedef struct TclStubs { int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */ - void (*tcl_Release) (ClientData clientData); /* 216 */ + void (*tcl_Release) (void *clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ - void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ + void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */ void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */ int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */ int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */ @@ -2094,22 +2080,22 @@ typedef struct TclStubs { void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ void (*reserved246)(void); - int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ - int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ + int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 247 */ + int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ - void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */ - void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ + void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 255 */ + void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 256 */ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ - ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ - ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ + void * (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 261 */ + void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */ int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ @@ -2128,15 +2114,15 @@ typedef struct TclStubs { void (*reserved278)(void); void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ - Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */ + Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ void (*reserved285)(void); void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ - void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ - void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ + void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ + void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */ void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ @@ -2145,7 +2131,7 @@ typedef struct TclStubs { int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ - void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */ + void (*tcl_FinalizeNotifier) (void *clientData); /* 298 */ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ @@ -2154,7 +2140,7 @@ typedef struct TclStubs { int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */ - ClientData (*tcl_InitNotifier) (void); /* 307 */ + void * (*tcl_InitNotifier) (void); /* 307 */ void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */ void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */ @@ -2190,7 +2176,7 @@ typedef struct TclStubs { char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ - void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ + void (*tcl_AlertNotifier) (void *clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ @@ -2237,10 +2223,10 @@ typedef struct TclStubs { Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ - int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ + int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */ - int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */ + int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, int stackSize, int flags); /* 393 */ int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */ int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ @@ -2272,9 +2258,9 @@ typedef struct TclStubs { void (*reserved422)(void); void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ - ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ - int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ - void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ + void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */ + int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */ + void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ void * (*tcl_AttemptAlloc) (size_t size); /* 428 */ void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */ @@ -2282,7 +2268,7 @@ typedef struct TclStubs { int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ - int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ + int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, void **clientDataPtr); /* 435 */ Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ @@ -2312,17 +2298,17 @@ typedef struct TclStubs { int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */ - ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ + void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */ int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */ - Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */ + Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */ const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */ Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */ Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */ Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */ - int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */ + int (*tcl_FSRegister) (void *clientData, const Tcl_Filesystem *fsPtr); /* 473 */ int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ - ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ + void * (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */ CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */ @@ -2330,7 +2316,7 @@ typedef struct TclStubs { void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */ int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */ void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */ - Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ + Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ @@ -2353,7 +2339,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */ Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */ void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */ - Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ + Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */ @@ -2367,8 +2353,8 @@ typedef struct TclStubs { void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ - void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ - void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ + void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ + void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */ int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */ @@ -2399,8 +2385,8 @@ typedef struct TclStubs { int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ - void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ - void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ + void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */ + void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */ @@ -2427,15 +2413,15 @@ typedef struct TclStubs { int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */ void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */ - int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */ + int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 580 */ int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */ int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */ - Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ + Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */ int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */ int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ - void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */ - int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ + void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, void *data0, void *data1, void *data2, void *data3); /* 587 */ + int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ @@ -2478,7 +2464,7 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ - Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */ } TclStubs; extern const TclStubs *tclStubsPtr; diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 1eec7ff..684407c 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -30,7 +30,7 @@ MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, - const Tcl_Filesystem *fsPtr, ClientData clientData); + const Tcl_Filesystem *fsPtr, void *clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); MODULE_SCOPE size_t TclFSEpoch(void); diff --git a/generic/tclIO.h b/generic/tclIO.h index 07c54fa..15f0f78 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -96,7 +96,7 @@ typedef struct EventScriptRecord { typedef struct Channel { struct ChannelState *state; /* Split out state information */ - ClientData instanceData; /* Instance-specific data provided by creator + void *instanceData; /* Instance-specific data provided by creator * of channel. */ const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */ struct Channel *downChanPtr;/* Refers to channel this one was stacked diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 9ee376c..a2f51ab 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -80,7 +80,7 @@ declare 12 { # Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) #} declare 14 { - int TclDumpMemoryInfo(ClientData clientData, int flags) + int TclDumpMemoryInfo(void *clientData, int flags) } # Removed in 8.1: # declare 15 { @@ -227,11 +227,11 @@ declare 51 { # int flags) #} declare 53 { - int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, + int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, CONST84 char **argv) } declare 54 { - int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, + int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 55 { @@ -267,7 +267,7 @@ declare 62 { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 { - int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, + int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { @@ -360,7 +360,7 @@ declare 81 { # } # Removed in 9.0: #declare 88 { -# char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, +# char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, # const char *name1, const char *name2, int flags) #} declare 89 { @@ -380,11 +380,11 @@ declare 92 { const char *procName) } declare 93 { - void TclProcDeleteProc(ClientData clientData) + void TclProcDeleteProc(void *clientData) } # Removed in 8.5: #declare 94 { -# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, +# int TclProcInterpProc(void *clientData, Tcl_Interp *interp, # int argc, const char **argv) #} # Replaced by Tcl_FSStat in 8.4: @@ -465,7 +465,7 @@ declare 111 { # Removed in 9.0: #declare 113 { # Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, -# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) +# void *clientData, Tcl_NamespaceDeleteProc *deleteProc) #} # Removed in 9.0: #declare 114 { @@ -571,7 +571,7 @@ declare 138 { #declare 139 { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, # char *sym2, Tcl_PackageInitProc **proc1Ptr, -# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) +# Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr) #} #declare 140 { # int TclLooksLikeInt(const char *bytes, int length) @@ -582,7 +582,7 @@ declare 141 { } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, - CompileHookProc *hookProc, ClientData clientData) + CompileHookProc *hookProc, void *clientData) } declare 143 { int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, @@ -626,11 +626,11 @@ declare 153 { # moved to tclTest.c (static) in 8.3.2/8.4a2 #declare 154 { -# int TclTestChannelCmd(ClientData clientData, +# int TclTestChannelCmd(void *clientData, # Tcl_Interp *interp, int argc, char **argv) #} #declare 155 { -# int TclTestChannelEventCmd(ClientData clientData, +# int TclTestChannelEventCmd(void *clientData, # Tcl_Interp *interp, int argc, char **argv) #} @@ -661,7 +661,7 @@ declare 161 { Tcl_Obj *cmdObjPtr) } declare 162 { - void TclChannelEventScriptInvoker(ClientData clientData, int flags) + void TclChannelEventScriptInvoker(void *clientData, int flags) } # ALERT: The result of 'TclGetInstructionTable' is actually a @@ -968,7 +968,7 @@ declare 237 { # NRE functions for "rogue" extensions to exploit NRE; they will need to # include NRE.h too. declare 238 { - int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, + int TclNRInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 239 { diff --git a/generic/tclInt.h b/generic/tclInt.h index 10ec7e9..196a790 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -249,7 +249,7 @@ typedef struct Namespace { * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - ClientData clientData; /* An arbitrary value associated with this + void *clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the @@ -520,7 +520,7 @@ typedef struct EnsembleConfig { typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -539,7 +539,7 @@ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ @@ -993,7 +993,7 @@ typedef struct Trace { int level; /* Only trace commands at nesting level less * than or equal to this. */ Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ - ClientData clientData; /* Arbitrary value to pass to proc. */ + void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ @@ -1045,7 +1045,7 @@ typedef struct ActiveInterpTrace { typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ - ClientData clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ } AssocData; /* @@ -1123,7 +1123,7 @@ typedef struct CallFrame { * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ - ClientData clientData; /* Pointer to some context that is used by + void *clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by @@ -1307,13 +1307,13 @@ typedef struct ContLineLoc { * by [info frame]. Contains a sub-structure for each extra field. */ -typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData); +typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData); typedef struct { const char *name; /* Name of this field. */ GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ - ClientData clientData; /* Context for above function, or Tcl_Obj* if + void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { @@ -1406,7 +1406,7 @@ typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr, */ typedef int (CompileHookProc)(Tcl_Interp *interp, - struct CompileEnv *compEnvPtr, ClientData clientData); + struct CompileEnv *compEnvPtr, void *clientData); /* * The data structure for a (linked list of) execution stacks. @@ -1569,7 +1569,7 @@ typedef struct { Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ - ClientData clientData; /* Any clientData to give the command. */ + void *clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; @@ -1646,13 +1646,13 @@ typedef struct Command { CompileProc *compileProc; /* Procedure called to compile command. NULL * if no compile proc exists for command. */ Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ - ClientData objClientData; /* Arbitrary value passed to object proc. */ + void *objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ - ClientData clientData; /* Arbitrary value passed to string proc. */ + void *clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ - ClientData deleteData; /* Arbitrary value passed to deleteProc. */ + void *deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in @@ -1808,7 +1808,7 @@ typedef struct Interp { /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ - ClientData interpInfo; /* Information used by tclInterp.c to keep + void *interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ void (*optimizer)(void *envPtr); @@ -2502,7 +2502,7 @@ typedef struct List { */ #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) -typedef ClientData (TclFSGetCwdProc2)(ClientData clientData); +typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); @@ -2667,7 +2667,7 @@ MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr; MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; -MODULE_SCOPE ClientData tclTimeClientData; +MODULE_SCOPE void *tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. @@ -2787,7 +2787,7 @@ typedef struct ForIterData { typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, const char* symbol); struct Tcl_LoadHandle_ { - ClientData clientData; /* Client data is the load handle in the + void *clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS @@ -2879,7 +2879,7 @@ MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs ( const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs( Tcl_Interp *interp, @@ -2905,9 +2905,9 @@ MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, @@ -2949,7 +2949,7 @@ MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs ( Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, @@ -2964,7 +2964,7 @@ MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, ClientData *clientDataPtr, + Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, @@ -2984,16 +2984,16 @@ MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); -MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoExistsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoCoroutineCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); -MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoVarsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitBignumFromLong(mp_int *, long); @@ -3074,7 +3074,7 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, ClientData clientData, + Tcl_ThreadCreateProc *proc, void *clientData, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, @@ -3098,7 +3098,7 @@ MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData); +MODULE_SCOPE ClientData TclpGetNativeCwd(void *clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); @@ -3175,7 +3175,7 @@ MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCount(int ch); -MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); +MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, @@ -3208,60 +3208,60 @@ MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int *---------------------------------------------------------------- */ -MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AfterObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AppendObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ApplyObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_BreakObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #ifndef TCL_NO_DEPRECATED -MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CaseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #endif -MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CatchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CdObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanCreateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPostEventObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPopObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPopObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPushObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE int TclClockOldscanObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CloseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ConcatObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ContinueObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, @@ -3270,229 +3270,229 @@ MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]); -MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_DisassembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* Assemble command function */ -MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AssembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData, +MODULE_SCOPE int TclNRAssembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); MODULE_SCOPE int TclMakeEncodingCommandSafe(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_EofObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ErrorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_EvalObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExecObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExprObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FblockedObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FconfigureObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, +MODULE_SCOPE int Tcl_FcopyObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FileEventObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FlushObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ForObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ForeachObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy, +MODULE_SCOPE int Tcl_FormatObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GetsObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GlobalObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GlobObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_IfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_IncrObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_InterpObjCmd(void *clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_JoinObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LappendObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LassignObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LindexObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LinsertObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LlengthObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ListObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LmapObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LoadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LrangeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LrepeatObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LreplaceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LreverseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsearchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsortObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy, +MODULE_SCOPE int TclNamespaceEnsembleCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_OpenObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PackageObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PidObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PutsObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PwdObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ReadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RegexpObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RegsubObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RenameObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RepresentationCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ReturnObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ScanObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SeekObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SplitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SocketObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SourceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SubstObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SwitchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TellObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TimeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TraceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UnloadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UnsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UpdateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UplevelObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UpvarObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_VariableObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_VwaitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_WhileObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -3818,139 +3818,139 @@ MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, +MODULE_SCOPE int TclInvertOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNotOpCmd(ClientData clientData, +MODULE_SCOPE int TclNotOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAddOpCmd(ClientData clientData, +MODULE_SCOPE int TclAddOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMulOpCmd(ClientData clientData, +MODULE_SCOPE int TclMulOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAndOpCmd(ClientData clientData, +MODULE_SCOPE int TclAndOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclOrOpCmd(ClientData clientData, +MODULE_SCOPE int TclOrOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclXorOpCmd(ClientData clientData, +MODULE_SCOPE int TclXorOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclPowOpCmd(ClientData clientData, +MODULE_SCOPE int TclPowOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, +MODULE_SCOPE int TclLshiftOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, +MODULE_SCOPE int TclRshiftOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclModOpCmd(ClientData clientData, +MODULE_SCOPE int TclModOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclNeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, +MODULE_SCOPE int TclStrneqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInOpCmd(ClientData clientData, +MODULE_SCOPE int TclInOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNiOpCmd(ClientData clientData, +MODULE_SCOPE int TclNiOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, +MODULE_SCOPE int TclMinusOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclDivOpCmd(ClientData clientData, +MODULE_SCOPE int TclDivOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLessOpCmd(ClientData clientData, +MODULE_SCOPE int TclLessOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclLeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, +MODULE_SCOPE int TclGreaterOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclGeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclEqOpCmd(ClientData clientData, +MODULE_SCOPE int TclEqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, +MODULE_SCOPE int TclStreqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, @@ -4818,7 +4818,7 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); typedef struct NRE_callback { Tcl_NRPostProc *procPtr; - ClientData data[4]; + void *data[4]; struct NRE_callback *nextPtr; } NRE_callback; diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index ed50e85..77867b2 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -76,7 +76,7 @@ EXTERN void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ -EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); +EXTERN int TclDumpMemoryInfo(void *clientData, int flags); /* Slot 15 is reserved */ /* 16 */ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); @@ -152,11 +152,11 @@ EXTERN void TclInitCompiledLocals(Tcl_Interp *interp, EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ -EXTERN int TclInvokeObjectCommand(ClientData clientData, +EXTERN int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 54 */ -EXTERN int TclInvokeStringCommand(ClientData clientData, +EXTERN int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ @@ -176,7 +176,7 @@ EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ -EXTERN int TclObjInterpProc(ClientData clientData, +EXTERN int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ @@ -223,7 +223,7 @@ EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, const char *description, const char *procName); /* 93 */ -EXTERN void TclProcDeleteProc(ClientData clientData); +EXTERN void TclProcDeleteProc(void *clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ @@ -318,7 +318,7 @@ EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp, /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, - ClientData clientData); + void *clientData); /* 143 */ EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); @@ -359,7 +359,7 @@ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, EXTERN int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ -EXTERN void TclChannelEventScriptInvoker(ClientData clientData, +EXTERN void TclChannelEventScriptInvoker(void *clientData, int flags); /* 163 */ EXTERN const void * TclGetInstructionTable(void); @@ -516,9 +516,8 @@ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ -EXTERN int TclNRInterpProc(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +EXTERN int TclNRInterpProc(void *clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, @@ -600,7 +599,7 @@ typedef struct TclIntStubs { void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */ void (*reserved13)(void); - int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */ + int (*tclDumpMemoryInfo) (void *clientData, int flags); /* 14 */ void (*reserved15)(void); void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */ void (*reserved17)(void); @@ -639,8 +638,8 @@ typedef struct TclIntStubs { void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); - int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */ - int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ + int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */ + int (*tclInvokeStringCommand) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); void (*reserved57)(void); @@ -649,7 +648,7 @@ typedef struct TclIntStubs { int (*tclNeedSpace) (const char *start, const char *end); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */ int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */ - int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ + int (*tclObjInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */ void (*reserved65)(void); void (*reserved66)(void); @@ -679,7 +678,7 @@ typedef struct TclIntStubs { void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */ - void (*tclProcDeleteProc) (ClientData clientData); /* 93 */ + void (*tclProcDeleteProc) (void *clientData); /* 93 */ void (*reserved94)(void); void (*reserved95)(void); int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */ @@ -728,7 +727,7 @@ typedef struct TclIntStubs { void (*reserved139)(void); void (*reserved140)(void); CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ - int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ + int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ @@ -748,7 +747,7 @@ typedef struct TclIntStubs { void (*reserved159)(void); void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ - void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ + void (*tclChannelEventScriptInvoker) (void *clientData, int flags); /* 162 */ const void * (*tclGetInstructionTable) (void); /* 163 */ void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ @@ -824,7 +823,7 @@ typedef struct TclIntStubs { void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ void (*reserved236)(void); int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ - int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ + int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */ diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 265ba88..5095401 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -51,7 +51,7 @@ declare 8 { } declare 9 { int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr) + void **clientDataPtr) } declare 10 { Tcl_Obj *Tcl_MethodName(Tcl_Method method) @@ -59,12 +59,12 @@ declare 10 { declare 11 { Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, - ClientData clientData) + void *clientData) } declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, - ClientData clientData) + void *clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, @@ -87,20 +87,20 @@ declare 18 { int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { - ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, + void *Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) } declare 20 { void Tcl_ClassSetMetadata(Tcl_Class clazz, - const Tcl_ObjectMetadataType *typePtr, ClientData metadata) + const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 21 { - ClientData Tcl_ObjectGetMetadata(Tcl_Object object, + void *Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) } declare 22 { void Tcl_ObjectSetMetadata(Tcl_Object object, - const Tcl_ObjectMetadataType *typePtr, ClientData metadata) + const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, @@ -141,14 +141,14 @@ declare 0 { declare 1 { Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - const Tcl_MethodType *typePtr, ClientData clientData, + const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr) } declare 2 { Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr) + void *clientData, Proc **procPtrPtr) } declare 3 { Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, @@ -179,13 +179,13 @@ declare 9 { Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, + void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 10 { Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, + ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } diff --git a/generic/tclOO.h b/generic/tclOO.h index d051e79..0cad9fd 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -60,12 +60,12 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; * and to allow the attachment of arbitrary data to objects and classes. */ -typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); -typedef void (Tcl_MethodDeleteProc)(ClientData clientData); -typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData, - ClientData *newClientData); -typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData); +typedef void (Tcl_MethodDeleteProc)(void *clientData); +typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, + void **newClientData); +typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData); typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 9fd62ec..f4d9b34 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -53,19 +53,19 @@ TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr); + void **clientDataPtr); /* 10 */ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, - ClientData clientData); + void *clientData); /* 12 */ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, - ClientData clientData); + void *clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, @@ -84,19 +84,19 @@ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata); + void *metadata); /* 21 */ -TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +TCLAPI void * Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata); + void *metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -134,20 +134,20 @@ typedef struct TclOOStubs { Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ - int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */ + int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ - Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */ - Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ + Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ + Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ - ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ - void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */ - ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ - void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */ + void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ + void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ + void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ + void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index bfae623..732ca9e 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -47,7 +47,7 @@ typedef struct Method { * special flag record which is just used for * the setting of the flags field. */ int refCount; - ClientData clientData; /* Type-specific data. */ + void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; /* The object that declares this method, or @@ -65,12 +65,12 @@ typedef struct Method { * tuned in their behaviour. */ -typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished); -typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result); -typedef void (TclOO_PmCDDeleteProc)(ClientData clientData); -typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData); +typedef void (TclOO_PmCDDeleteProc)(void *clientData); +typedef void *(TclOO_PmCDCloneProc)(void *clientData); /* * Procedure-like methods have the following extra information. @@ -84,7 +84,7 @@ typedef struct ProcedureMethod { * body bytecodes. */ int flags; /* Flags to control features. */ int refCount; - ClientData clientData; + void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; ProcErrorProc *errProc; /* Replacement error handler. */ @@ -395,58 +395,58 @@ typedef struct { */ MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); -MODULE_SCOPE int TclOODefineObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOObjDefObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineConstructorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineDestructorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineExportObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineExportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineForwardObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineForwardObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineRenameMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineRenameMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineUnexportObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData, +MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData, +MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextToObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextToObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); @@ -454,31 +454,31 @@ MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, * Method implementations (in tclOOBasic.c). */ -MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData, +MODULE_SCOPE int TclOO_Class_Constructor(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_Create(ClientData clientData, +MODULE_SCOPE int TclOO_Class_Create(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_CreateNs(ClientData clientData, +MODULE_SCOPE int TclOO_Class_CreateNs(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_New(ClientData clientData, +MODULE_SCOPE int TclOO_Class_New(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Destroy(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Destroy(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Eval(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Eval(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_LinkVar(ClientData clientData, +MODULE_SCOPE int TclOO_Object_LinkVar(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Unknown(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Unknown(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData, +MODULE_SCOPE int TclOO_Object_VarName(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); @@ -519,7 +519,7 @@ MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); -MODULE_SCOPE int TclOOInvokeContext(ClientData clientData, +MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 74a8d81..6a5cfd3 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -22,14 +22,14 @@ TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr); + void *clientData, Proc **procPtrPtr); /* 2 */ TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr); + void *clientData, Proc **procPtrPtr); /* 3 */ TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, @@ -59,19 +59,19 @@ TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, - Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - int flags, void **internalTokenPtr); + ProcErrorProc *errProc, void *clientData, + Tcl_Obj *nameObj, Tcl_Obj *argsObj, + Tcl_Obj *bodyObj, int flags, + void **internalTokenPtr); /* 10 */ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, - Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - int flags, void **internalTokenPtr); + ProcErrorProc *errProc, void *clientData, + Tcl_Obj *nameObj, Tcl_Obj *argsObj, + Tcl_Obj *bodyObj, int flags, + void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, @@ -97,16 +97,16 @@ typedef struct TclOOIntStubs { void *hooks; Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ - Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */ - Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ + Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */ + Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ - Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ - Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ + Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ + Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */ void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ diff --git a/win/tclWinInt.h b/win/tclWinInt.h index cf85bbb..65eb400 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -96,7 +96,7 @@ typedef struct TclPipeThreadInfo { * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - ClientData clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; @@ -123,7 +123,7 @@ typedef struct TclPipeThreadInfo { MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, - ClientData clientData, HANDLE wakeEvent); + void *clientData, HANDLE wakeEvent); MODULE_SCOPE int TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr); static inline void -- cgit v0.12 From 69384ff89c0dd2eac33ca84ef731449df0622697 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Dec 2017 22:49:15 +0000 Subject: Fix compilation using -DUSE_TCLALLOC=1 --- generic/tclAlloc.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index c3966c4..74448b4 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -249,9 +249,9 @@ TclFinalizeAllocSubsystem(void) *---------------------------------------------------------------------- */ -char * +void * TclpAlloc( - unsigned int numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { register union overhead *overPtr; register size_t bucket; @@ -446,7 +446,7 @@ MoreCore( void TclpFree( - char *oldPtr) /* Pointer to memory to free. */ + void *oldPtr) /* Pointer to memory to free. */ { register size_t size; register union overhead *overPtr; @@ -509,10 +509,10 @@ TclpFree( *---------------------------------------------------------------------- */ -char * +void * TclpRealloc( - char *oldPtr, /* Pointer to alloced block. */ - unsigned int numBytes) /* New size of memory. */ + void *oldPtr, /* Pointer to alloced block. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; -- cgit v0.12 From 1402f26fc8cd143a3281e3c3f4436d12246f5ea1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Dec 2017 23:23:22 +0000 Subject: New Tcl_GetIndexFromObjStruct signature using size_t --- generic/tcl.decls | 2 +- generic/tclDecls.h | 4 ++-- generic/tclIndexObj.c | 12 ++++++------ generic/tclTestObj.c | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index b453b47..f82fb8d 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1101,7 +1101,7 @@ declare 303 { } declare 304 { int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, - const void *tablePtr, int offset, const char *msg, int flags, + const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr) } declare 305 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ffb8d3f..da7e998 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -897,7 +897,7 @@ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, - int offset, const char *msg, int flags, + size_t offset, const char *msg, int flags, int *indexPtr); /* 305 */ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, @@ -2137,7 +2137,7 @@ typedef struct TclStubs { Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ - int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ + int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */ void * (*tcl_InitNotifier) (void); /* 307 */ diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index eeed0e5..a1ddbfa 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -61,8 +61,8 @@ static const Tcl_ObjType indexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - int offset; /* Offset between table entries */ - int index; /* Selected index into table. */ + size_t offset; /* Offset between table entries */ + size_t index; /* Selected index into table. */ } IndexRep; /* @@ -129,7 +129,7 @@ Tcl_GetIndexFromObj( * on odd platforms like a Cray PVP... */ - if (indexRep->tablePtr == (void *) tablePtr + if (indexRep->tablePtr == tablePtr && indexRep->offset == sizeof(char *)) { *indexPtr = indexRep->index; return TCL_OK; @@ -254,7 +254,7 @@ Tcl_GetIndexFromObjStruct( * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ - int offset, /* The number of bytes between entries */ + size_t offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ @@ -268,8 +268,8 @@ Tcl_GetIndexFromObjStruct( IndexRep *indexRep; /* Protect against invalid values, like -1 or 0. */ - if (offset < (int)sizeof(char *)) { - offset = (int)sizeof(char *); + if (offset+1 <= sizeof(char *)) { + offset = sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 1ec89fb..36a6d81 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -576,8 +576,8 @@ TestindexobjCmd( */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ - int offset; /* Offset between table entries. */ - int index; /* Selected index into table. */ + size_t offset; /* Offset between table entries. */ + size_t index; /* Selected index into table. */ }; struct IndexRep *indexRep; -- cgit v0.12 From 0f6d3fd95989e7b5c22a40bbdc90631e3ae10bc1 Mon Sep 17 00:00:00 2001 From: pspjuth Date: Thu, 28 Dec 2017 23:54:57 +0000 Subject: Optimise lrange for unshared object. --- generic/tclExecute.c | 13 +++++++ tests/lrange.test | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 115 insertions(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f2cda0c..0f501b9 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5140,12 +5140,25 @@ TEBCresume( if (toIdx >= objc) { toIdx = objc-1; } + + /* + * If we are just removing the beginning or the end from an + * unshared object, Tcl_ListObjReplace is very efficient, and also + * guarantees a pure list. + */ + if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) { Tcl_ListObjReplace(interp, valuePtr, toIdx + 1, LIST_MAX, 0, NULL); TRACE_APPEND(("%.30s\n", O2S(valuePtr))); NEXT_INST_F(9, 0, 0); } + if (toIdx == objc-1 && !Tcl_IsShared(valuePtr)) { + Tcl_ListObjReplace(interp, valuePtr, + 0, fromIdx, 0, NULL); + TRACE_APPEND(("%.30s\n", O2S(valuePtr))); + NEXT_INST_F(9, 0, 0); + } objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx); } else { TclNewObj(objResultPtr); diff --git a/tests/lrange.test b/tests/lrange.test index 02b9c65..0b1a7ca 100644 --- a/tests/lrange.test +++ b/tests/lrange.test @@ -90,6 +90,108 @@ test lrange-3.1 {Bug 3588366: end-offsets before start} { lrange $l 0 end-5 }} {1 2 3 4 5} } {} + +test lrange-4.1 {lrange pure promise} -body { + set ll1 [list $tcl_version 2 3 4] + # Shared + set ll2 $ll1 + # With string rep + string length $ll1 + set rep1 [tcl::unsupported::representation $ll1] + # Get new pure object + set x [lrange $ll1 0 end] + set rep2 [tcl::unsupported::representation $x] + regexp {object pointer at (\S+)} $rep1 -> obj1 + regexp {object pointer at (\S+)} $rep2 -> obj2 + list $rep1 $rep2 [string equal $obj1 $obj2] + # Check for a new clean object +} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0} + +test lrange-4.2 {lrange pure promise} -body { + set ll1 [list $tcl_version 2 3 4] + # Shared + set ll2 $ll1 + # With string rep + string length $ll1 + set rep1 [tcl::unsupported::representation $ll1] + # Get new pure object, not compiled + set x [[string cat l range] $ll1 0 end] + set rep2 [tcl::unsupported::representation $x] + regexp {object pointer at (\S+)} $rep1 -> obj1 + regexp {object pointer at (\S+)} $rep2 -> obj2 + list $rep1 $rep2 [string equal $obj1 $obj2] + # Check for a new clean object +} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0} + +test lrange-4.3 {lrange pure promise} -body { + set ll1 [list $tcl_version 2 3 4] + # With string rep + string length $ll1 + set rep1 [tcl::unsupported::representation $ll1] + # Get pure object, unshared + set ll2 [lrange $ll1[set ll1 {}] 0 end] + set rep2 [tcl::unsupported::representation $ll2] + regexp {object pointer at (\S+)} $rep1 -> obj1 + regexp {object pointer at (\S+)} $rep2 -> obj2 + list $rep1 $rep2 [string equal $obj1 $obj2] + # Internal optimisations should keep the same object +} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1} + +test lrange-4.4 {lrange pure promise} -body { + set ll1 [list $tcl_version 2 3 4] + # With string rep + string length $ll1 + set rep1 [tcl::unsupported::representation $ll1] + # Get pure object, unshared, not compiled + set ll2 [[string cat l range] $ll1[set ll1 {}] 0 end] + set rep2 [tcl::unsupported::representation $ll2] + regexp {object pointer at (\S+)} $rep1 -> obj1 + regexp {object pointer at (\S+)} $rep2 -> obj2 + list $rep1 $rep2 [string equal $obj1 $obj2] + # Internal optimisations should keep the same object +} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1} + +# Testing for compiled vs non-compiled behaviour, and shared vs non-shared. +# Far too many variations to check with spelt-out tests. +# Note that this *just* checks whether the different versions are the same +# not whether any of them is correct. +apply {{} { + set lss {{} {a} {a b c} {a b c d}} + set idxs {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2} + set lrange lrange + + foreach ls $lss { + foreach a $idxs { + foreach b $idxs { + # Shared, uncompiled + set ls2 $ls + set expected [list [catch {$lrange $ls $a $b} m] $m] + # Shared, compiled + set tester [list lrange $ls $a $b] + set script [list catch $tester m] + set script "list \[$script\] \$m" + test lrange-5.[incr n].1 {lrange shared compiled} \ + [list apply [list {} $script]] $expected + # Unshared, uncompiled + set tester [string map [list %l [list $ls] %a $a %b $b] { + [string cat l range] [lrange %l 0 end] %a %b + }] + set script [list catch $tester m] + set script "list \[$script\] \$m" + test lrange-5.$n.2 {lrange unshared uncompiled} \ + [list apply [list {} $script]] $expected + # Unshared, compiled + set tester [string map [list %l [list $ls] %a $a %b $b] { + lrange [lrange %l 0 end] %a %b + }] + set script [list catch $tester m] + set script "list \[$script\] \$m" + test lrange-5.$n.3 {lrange unshared compiled} \ + [list apply [list {} $script]] $expected + } + } + } +}} # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 6631e46bd3d3c18c60f319c4879ce8682f954229 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Dec 2017 16:49:47 +0000 Subject: Remove handling of http 1.0 package files from Makefiles. --- unix/Makefile.in | 9 ++------- win/Makefile.in | 7 +------ win/makefile.vc | 3 --- 3 files changed, 3 insertions(+), 16 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index f3b9782..244ad29 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -829,7 +829,7 @@ install-libraries: libraries else true; \ fi; \ done; - @for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ + @for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -843,11 +843,6 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/"; - @for i in $(TOP_DIR)/library/http1.0/*.tcl ; \ - do \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ - done; @echo "Installing package http 2.8.12 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.12.tm; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @@ -2010,7 +2005,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M @mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library - for i in http1.0 http opt msgcat reg dde tcltest platform; \ + for i in http opt msgcat reg dde tcltest platform; \ do \ mkdir $(DISTDIR)/library/$$i ;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ diff --git a/win/Makefile.in b/win/Makefile.in index a3275ba..5be7492 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -630,7 +630,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ + @for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -652,11 +652,6 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing library http1.0 directory"; - @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ - do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ - done; @echo "Installing package http 2.8.12 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.12.tm; @echo "Installing library opt0.4 directory"; diff --git a/win/makefile.vc b/win/makefile.vc index de80452..64717af 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -860,9 +860,6 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @$(CPY) "$(WINDIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WINDIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" - @echo Installing library http1.0 directory - @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\http1.0\" @echo Installing library opt0.4 directory @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" -- cgit v0.12 From a922e9fd15daadaa80f131c7cb9884423e6873a3 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Dec 2017 16:54:50 +0000 Subject: Remove http 1.0 files from fossil management. --- library/http1.0/http.tcl | 377 ------------------------------------------- library/http1.0/pkgIndex.tcl | 11 -- 2 files changed, 388 deletions(-) delete mode 100644 library/http1.0/http.tcl delete mode 100644 library/http1.0/pkgIndex.tcl diff --git a/library/http1.0/http.tcl b/library/http1.0/http.tcl deleted file mode 100644 index 8329de4..0000000 --- a/library/http1.0/http.tcl +++ /dev/null @@ -1,377 +0,0 @@ -# http.tcl -# Client-side HTTP for GET, POST, and HEAD commands. -# These routines can be used in untrusted code that uses the Safesock -# security policy. -# These procedures use a callback interface to avoid using vwait, -# which is not defined in the safe base. -# -# See the http.n man page for documentation - -package provide http 1.0 - -array set http { - -accept */* - -proxyhost {} - -proxyport {} - -useragent {Tcl http client package 1.0} - -proxyfilter httpProxyRequired -} -proc http_config {args} { - global http - set options [lsort [array names http -*]] - set usage [join $options ", "] - if {[llength $args] == 0} { - set result {} - foreach name $options { - lappend result $name $http($name) - } - return $result - } - regsub -all -- - $options {} options - set pat ^-([join $options |])$ - if {[llength $args] == 1} { - set flag [lindex $args 0] - if {[regexp -- $pat $flag]} { - return $http($flag) - } else { - return -code error "Unknown option $flag, must be: $usage" - } - } else { - foreach {flag value} $args { - if {[regexp -- $pat $flag]} { - set http($flag) $value - } else { - return -code error "Unknown option $flag, must be: $usage" - } - } - } -} - - proc httpFinish { token {errormsg ""} } { - upvar #0 $token state - global errorInfo errorCode - if {[string length $errormsg] != 0} { - set state(error) [list $errormsg $errorInfo $errorCode] - set state(status) error - } - catch {close $state(sock)} - catch {after cancel $state(after)} - if {[info exists state(-command)]} { - if {[catch {eval $state(-command) {$token}} err]} { - if {[string length $errormsg] == 0} { - set state(error) [list $err $errorInfo $errorCode] - set state(status) error - } - } - unset state(-command) - } -} -proc http_reset { token {why reset} } { - upvar #0 $token state - set state(status) $why - catch {fileevent $state(sock) readable {}} - httpFinish $token - if {[info exists state(error)]} { - set errorlist $state(error) - unset state(error) - eval error $errorlist - } -} -proc http_get { url args } { - global http - if {![info exists http(uid)]} { - set http(uid) 0 - } - set token http#[incr http(uid)] - upvar #0 $token state - http_reset $token - array set state { - -blocksize 8192 - -validate 0 - -headers {} - -timeout 0 - state header - meta {} - currentsize 0 - totalsize 0 - type text/html - body {} - status "" - } - set options {-blocksize -channel -command -handler -headers \ - -progress -query -validate -timeout} - set usage [join $options ", "] - regsub -all -- - $options {} options - set pat ^-([join $options |])$ - foreach {flag value} $args { - if {[regexp $pat $flag]} { - # Validate numbers - if {[info exists state($flag)] && \ - [regexp {^[0-9]+$} $state($flag)] && \ - ![regexp {^[0-9]+$} $value]} { - return -code error "Bad value for $flag ($value), must be integer" - } - set state($flag) $value - } else { - return -code error "Unknown option $flag, can be: $usage" - } - } - if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \ - x proto host y port srvurl]} { - error "Unsupported URL: $url" - } - if {[string length $port] == 0} { - set port 80 - } - if {[string length $srvurl] == 0} { - set srvurl / - } - if {[string length $proto] == 0} { - set url http://$url - } - set state(url) $url - if {![catch {$http(-proxyfilter) $host} proxy]} { - set phost [lindex $proxy 0] - set pport [lindex $proxy 1] - } - if {$state(-timeout) > 0} { - set state(after) [after $state(-timeout) [list http_reset $token timeout]] - } - if {[info exists phost] && [string length $phost]} { - set srvurl $url - set s [socket $phost $pport] - } else { - set s [socket $host $port] - } - set state(sock) $s - - # Send data in cr-lf format, but accept any line terminators - - fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize) - - # The following is disallowed in safe interpreters, but the socket - # is already in non-blocking mode in that case. - - catch {fconfigure $s -blocking off} - set len 0 - set how GET - if {[info exists state(-query)]} { - set len [string length $state(-query)] - if {$len > 0} { - set how POST - } - } elseif {$state(-validate)} { - set how HEAD - } - puts $s "$how $srvurl HTTP/1.0" - puts $s "Accept: $http(-accept)" - puts $s "Host: $host" - puts $s "User-Agent: $http(-useragent)" - foreach {key value} $state(-headers) { - regsub -all \[\n\r\] $value {} value - set key [string trim $key] - if {[string length $key]} { - puts $s "$key: $value" - } - } - if {$len > 0} { - puts $s "Content-Length: $len" - puts $s "Content-Type: application/x-www-form-urlencoded" - puts $s "" - fconfigure $s -translation {auto binary} - puts -nonewline $s $state(-query) - } else { - puts $s "" - } - flush $s - fileevent $s readable [list httpEvent $token] - if {! [info exists state(-command)]} { - http_wait $token - } - return $token -} -proc http_data {token} { - upvar #0 $token state - return $state(body) -} -proc http_status {token} { - upvar #0 $token state - return $state(status) -} -proc http_code {token} { - upvar #0 $token state - return $state(http) -} -proc http_size {token} { - upvar #0 $token state - return $state(currentsize) -} - - proc httpEvent {token} { - upvar #0 $token state - set s $state(sock) - - if {[eof $s]} { - httpEof $token - return - } - if {$state(state) == "header"} { - set n [gets $s line] - if {$n == 0} { - set state(state) body - if {![regexp -nocase ^text $state(type)]} { - # Turn off conversions for non-text data - fconfigure $s -translation binary - if {[info exists state(-channel)]} { - fconfigure $state(-channel) -translation binary - } - } - if {[info exists state(-channel)] && - ![info exists state(-handler)]} { - # Initiate a sequence of background fcopies - fileevent $s readable {} - httpCopyStart $s $token - } - } elseif {$n > 0} { - if {[regexp -nocase {^content-type:(.+)$} $line x type]} { - set state(type) [string trim $type] - } - if {[regexp -nocase {^content-length:(.+)$} $line x length]} { - set state(totalsize) [string trim $length] - } - if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} { - lappend state(meta) $key $value - } elseif {[regexp ^HTTP $line]} { - set state(http) $line - } - } - } else { - if {[catch { - if {[info exists state(-handler)]} { - set n [eval $state(-handler) {$s $token}] - } else { - set block [read $s $state(-blocksize)] - set n [string length $block] - if {$n >= 0} { - append state(body) $block - } - } - if {$n >= 0} { - incr state(currentsize) $n - } - } err]} { - httpFinish $token $err - } else { - if {[info exists state(-progress)]} { - eval $state(-progress) {$token $state(totalsize) $state(currentsize)} - } - } - } -} - proc httpCopyStart {s token} { - upvar #0 $token state - if {[catch { - fcopy $s $state(-channel) -size $state(-blocksize) -command \ - [list httpCopyDone $token] - } err]} { - httpFinish $token $err - } -} - proc httpCopyDone {token count {error {}}} { - upvar #0 $token state - set s $state(sock) - incr state(currentsize) $count - if {[info exists state(-progress)]} { - eval $state(-progress) {$token $state(totalsize) $state(currentsize)} - } - if {([string length $error] != 0)} { - httpFinish $token $error - } elseif {[eof $s]} { - httpEof $token - } else { - httpCopyStart $s $token - } -} - proc httpEof {token} { - upvar #0 $token state - if {$state(state) == "header"} { - # Premature eof - set state(status) eof - } else { - set state(status) ok - } - set state(state) eof - httpFinish $token -} -proc http_wait {token} { - upvar #0 $token state - if {![info exists state(status)] || [string length $state(status)] == 0} { - vwait $token\(status) - } - if {[info exists state(error)]} { - set errorlist $state(error) - unset state(error) - eval error $errorlist - } - return $state(status) -} - -# Call http_formatQuery with an even number of arguments, where the first is -# a name, the second is a value, the third is another name, and so on. - -proc http_formatQuery {args} { - set result "" - set sep "" - foreach i $args { - append result $sep [httpMapReply $i] - if {$sep != "="} { - set sep = - } else { - set sep & - } - } - return $result -} - -# do x-www-urlencoded character mapping -# The spec says: "non-alphanumeric characters are replaced by '%HH'" -# 1 leave alphanumerics characters alone -# 2 Convert every other character to an array lookup -# 3 Escape constructs that are "special" to the tcl parser -# 4 "subst" the result, doing all the array substitutions - - proc httpMapReply {string} { - global httpFormMap - set alphanumeric a-zA-Z0-9 - if {![info exists httpFormMap]} { - - for {set i 1} {$i <= 256} {incr i} { - set c [format %c $i] - if {![string match \[$alphanumeric\] $c]} { - set httpFormMap($c) %[format %.2x $i] - } - } - # These are handled specially - array set httpFormMap { - " " + \n %0d%0a - } - } - regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string - regsub -all \n $string {\\n} string - regsub -all \t $string {\\t} string - regsub -all {[][{})\\]\)} $string {\\&} string - return [subst $string] -} - -# Default proxy filter. - proc httpProxyRequired {host} { - global http - if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} { - if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} { - set http(-proxyport) 8080 - } - return [list $http(-proxyhost) $http(-proxyport)] - } else { - return {} - } -} diff --git a/library/http1.0/pkgIndex.tcl b/library/http1.0/pkgIndex.tcl deleted file mode 100644 index ab6170f..0000000 --- a/library/http1.0/pkgIndex.tcl +++ /dev/null @@ -1,11 +0,0 @@ -# Tcl package index file, version 1.0 -# This file is generated by the "pkg_mkIndex" command -# and sourced either when an application starts up or -# by a "package unknown" script. It invokes the -# "package ifneeded" command to set up package-related -# information so that packages will be loaded automatically -# in response to "package require" commands. When this -# script is sourced, the variable $dir must contain the -# full path name of this file's directory. - -package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}] -- cgit v0.12 From b0898beca68aa150062cb6eacc8daee6e6490f55 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Dec 2017 17:38:10 +0000 Subject: Remove http 1.0 tests. --- tests/httpold.test | 300 ----------------------------------------------------- 1 file changed, 300 deletions(-) delete mode 100644 tests/httpold.test diff --git a/tests/httpold.test b/tests/httpold.test deleted file mode 100644 index dda0189..0000000 --- a/tests/httpold.test +++ /dev/null @@ -1,300 +0,0 @@ -# -*- tcl -*- -# Commands covered: http_config, http_get, http_wait, http_reset -# -# This file contains a collection of tests for the http script library. -# Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} - -if {[catch {package require http 1.0}]} { - if {[info exists httpold]} { - catch {puts "Cannot load http 1.0 package"} - ::tcltest::cleanupTests - return - } else { - catch {puts "Running http 1.0 tests in slave interp"} - set interp [interp create httpold] - $interp eval [list set httpold "running"] - $interp eval [list set argv $argv] - $interp eval [list source [info script]] - interp delete $interp - ::tcltest::cleanupTests - return - } -} - -if {$::tcl_platform(os) eq "Darwin"} { - # Name resolution often a problem on OSX; not focus of HTTP package anyway - set HOST localhost -} else { - set HOST [info hostname] -} - -set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" -catch {unset data} - -## -## The httpd script implement a stub http server -## -source [file join [file dirname [info script]] httpd] - -if [catch {httpd_init 0} listen] { - puts "Cannot start http server, http test skipped" - catch {unset port} - ::tcltest::cleanupTests - return -} - -test httpold-1.1 {http_config} { - http_config -} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}} - -test httpold-1.2 {http_config} { - http_config -proxyfilter -} httpProxyRequired - -test httpold-1.3 {http_config} { - catch {http_config -junk} -} 1 - -test httpold-1.4 {http_config} { - http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite" - set x [http_config] - http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \ - -useragent "Tcl http client package 1.0" - set x -} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}} - -test httpold-1.5 {http_config} { - catch {http_config -proxyhost {} -junk 8080} -} 1 - -test httpold-2.1 {http_reset} { - catch {http_reset http#1} -} 0 - -test httpold-3.1 {http_get} { - catch {http_get -bogus flag} -} 1 -test httpold-3.2 {http_get} { - catch {http_get http:junk} err - set err -} {Unsupported URL: http:junk} - -set url ${::HOST}:$port -test httpold-3.3 {http_get} { - set token [http_get $url] - http_data $token -} "HTTP/1.0 TEST -

Hello, World!

-

GET /

-" - -set tail /a/b/c -set url ${::HOST}:$port/a/b/c -set binurl ${::HOST}:$port/binary - -test httpold-3.4 {http_get} { - set token [http_get $url] - http_data $token -} "HTTP/1.0 TEST -

Hello, World!

-

GET $tail

-" - -proc selfproxy {host} { - global port - return [list ${::HOST} $port] -} -test httpold-3.5 {http_get} { - http_config -proxyfilter selfproxy - set token [http_get $url] - http_config -proxyfilter httpProxyRequired - http_data $token -} "HTTP/1.0 TEST -

Hello, World!

-

GET http://$url

-" - -test httpold-3.6 {http_get} { - http_config -proxyfilter bogus - set token [http_get $url] - http_config -proxyfilter httpProxyRequired - http_data $token -} "HTTP/1.0 TEST -

Hello, World!

-

GET $tail

-" - -test httpold-3.7 {http_get} { - set token [http_get $url -headers {Pragma no-cache}] - http_data $token -} "HTTP/1.0 TEST -

Hello, World!

-

GET $tail

-" - -test httpold-3.8 {http_get} { - set token [http_get $url -query Name=Value&Foo=Bar] - http_data $token -} "HTTP/1.0 TEST -

Hello, World!

-

POST $tail

-

Query

-
-
Name
Value -
Foo
Bar -
-" - -test httpold-3.9 {http_get} { - set token [http_get $url -validate 1] - http_code $token -} "HTTP/1.0 200 OK" - - -test httpold-4.1 {httpEvent} { - set token [http_get $url] - upvar #0 $token data - array set meta $data(meta) - expr ($data(totalsize) == $meta(Content-Length)) -} 1 - -test httpold-4.2 {httpEvent} { - set token [http_get $url] - upvar #0 $token data - array set meta $data(meta) - string compare $data(type) [string trim $meta(Content-Type)] -} 0 - -test httpold-4.3 {httpEvent} { - set token [http_get $url] - http_code $token -} {HTTP/1.0 200 Data follows} - -test httpold-4.4 {httpEvent} { - set testfile [makeFile "" testfile] - set out [open $testfile w] - set token [http_get $url -channel $out] - close $out - set in [open $testfile] - set x [read $in] - close $in - removeFile $testfile - set x -} "HTTP/1.0 TEST -

Hello, World!

-

GET $tail

-" - -test httpold-4.5 {httpEvent} { - set testfile [makeFile "" testfile] - set out [open $testfile w] - set token [http_get $url -channel $out] - close $out - upvar #0 $token data - removeFile $testfile - expr $data(currentsize) == $data(totalsize) -} 1 - -test httpold-4.6 {httpEvent} { - set testfile [makeFile "" testfile] - set out [open $testfile w] - set token [http_get $binurl -channel $out] - close $out - set in [open $testfile] - fconfigure $in -translation binary - set x [read $in] - close $in - removeFile $testfile - set x -} "$bindata$binurl" - -proc myProgress {token total current} { - global progress httpLog - if {[info exists httpLog] && $httpLog} { - puts "progress $total $current" - } - set progress [list $total $current] -} -if 0 { - # This test hangs on Windows95 because the client never gets EOF - set httpLog 1 - test httpold-4.6 {httpEvent} { - set token [http_get $url -blocksize 50 -progress myProgress] - set progress - } {111 111} -} -test httpold-4.7 {httpEvent} { - set token [http_get $url -progress myProgress] - set progress -} {111 111} -test httpold-4.8 {httpEvent} { - set token [http_get $url] - http_status $token -} {ok} -test httpold-4.9 {httpEvent} { - set token [http_get $url -progress myProgress] - http_code $token -} {HTTP/1.0 200 Data follows} -test httpold-4.10 {httpEvent} { - set token [http_get $url -progress myProgress] - http_size $token -} {111} -test httpold-4.11 {httpEvent} { - set token [http_get $url -timeout 1 -command {#}] - http_reset $token - http_status $token -} {reset} -test httpold-4.12 {httpEvent} { - update - set x {} - after 500 {lappend x ok} - set token [http_get $url -timeout 1 -command {lappend x fail}] - vwait x - list [http_status $token] $x -} {timeout ok} - -test httpold-5.1 {http_formatQuery} { - http_formatQuery name1 value1 name2 "value two" -} {name1=value1&name2=value+two} - -test httpold-5.2 {http_formatQuery} { - http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 -} {name1=%7ebwelch&name2=%a1%a2%a2} - -test httpold-5.3 {http_formatQuery} { - http_formatQuery lines "line1\nline2\nline3" -} {lines=line1%0d%0aline2%0d%0aline3} - -test httpold-6.1 {httpProxyRequired} { - update - http_config -proxyhost ${::HOST} -proxyport $port - set token [http_get $url] - http_wait $token - http_config -proxyhost {} -proxyport {} - upvar #0 $token data - set data(body) -} "HTTP/1.0 TEST -

Hello, World!

-

GET http://$url

-" - -# cleanup -catch {unset url} -catch {unset port} -catch {unset data} -close $listen -::tcltest::cleanupTests -return -- cgit v0.12 From daa36e9a1bc07b908f1f3fdb5e9fe52b699047e5 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 29 Dec 2017 17:47:50 +0000 Subject: Use http 2 instead of http 1 for Safe Base testing. --- tests/safe.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/safe.test b/tests/safe.test index 33ee166..df60de6 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -180,17 +180,17 @@ test safe-6.3 {test safe interpreters knowledge of the world} { # leaking infos, but they still do... # high level general test -test safe-7.1 {tests that everything works at high level} { +test safe-7.1 {tests that everything works at high level} -body { set i [safe::interpCreate] # no error shall occur: # (because the default access_path shall include 1st level sub dirs so # package require in a slave works like in the master) - set v [interp eval $i {package require http 1}] + set v [interp eval $i {package require http 2}] # no error shall occur: - interp eval $i {http_config} + interp eval $i {http::config} safe::interpDelete $i set v -} 1.0 +} -match glob -result 2.* test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) -- cgit v0.12 From 651697f7cd746dded1a031d4217376000a176037 Mon Sep 17 00:00:00 2001 From: pspjuth Date: Fri, 29 Dec 2017 18:58:01 +0000 Subject: Refactored lrange to common function. --- generic/tclCmdIL.c | 44 +--------------------------- generic/tclExecute.c | 40 ++------------------------ generic/tclInt.h | 2 ++ generic/tclListObj.c | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 87 insertions(+), 80 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index b41d312..001b62d 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2543,7 +2543,6 @@ Tcl_LrangeObjCmd( register Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj **elemPtrs; int listLen, first, last, result; if (objc != 4) { @@ -2561,55 +2560,14 @@ Tcl_LrangeObjCmd( if (result != TCL_OK) { return result; } - if (first < 0) { - first = 0; - } result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, &last); if (result != TCL_OK) { return result; } - if (last >= listLen) { - last = listLen - 1; - } - - if (first > last) { - /* - * Returning an empty list is easy. - */ - - return TCL_OK; - } - - result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs); - if (result != TCL_OK) { - return result; - } - - if (Tcl_IsShared(objv[1]) || - ((ListRepPtr(objv[1])->refCount > 1))) { - Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1, - &elemPtrs[first])); - } else { - /* - * In-place is possible. - */ - - if (last < (listLen - 1)) { - Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last, - 0, NULL); - } - - /* - * This one is not conditioned on (first > 0) in order to preserve the - * string-canonizing effect of [lrange 0 end]. - */ - - Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL); - Tcl_SetObjResult(interp, objv[1]); - } + Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 0f501b9..8568642 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5087,11 +5087,11 @@ TEBCresume( TclGetInt4AtPtr(pc+5))); /* - * Get the contents of the list, making sure that it really is a list + * Get the length of the list, making sure that it really is a list * in the process. */ - if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { + if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -5128,41 +5128,7 @@ TEBCresume( toIdx = objc; } - /* - * Check if we are referring to a valid, non-empty list range, and if - * so, build the list of elements in that range. - */ - - if (fromIdx<=toIdx && fromIdx=0) { - if (fromIdx < 0) { - fromIdx = 0; - } - if (toIdx >= objc) { - toIdx = objc-1; - } - - /* - * If we are just removing the beginning or the end from an - * unshared object, Tcl_ListObjReplace is very efficient, and also - * guarantees a pure list. - */ - - if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) { - Tcl_ListObjReplace(interp, valuePtr, - toIdx + 1, LIST_MAX, 0, NULL); - TRACE_APPEND(("%.30s\n", O2S(valuePtr))); - NEXT_INST_F(9, 0, 0); - } - if (toIdx == objc-1 && !Tcl_IsShared(valuePtr)) { - Tcl_ListObjReplace(interp, valuePtr, - 0, fromIdx, 0, NULL); - TRACE_APPEND(("%.30s\n", O2S(valuePtr))); - NEXT_INST_F(9, 0, 0); - } - objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx); - } else { - TclNewObj(objResultPtr); - } + objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx); TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 2ba0493..8322095 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3069,6 +3069,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, int *lines, Tcl_Obj *const *elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); +MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, int fromIdx, + int toIdx); MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 43d90ab..c4dafba 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -423,6 +423,87 @@ TclListObjCopy( /* *---------------------------------------------------------------------- * + * TclListObjRange -- + * + * Makes a slice of a list value. + * *listPtr must be known to be a valid list. + * + * Results: + * Returns a pointer to the sliced list. + * This may be a new object or the same object if not shared. + * + * Side effects: + * The possible conversion of the object referenced by listPtr + * to a list object. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclListObjRange( + Tcl_Obj *listPtr, /* List object to take a range from. */ + int fromIdx, /* Index of first element to include. */ + int toIdx) /* Index of last element to include. */ +{ + Tcl_Obj **elemPtrs; + int listLen, i, newLen; + List *listRepPtr; + + TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs); + + if (fromIdx < 0) { + fromIdx = 0; + } + if (toIdx >= listLen) { + toIdx = listLen-1; + } + if (fromIdx > toIdx) { + return Tcl_NewObj(); + } + + newLen = toIdx - fromIdx + 1; + + if (Tcl_IsShared(listPtr) || + ((ListRepPtr(listPtr)->refCount > 1))) { + return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]); + } + + /* + * In-place is possible. + */ + + /* + * Even if nothing below cause any changes, we still want the + * string-canonizing effect of [lrange 0 end]. + */ + + TclInvalidateStringRep(listPtr); + + /* + * Delete elements that should not be included. + */ + + for (i = 0; i < fromIdx; i++) { + TclDecrRefCount(elemPtrs[i]); + } + for (i = toIdx + 1; i < listLen; i++) { + TclDecrRefCount(elemPtrs[i]); + } + + if (fromIdx > 0) { + memmove(elemPtrs, &elemPtrs[fromIdx], + (size_t) newLen * sizeof(Tcl_Obj*)); + } + + listRepPtr = ListRepPtr(listPtr); + listRepPtr->elemCount = newLen; + + return listPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_ListObjGetElements -- * * This function returns an (objc,objv) array of the elements in a list -- cgit v0.12 From 983b089edb6d9c4f233f21a1792393758dea4f65 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 29 Dec 2017 20:40:29 +0000 Subject: Removing the standalone pkgIndex.tcl. There is enough stuff that needs to be manually edited in the init.tcl script for new releases as it is, there is no sense in having yet another file to edit. Marking which distributed packages are safe to load in a safe interpreter --- library/init.tcl | 25 +++++++++++++++++++++---- library/pkgIndex.tcl | 16 ---------------- 2 files changed, 21 insertions(+), 20 deletions(-) delete mode 100644 library/pkgIndex.tcl diff --git a/library/init.tcl b/library/init.tcl index d4a66e2..e58dcfc 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -6,7 +6,10 @@ # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. -# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# Copyright (c) 2004 by Kevin B. Kenny. +# Copyright (c) 2018 by Sean Woods +# +# All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -795,7 +798,21 @@ proc tcl::CopyDirectory {action src dest} { } return } -if {[file exists [file join $::tcl_library pkgIndex.tcl]]} { - set dir $::tcl_library - source [file join $::tcl_library pkgIndex.tcl] +set isafe [interp issafe] +### +# Package manifest for all Tcl packages included in the /library file system +### +set isafe [interp issafe] +set dir [file dirname [info script]] +foreach {safe package version file} { + 0 http 2.8.12 {http http.tcl} + 0 http 1.0 {http1.0 http.tcl} + 1 msgcat 1.6.1 {msgcat msgcat.tcl} + 1 opt 0.4.7 {opt optparse.tcl} + 0 platform 1.0.14 {platform platform.tcl} + 0 platform::shell 1.1.4 {platform shell.tcl} + 1 tcltest 2.4.1 {tcltest tcltest.tcl} +} { + if {$isafe && !$safe} continue + package ifneeded $package $version [list source [file join $dir {*}$file]] } diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl deleted file mode 100644 index ff8d0f1..0000000 --- a/library/pkgIndex.tcl +++ /dev/null @@ -1,16 +0,0 @@ -### -# Package manifest for all Tcl packages included in the /library file system -### -foreach {package version file} { - http 2.8.12 {http http.tcl} - http 1.0 {http1.0 http.tcl} - msgcat 1.6.1 {msgcat msgcat.tcl} - opt 0.4.7 {opt optparse.tcl} - platform 1.0.14 {platform platform.tcl} - platform::shell 1.1.4 {platform shell.tcl} - tcltest 2.4.1 {tcltest tcltest.tcl} -} { - package ifneeded $package $version [list source [file join $dir {*}$file]] -} -# Opt is the odd man out -package ifneeded opt 0.4.7 [list source [file join $dir opt optparse.tcl]] -- cgit v0.12 From b533731c50bd2d75793771054f53afd96afbfd80 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 29 Dec 2017 21:41:00 +0000 Subject: Modifications to clean up warnings on compile --- generic/tclZipfs.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 45ba8e2..49f3b04 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -155,14 +155,14 @@ typedef struct ZipFile { long length; /* Length of memory mapped file */ unsigned char *tofree; /* Non-NULL if malloc'ed file */ int nfiles; /* Number of files in archive */ - int baseoffs; /* Archive start */ - int baseoffsp; /* Password start */ - int centoffs; /* Archive directory start */ - char pwbuf[264]; /* Password buffer */ + unsigned long baseoffs; /* Archive start */ + long baseoffsp; /* Password start */ + unsigned long centoffs; /* Archive directory start */ + unsigned char pwbuf[264]; /* Password buffer */ #if defined(_WIN32) || defined(_WIN64) HANDLE mh; #endif - int nopen; /* Number of open files on archive */ + unsigned long nopen; /* Number of open files on archive */ struct ZipEntry *entries; /* List of files in archive */ struct ZipEntry *topents; /* List of top-level dirs in archive */ #if HAS_DRIVES @@ -1796,7 +1796,7 @@ wrerr: return TCL_ERROR; } if ((len + pos[0]) & 3) { - char abuf[8]; + unsigned char abuf[8]; /* * Align payload to next 4-byte boundary using a dummy extra @@ -1806,7 +1806,7 @@ wrerr: zip_write_short(abuf, 0xffff); zip_write_short(abuf + 2, align - 4); zip_write_int(abuf + 4, 0x03020100); - if (Tcl_Write(out, abuf, align) != align) { + if (Tcl_Write(out, (const char *)abuf, align) != align) { goto wrerr; } } @@ -4151,7 +4151,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) char *archive; Tcl_FindExecutable(*argv[0]); - archive=Tcl_GetNameOfExecutable(); + archive=(char *)Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); /* ** Look for init.tcl in one of the locations mounted later in this function -- cgit v0.12 From 54590627ee18ff872a23f3a37227324aed8d1fd8 Mon Sep 17 00:00:00 2001 From: pspjuth Date: Tue, 2 Jan 2018 22:03:02 +0000 Subject: Add -stride to lsearch. TIP#351 --- generic/tclCmdIL.c | 187 +++++++++++++++++++++++++++++++++++++++-------------- tests/lsearch.test | 158 +++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 287 insertions(+), 58 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index b41d312..c514f84 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2939,7 +2939,8 @@ Tcl_LsearchObjCmd( { const char *bytes, *patternBytes; int i, match, index, result, listc, length, elemLen, bisect; - int dataType, isIncreasing, lower, upper, offset; + int allocatedIndexVector = 0; + int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset; Tcl_WideInt patWide, objWide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; @@ -2951,7 +2952,7 @@ Tcl_LsearchObjCmd( "-all", "-ascii", "-bisect", "-decreasing", "-dictionary", "-exact", "-glob", "-increasing", "-index", "-inline", "-integer", "-nocase", "-not", - "-real", "-regexp", "-sorted", "-start", + "-real", "-regexp", "-sorted", "-start", "-stride", "-subindices", NULL }; enum options { @@ -2959,7 +2960,7 @@ Tcl_LsearchObjCmd( LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, - LSEARCH_START, LSEARCH_SUBINDICES + LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES }; enum datatypes { ASCII, DICTIONARY, INTEGER, REAL @@ -2979,7 +2980,9 @@ Tcl_LsearchObjCmd( bisect = 0; listPtr = NULL; startPtr = NULL; - offset = 0; + groupSize = 1; + groupOffset = 0; + start = 0; noCase = 0; sortInfo.compareCmdPtr = NULL; sortInfo.isIncreasing = 1; @@ -2997,9 +3000,6 @@ Tcl_LsearchObjCmd( for (i = 1; i < objc-2; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } result = TCL_ERROR; goto done; } @@ -3064,6 +3064,7 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); + startPtr = NULL; } if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -3084,25 +3085,47 @@ Tcl_LsearchObjCmd( startPtr = Tcl_DuplicateObj(objv[i]); } else { startPtr = objv[i]; - Tcl_IncrRefCount(startPtr); } + Tcl_IncrRefCount(startPtr); + break; + case LSEARCH_STRIDE: /* -stride */ + if (i > objc-4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"-stride\" option must be " + "followed by stride length", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + result = TCL_ERROR; + goto done; + } + if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (groupSize < 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "stride length must be at least 2", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADSTRIDE", NULL); + result = TCL_ERROR; + goto done; + } + i++; break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; int j; - if (sortInfo.indexc > 1) { + if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); + allocatedIndexVector = 0; } if (i > objc-4) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } /* @@ -3114,10 +3137,8 @@ Tcl_LsearchObjCmd( i++; if (TclListObjGetElements(interp, objv[i], &sortInfo.indexc, &indices) != TCL_OK) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } - return TCL_ERROR; + result = TCL_ERROR; + goto done; } switch (sortInfo.indexc) { case 0: @@ -3129,6 +3150,8 @@ Tcl_LsearchObjCmd( default: sortInfo.indexv = TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); + allocatedIndexVector = 1; /* Cannot use indexc field, as it + * might be decreased by 1 later. */ } /* @@ -3156,14 +3179,12 @@ Tcl_LsearchObjCmd( */ if (returnSubindices && sortInfo.indexc==0) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } Tcl_SetObjResult(interp, Tcl_NewStringObj( "-subindices cannot be used without -index option", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } if (bisect && (allMatches || negatedMatch)) { @@ -3171,7 +3192,8 @@ Tcl_LsearchObjCmd( "-bisect is not compatible with -all or -not", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } if (mode == REGEXP) { @@ -3197,9 +3219,6 @@ Tcl_LsearchObjCmd( } if (regexp == NULL) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } result = TCL_ERROR; goto done; } @@ -3212,24 +3231,67 @@ Tcl_LsearchObjCmd( result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv); if (result != TCL_OK) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } goto done; } /* + * Check for sanity when grouping elements of the overall list together + * because of the -stride option. [TIP #351] + */ + + if (groupSize > 1) { + if (listc % groupSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "list size must be a multiple of the stride length", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", + NULL); + result = TCL_ERROR; + goto done; + } + if (sortInfo.indexc > 0) { + /* + * Use the first value in the list supplied to -index as the + * offset of the element within each group by which to sort. + */ + + groupOffset = sortInfo.indexv[0]; + if (groupOffset <= SORTIDX_END) { + groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1; + } + if (groupOffset < 0 || groupOffset >= groupSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "when used with \"-stride\", the leading \"-index\"" + " value must be within the group", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BADINDEX", NULL); + result = TCL_ERROR; + goto done; + } + if (sortInfo.indexc == 1) { + sortInfo.indexc = 0; + sortInfo.indexv = NULL; + } else { + sortInfo.indexc--; + + for (i = 0; i < sortInfo.indexc; i++) { + sortInfo.indexv[i] = sortInfo.indexv[i+1]; + } + } + } + } + + /* * Get the user-specified start offset. */ if (startPtr) { - result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset); - Tcl_DecrRefCount(startPtr); + result = TclGetIntForIndexM(interp, startPtr, listc-1, &start); if (result != TCL_OK) { goto done; } - if (offset < 0) { - offset = 0; + if (start < 0) { + start = 0; } /* @@ -3237,16 +3299,21 @@ Tcl_LsearchObjCmd( * "did not match anything at all" result straight away. [Bug 1374778] */ - if (offset > listc-1) { - if (sortInfo.indexc > 1) { - TclStackFree(interp, sortInfo.indexv); - } + if (start > listc-1) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); } - return TCL_OK; + goto done; + } + + /* + * If start points within a group, it points to the start of the group. + */ + + if (groupSize > 1) { + start -= (start % groupSize); } } @@ -3305,18 +3372,23 @@ Tcl_LsearchObjCmd( * sense in doing this when the match sense is inverted. */ - lower = offset - 1; + /* + * With -stride, lower, upper and i are kept as multiples of groupSize. + */ + + lower = start - groupSize; upper = listc; - while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) { + while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) { i = (lower + upper)/2; + i -= i % groupSize; if (sortInfo.indexc != 0) { - itemPtr = SelectObjFromSublist(listv[i], &sortInfo); + itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo); if (sortInfo.resultCode != TCL_OK) { result = sortInfo.resultCode; goto done; } } else { - itemPtr = listv[i]; + itemPtr = listv[i+groupOffset]; } switch ((enum datatypes) dataType) { case ASCII: @@ -3405,10 +3477,10 @@ Tcl_LsearchObjCmd( if (allMatches) { listPtr = Tcl_NewListObj(0, NULL); } - for (i = offset; i < listc; i++) { + for (i = start; i < listc; i += groupSize) { match = 0; if (sortInfo.indexc != 0) { - itemPtr = SelectObjFromSublist(listv[i], &sortInfo); + itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo); if (sortInfo.resultCode != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); @@ -3417,7 +3489,7 @@ Tcl_LsearchObjCmd( goto done; } } else { - itemPtr = listv[i]; + itemPtr = listv[i+groupOffset]; } switch (mode) { @@ -3507,15 +3579,20 @@ Tcl_LsearchObjCmd( */ if (returnSubindices && (sortInfo.indexc != 0)) { - itemPtr = SelectObjFromSublist(listv[i], &sortInfo); + itemPtr = SelectObjFromSublist(listv[i+groupOffset], + &sortInfo); + Tcl_ListObjAppendElement(interp, listPtr, itemPtr); + } else if (groupSize > 1) { + Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, + groupSize, &listv[i]); } else { itemPtr = listv[i]; + Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } - Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } else if (returnSubindices) { int j; - itemPtr = Tcl_NewIntObj(i); + itemPtr = Tcl_NewIntObj(i+groupOffset); for (j=0 ; j 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index])); + } else { + Tcl_SetObjResult(interp, listv[index]); + } } result = TCL_OK; @@ -3563,7 +3647,10 @@ Tcl_LsearchObjCmd( */ done: - if (sortInfo.indexc > 1) { + if (startPtr != NULL) { + Tcl_DecrRefCount(startPtr); + } + if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } return result; diff --git a/tests/lsearch.test b/tests/lsearch.test index b2c1812..4e4b206 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -59,7 +59,7 @@ test lsearch-2.9 {search modes} { } 1 test lsearch-2.10 {search modes} -returnCodes error -body { lsearch -glib {b.x bx xy bcx} b.x -} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} +} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices} test lsearch-2.11 {search modes with -nocase} { lsearch -exact -nocase {a b c A B C} A } 0 @@ -87,10 +87,10 @@ test lsearch-3.2 {lsearch errors} -returnCodes error -body { } -result {wrong # args: should be "lsearch ?-option value ...? list pattern"} test lsearch-3.3 {lsearch errors} -returnCodes error -body { lsearch a b c -} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} +} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices} test lsearch-3.4 {lsearch errors} -returnCodes error -body { lsearch a b c d -} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} +} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices} test lsearch-3.5 {lsearch errors} -returnCodes error -body { lsearch "\{" b } -result {unmatched open brace in list} @@ -435,21 +435,24 @@ test lsearch-18.5 {lsearch -index option, list as index basic functionality} { lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a } {0 1} -test lsearch-19.1 {lsearch -sunindices option} { +test lsearch-19.1 {lsearch -subindices option} { lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } {1 0 0} -test lsearch-19.2 {lsearch -sunindices option} { +test lsearch-19.2 {lsearch -subindices option} { lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } {0 2 0} -test lsearch-19.3 {lsearch -sunindices option} { +test lsearch-19.3 {lsearch -subindices option} { lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* } {0 1 1} -test lsearch-19.4 {lsearch -sunindices option} { +test lsearch-19.4 {lsearch -subindices option} { lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b} } {0 0 1} -test lsearch-19.5 {lsearch -sunindices option} { +test lsearch-19.5 {lsearch -subindices option} { lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a } {{0 0 0} {1 0 0}} +test lsearch-19.6 {lsearch -subindices option} { + lsearch -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a +} {{0 1 0} {1 1 0}} test lsearch-20.1 {lsearch -index option, index larger than sublists} -body { lsearch -index 2 {{a c} {a b} {a a}} a @@ -509,6 +512,145 @@ test lsearch-22.5 {lsearch -bisect, all equal} { test lsearch-22.6 {lsearch -sorted, all equal} { lsearch -sorted -integer {5 5 5 5} 5 } {0} + +test lsearch-23.1 {lsearch -stride option, errors} -body { + lsearch -stride {a b} a +} -returnCodes error -result {"-stride" option must be followed by stride length} +test lsearch-23.2 {lsearch -stride option, errors} -body { + lsearch -stride 0 {a b} a +} -returnCodes error -result {stride length must be at least 2} +test lsearch-23.3 {lsearch -stride option, errors} -body { + lsearch -stride 2 {a b c} a +} -returnCodes error -result {list size must be a multiple of the stride length} +test lsearch-23.4 {lsearch -stride option, errors} -body { + lsearch -stride 5 {a b c} a +} -returnCodes error -result {list size must be a multiple of the stride length} +test lsearch-23.5 {lsearch -stride option, errors} -body { + # Stride equal to length is ok + lsearch -stride 3 {a b c} a +} -result 0 + +test lsearch-24.1 {lsearch -stride option} -body { + lsearch -stride 2 {a b c d e f g h} d +} -result -1 +test lsearch-24.2 {lsearch -stride option} -body { + lsearch -stride 2 {a b c d e f g h} e +} -result 4 +test lsearch-24.3 {lsearch -stride option} -body { + lsearch -stride 3 {a b c d e f g h i} e +} -result -1 +test lsearch-24.4 {lsearch -stride option} -body { + # Result points first in group + lsearch -stride 3 -index 1 {a b c d e f g h i} e +} -result 3 +test lsearch-24.5 {lsearch -stride option} -body { + lsearch -inline -stride 2 {a b c d e f g h} d +} -result {} +test lsearch-24.6 {lsearch -stride option} -body { + # Inline result is a "single element" strided list + lsearch -inline -stride 2 {a b c d e f g h} e +} -result "e f" +test lsearch-24.7 {lsearch -stride option} -body { + lsearch -inline -stride 3 {a b c d e f g h i} e +} -result {} +test lsearch-24.8 {lsearch -stride option} -body { + lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e +} -result "d e f" +test lsearch-24.9 {lsearch -stride option} -body { + lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e +} -result "d e f g e i" +test lsearch-24.10 {lsearch -stride option} -body { + lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a +} -result "a b c a e i" + +# 25* mimics 19* but with -inline added to -subindices +test lsearch-25.1 {lsearch -subindices option} { + lsearch -inline -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a +} {a} +test lsearch-25.2 {lsearch -subindices option} { + lsearch -inline -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a +} {a} +test lsearch-25.3 {lsearch -subindices option} { + lsearch -inline -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* +} {bb} +test lsearch-25.4 {lsearch -subindices option} { + lsearch -inline -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b} +} {cb} +test lsearch-25.5 {lsearch -subindices option} { + lsearch -inline -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a +} {a a} +test lsearch-25.6 {lsearch -subindices option} { + lsearch -inline -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a +} {a a} + +# 26* mimics 19* but with -stride added +test lsearch-26.1 {lsearch -stride + -subindices option} { + lsearch -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a +} {3 0} +test lsearch-26.2 {lsearch -stride + -subindices option} { + lsearch -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a +} {2 0} +test lsearch-26.3 {lsearch -stride + -subindices option} { + lsearch -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b* +} {1 1} +test lsearch-26.4 {lsearch -stride + -subindices option} { + lsearch -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b} +} {0 1} +test lsearch-26.5 {lsearch -stride + -subindices option} { + lsearch -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a +} {{0 0} {3 0}} +test lsearch-26.6 {lsearch -stride + -subindices option} { + lsearch -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a +} {{1 0} {4 0}} + +# 27* mimics 25* but with -stride added +test lsearch-27.1 {lsearch -stride + -subindices option} { + lsearch -inline -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a +} {a} +test lsearch-27.2 {lsearch -stride + -subindices option} { + lsearch -inline -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a +} {a} +test lsearch-27.3 {lsearch -stride + -subindices option} { + lsearch -inline -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b* +} {bb} +test lsearch-27.4 {lsearch -stride + -subindices option} { + lsearch -inline -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b} +} {cb} +test lsearch-27.5 {lsearch -stride + -subindices option} { + lsearch -inline -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a +} {a a} +test lsearch-27.6 {lsearch -stride + -subindices option} { + lsearch -inline -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a +} {a a} + +test lsearch-28.1 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 {5 3 7 8 9 2} 5 +} -result 0 +test lsearch-28.2 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 {5 3 7 8 9 2} 3 +} -result -1 +test lsearch-28.3 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 {5 3 7 8 9 2} 7 +} -result 2 +test lsearch-28.4 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 {5 3 7 8 9 2} 8 +} -result -1 +test lsearch-28.5 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 {5 3 7 8 9 2} 9 +} -result 4 +test lsearch-28.6 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 {5 3 7 8 9 2} 2 +} -result -1 +test lsearch-28.7 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 -index 0 -subindices {5 3 7 8 9 2} 9 +} -result 4 +test lsearch-28.8 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9 +} -result 5 +test lsearch-28.8 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9 +} -result 9 + # cleanup catch {unset res} -- cgit v0.12 From fc03549d341d28a2158b38acb91c75be993d37d0 Mon Sep 17 00:00:00 2001 From: pspjuth Date: Tue, 2 Jan 2018 23:05:25 +0000 Subject: Doc for lsearch -stride --- doc/lsearch.n | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/doc/lsearch.n b/doc/lsearch.n index c2644b8..2f956a5 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -148,6 +148,18 @@ or \fB\-not\fR. These options are used to search lists of lists. They may be used with any other options. .TP +\fB\-stride\0\fIstrideLength\fR +. +If this option is specified, the list is treated as consisting of +groups of \fIstrideLength\fR elements and the groups are searched by +either their first element or, if the \fB\-index\fR option is used, +by the element within each group given by the first index passed to +\fB\-index\fR (which is then ignored by \fB\-index\fR). The resulting +index always points to the first element in a group. +.PP +The list length must be an integer multiple of \fIstrideLength\fR, which +in turn must be at least 2. +.TP \fB\-index\fR\0\fIindexList\fR . This option is designed for use when searching within nested lists. @@ -208,6 +220,13 @@ It is also possible to search inside elements: \fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc* \fI\(-> {a abc} {b bcd}\fR .CE +.PP +The same thing for a flattened list: +.PP +.CS +\fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc* + \fI\(-> {a abc b bcd}\fR +.CE .SH "SEE ALSO" foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), lset(n), lsort(n), lrange(n), lreplace(n), -- cgit v0.12 From 7aa147800f9c40128417d41e350815b482d4a927 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 4 Jan 2018 02:23:37 +0000 Subject: Minimal fixes to stop the [package files] machinery writing to freed mem. This contribution needs a careful review from someone who actually knows how Tcl_Preserve, etc. work. --- generic/tclPkg.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index cdf9a8b..288d5dc 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -948,6 +948,7 @@ Tcl_PackageObjCmd( Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + availPtr->pkgIndex = NULL; } ckfree(availPtr); } @@ -1001,6 +1002,7 @@ Tcl_PackageObjCmd( Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + availPtr->pkgIndex = NULL; } break; } @@ -1012,7 +1014,7 @@ Tcl_PackageObjCmd( } if (availPtr == NULL) { availPtr = ckalloc(sizeof(PkgAvail)); - availPtr->pkgIndex = 0; + availPtr->pkgIndex = NULL; DupBlock(availPtr->version, argv3, (unsigned) length + 1); if (prevPtr == NULL) { @@ -1384,6 +1386,7 @@ TclFreePackageInfo( Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + availPtr->pkgIndex = NULL; } ckfree(availPtr); } -- cgit v0.12 From 6c799d891d69e04b9e0f32ca59719b4b23dc311a Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 4 Jan 2018 02:32:46 +0000 Subject: Minimal fixes to stop the [package files] machinery writing to freed mem. This contribution needs a careful review from someone who actually knows how Tcl_Preserve, etc. work. --- generic/tclPkg.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index cdf9a8b..288d5dc 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -948,6 +948,7 @@ Tcl_PackageObjCmd( Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + availPtr->pkgIndex = NULL; } ckfree(availPtr); } @@ -1001,6 +1002,7 @@ Tcl_PackageObjCmd( Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + availPtr->pkgIndex = NULL; } break; } @@ -1012,7 +1014,7 @@ Tcl_PackageObjCmd( } if (availPtr == NULL) { availPtr = ckalloc(sizeof(PkgAvail)); - availPtr->pkgIndex = 0; + availPtr->pkgIndex = NULL; DupBlock(availPtr->version, argv3, (unsigned) length + 1); if (prevPtr == NULL) { @@ -1384,6 +1386,7 @@ TclFreePackageInfo( Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + availPtr->pkgIndex = NULL; } ckfree(availPtr); } -- cgit v0.12 From 7e4261e22c5e89d5591793bf264bdc35eb154653 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 8 Jan 2018 17:03:07 +0000 Subject: Rearrange a few lines TclRenameCommand to reduce operations. --- generic/tclBasic.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3ed3447..d2e96b8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2626,10 +2626,6 @@ TclRenameCommand( Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL); return TCL_ERROR; } - cmdNsPtr = cmdPtr->nsPtr; - oldFullName = Tcl_NewObj(); - Tcl_IncrRefCount(oldFullName); - Tcl_GetCommandFullName(interp, cmd, oldFullName); /* * If the new command name is NULL or empty, delete the command. Do this @@ -2638,10 +2634,14 @@ TclRenameCommand( if ((newName == NULL) || (*newName == '\0')) { Tcl_DeleteCommandFromToken(interp, cmd); - result = TCL_OK; - goto done; + return TCL_OK; } + cmdNsPtr = cmdPtr->nsPtr; + oldFullName = Tcl_NewObj(); + Tcl_IncrRefCount(oldFullName); + Tcl_GetCommandFullName(interp, cmd, oldFullName); + /* * Make sure that the destination command does not already exist. The * rename operation is like creating a command, so we should automatically -- cgit v0.12 From b40ed15606db487315736beef3d23679445b122e Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 8 Jan 2018 17:36:00 +0000 Subject: Rearrange a few lines TclRenameCommand to reduce operations. --- generic/tclBasic.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ad81bb8..26a4843 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2590,10 +2590,6 @@ TclRenameCommand( Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL); return TCL_ERROR; } - cmdNsPtr = cmdPtr->nsPtr; - oldFullName = Tcl_NewObj(); - Tcl_IncrRefCount(oldFullName); - Tcl_GetCommandFullName(interp, cmd, oldFullName); /* * If the new command name is NULL or empty, delete the command. Do this @@ -2602,10 +2598,14 @@ TclRenameCommand( if ((newName == NULL) || (*newName == '\0')) { Tcl_DeleteCommandFromToken(interp, cmd); - result = TCL_OK; - goto done; + return TCL_OK; } + cmdNsPtr = cmdPtr->nsPtr; + oldFullName = Tcl_NewObj(); + Tcl_IncrRefCount(oldFullName); + Tcl_GetCommandFullName(interp, cmd, oldFullName); + /* * Make sure that the destination command does not already exist. The * rename operation is like creating a command, so we should automatically -- cgit v0.12 From 4a5058fc1bd50653d1de1db7f43ed983b4c8fd72 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 8 Jan 2018 18:21:40 +0000 Subject: Udate Tcl_ObjectDeleted to reflect recent changes. --- generic/tclOO.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 0243c15..7719f50 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1083,9 +1083,7 @@ ObjectNamespaceDeleted( * methods on the object. */ - /* To do: Get dkf to weigh in on wether this should be protected with a - * !IsRoot() condition. - */ + /* To do: Should this be protected with a * !IsRoot() condition? */ TclOORemoveFromInstances(oPtr, oPtr->selfCls); FOREACH(mixinPtr, oPtr->mixins) { @@ -2842,7 +2840,7 @@ int Tcl_ObjectDeleted( Tcl_Object object) { - return Deleted((Object *)object) ? 1 : 0; + return ((Object *)object)->command == NULL; } Tcl_Object -- cgit v0.12 From 6d9902632c27a3a3a46f9ea9506555027acac8ac Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 9 Jan 2018 00:10:22 +0000 Subject: Some refactoring and tidying up of comments. --- generic/tclOO.c | 340 ++++++++++++++++++++++++++++++---------------- generic/tclOOCall.c | 13 +- generic/tclOODefineCmds.c | 95 +++++++++++-- 3 files changed, 318 insertions(+), 130 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 7719f50..39e3fb2 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -71,7 +71,9 @@ static void DeletedHelpersNamespace(ClientData clientData); static Tcl_NRPostProc FinalizeAlloc; static Tcl_NRPostProc FinalizeNext; static Tcl_NRPostProc FinalizeObjectCall; -static void initClassPath(Tcl_Interp * interp, Class *clsPtr); +static inline void InitClassPath(Tcl_Interp * interp, Class *clsPtr); +static void InitClassSystemRoots(Tcl_Interp *interp, + Foundation *fPtr); static int InitFoundation(Tcl_Interp *interp); static void KillFoundation(ClientData clientData, Tcl_Interp *interp); @@ -82,6 +84,8 @@ static void ObjectRenamedTrace(ClientData clientData, const char *newName, int flags); static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); static void DeleteDescendants(Tcl_Interp *interp,Object *oPtr); +static inline void RemoveClass(Class **list, int num, int idx); +static inline void RemoveObject(Object **list, int num, int idx); static inline void SquelchCachedName(Object *oPtr); static int PublicObjectCmd(ClientData clientData, @@ -96,8 +100,6 @@ static int PrivateObjectCmd(ClientData clientData, static int PrivateNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static void RemoveClass(Class ** list, int num, int idx); -static void RemoveObject(Object ** list, int num, int idx); /* * Methods in the oo::object and oo::class classes. First, we define a helper @@ -236,14 +238,50 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) #define RemoveItem(type, lst, i) \ - do { \ - Remove ## type ((lst).list, (lst).num, i); \ - (lst).num--; \ + do { \ + Remove ## type ((lst).list, (lst).num, i); \ + (lst).num--; \ } while (0) /* * ---------------------------------------------------------------------- * + * RemoveClass, RemoveObject -- + * + * Helpers for the RemoveItem macro for deleting a class or object from a + * list. Setting the "empty" location to NULL makes debugging a little + * easier. + * + * ---------------------------------------------------------------------- + */ + +static inline void +RemoveClass( + Class **list, + int num, + int idx) +{ + for (; idx < num - 1; idx++) { + list[idx] = list[idx + 1]; + } + list[idx] = NULL; +} + +static inline void +RemoveObject( + Object **list, + int num, + int idx) +{ + for (; idx < num - 1; idx++) { + list[idx] = list[idx + 1]; + } + list[idx] = NULL; +} + +/* + * ---------------------------------------------------------------------- + * * TclOOInit -- * * Called to initialise the OO system within an interpreter. @@ -321,10 +359,6 @@ InitFoundation( Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); Foundation *fPtr = ckalloc(sizeof(Foundation)); Tcl_Obj *namePtr, *argsPtr, *bodyPtr; - - Class fakeCls; - Object fakeObject; - Tcl_DString buffer; Command *cmdPtr; int i; @@ -387,47 +421,10 @@ InitFoundation( Tcl_CallWhenDeleted(interp, KillFoundation, NULL); /* - * Create the objects at the core of the object system. These need to be - * spliced manually. + * Create the special objects at the core of the object system. */ - /* Stand up a phony class for bootstrapping. */ - fPtr->objectCls = &fakeCls; - /* referenced in AllocClass to increment the refCount. */ - fakeCls.thisPtr = &fakeObject; - - fPtr->objectCls = AllocClass(interp, - AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); - fPtr->classCls = AllocClass(interp, - AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); - - /* Rewire bootstrapped objects. */ - fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; - fPtr->classCls->thisPtr->selfCls = fPtr->classCls; - - AddRef(fPtr->objectCls->thisPtr); - AddRef(fPtr->classCls->thisPtr); - AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr); - AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr); - - /* special initialization for the primordial objects */ - fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; - fPtr->objectCls->flags |= ROOT_OBJECT; - - /* This is why it is unnecessary in this routine to make up for the - * incremented reference count of fPtr->objectCls that was sallwed by - * fakeObject. */ - fPtr->objectCls->superclasses.num = 0; - ckfree(fPtr->objectCls->superclasses.list); - fPtr->objectCls->superclasses.list = NULL; - - fPtr->classCls->thisPtr->flags |= ROOT_CLASS; - fPtr->classCls->flags |= ROOT_CLASS; - - /* Standard initialization for new Objects */ - TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); - TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); - TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); + InitClassSystemRoots(interp, fPtr); /* * Basic method declarations for the core classes. @@ -494,6 +491,88 @@ InitFoundation( } return Tcl_EvalEx(interp, slotScript, -1, 0); } + +/* + * ---------------------------------------------------------------------- + * + * InitClassSystemRoots -- + * + * Creates the objects at the core of the object system. These need to be + * spliced manually. + * + * ---------------------------------------------------------------------- + */ + +static void +InitClassSystemRoots( + Tcl_Interp *interp, + Foundation *fPtr) +{ + Class fakeCls; + Object fakeObject; + + /* + * Stand up a phony class for bootstrapping. + */ + + fPtr->objectCls = &fakeCls; + + /* + * Referenced in AllocClass to increment the refCount. + */ + + fakeCls.thisPtr = &fakeObject; + + fPtr->objectCls = AllocClass(interp, + AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); + fPtr->classCls = AllocClass(interp, + AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); + + /* + * Rewire bootstrapped objects. + */ + + fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; + fPtr->classCls->thisPtr->selfCls = fPtr->classCls; + + AddRef(fPtr->objectCls->thisPtr); + AddRef(fPtr->classCls->thisPtr); + AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr); + AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr); + + /* + * Special initialization for the primordial objects. + */ + + fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; + fPtr->objectCls->flags |= ROOT_OBJECT; + + /* + * This is why it is unnecessary in this routine to make up for the + * incremented reference count of fPtr->objectCls that was sallwed by + * fakeObject. + */ + + fPtr->objectCls->superclasses.num = 0; + ckfree(fPtr->objectCls->superclasses.list); + fPtr->objectCls->superclasses.list = NULL; + + fPtr->classCls->thisPtr->flags |= ROOT_CLASS; + fPtr->classCls->flags |= ROOT_CLASS; + + /* + * Standard initialization for new Objects. + */ + + TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); + TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); + TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); + + /* + * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING. + * Everything else is careful to prohibit looping. + */ +} /* * ---------------------------------------------------------------------- @@ -584,8 +663,8 @@ AllocObject( * if the OO system should pick the object * name itself (equal to the namespace * name). */ - Namespace *nsPtr, /* The namespace to create the object in, - or NULL if *nameStr is NULL */ + Namespace *nsPtr, /* The namespace to create the object in, or + * NULL if *nameStr is NULL */ const char *nsNameStr) /* The name of the namespace to create, or * NULL if the OO system should pick a unique * name itself. If this is non-NULL but names @@ -678,10 +757,10 @@ AllocObject( /* * An object starts life with a refCount of 2 to mark the two stages of * destruction it occur: A call to ObjectRenamedTrace(), and a call to - * ObjectNamespaceDeleted(). + * ObjectNamespaceDeleted(). */ - oPtr->refCount = 2; + oPtr->refCount = 2; oPtr->flags = USE_CLASS_CACHE; /* @@ -716,7 +795,7 @@ AllocObject( tracePtr->refCount = 1; oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr, - PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted); + PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted); return oPtr; } @@ -786,6 +865,7 @@ ObjectRenamedTrace( int flags) /* Why was the object deleted? */ { Object *oPtr = clientData; + /* * If this is a rename and not a delete of the object, we just flush the * cache of the object name. @@ -812,7 +892,7 @@ ObjectRenamedTrace( /* * ---------------------------------------------------------------------- * - * ReleaseClassContents -- + * DeleteDescendants, ReleaseClassContents -- * * Tear down the special class data structure, including deleting all * dependent classes and objects. @@ -834,9 +914,11 @@ DeleteDescendants( */ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) { - /* This condition also covers the case where mixinSubclassPtr == + /* + * This condition also covers the case where mixinSubclassPtr == * clsPtr */ + if (!Deleted(mixinSubclassPtr->thisPtr)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); @@ -844,6 +926,7 @@ DeleteDescendants( i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); TclOODecrRefCount(mixinSubclassPtr->thisPtr); } + /* * Squelch subclasses of this class. */ @@ -862,7 +945,10 @@ DeleteDescendants( if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { - /* This condition also covers the case where instancePtr == oPtr */ + /* + * This condition also covers the case where instancePtr == oPtr + */ + if (!Deleted(instancePtr) && !IsRoot(instancePtr)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } @@ -870,7 +956,6 @@ DeleteDescendants( } } } - static void ReleaseClassContents( @@ -878,7 +963,7 @@ ReleaseClassContents( Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; - int i; + int i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; Foundation *fPtr = oPtr->fPtr; @@ -1008,9 +1093,11 @@ ObjectNamespaceDeleted( int i; if (Deleted(oPtr)) { - /* To do: Can ObjectNamespaceDeleted ever be called twice? If not, - * this guard could be removed. + /* + * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this + * guard could be removed. */ + return; } @@ -1019,6 +1106,7 @@ ObjectNamespaceDeleted( * process of being deleted, nothing else may modify its bookeeping * records. This is the flag that */ + oPtr->flags |= OBJECT_DELETED; /* Let the dominoes fall */ @@ -1032,6 +1120,7 @@ ObjectNamespaceDeleted( * in that case when the destructor is partially deleted before the uses * of it have gone. [Bug 2949397] */ + if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); @@ -1071,6 +1160,7 @@ ObjectNamespaceDeleted( * The namespace must have been deleted directly. Delete the command * as well. */ + Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); } @@ -1083,7 +1173,10 @@ ObjectNamespaceDeleted( * methods on the object. */ - /* To do: Should this be protected with a * !IsRoot() condition? */ + /* + * TODO: Should this be protected with a * !IsRoot() condition? + */ + TclOORemoveFromInstances(oPtr, oPtr->selfCls); FOREACH(mixinPtr, oPtr->mixins) { @@ -1134,22 +1227,19 @@ ObjectNamespaceDeleted( } /* - * Because an object can be a class that is an instance of itself, the - * A class object's class structure should only be cleaned after most of - * the cleanup on the object is done. - */ - - - /* + * Because an object can be a class that is an instance of itself, the + * class object's class structure should only be cleaned after most of the + * cleanup on the object is done. + * * The class of objects needs some special care; if it is deleted (and * we're not killing the whole interpreter) we force the delete of the * class of classes now as well. Due to the incestuous nature of those two * classes, if one goes the other must too and yet the tangle can * sometimes not go away automatically; we force it here. [Bug 2962664] */ - if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr) - && !Tcl_InterpDeleted(interp)) { + if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr) + && !Tcl_InterpDeleted(interp)) { Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } @@ -1170,7 +1260,7 @@ ObjectNamespaceDeleted( /* * ---------------------------------------------------------------------- * - * TclOODecrRef -- + * TclOODecrRefCount -- * * Decrement the refcount of an object and deallocate storage then object * is no longer referenced. Returns 1 if storage was deallocated, and 0 @@ -1178,9 +1268,14 @@ ObjectNamespaceDeleted( * * ---------------------------------------------------------------------- */ -int TclOODecrRefCount(Object *oPtr) { + +int +TclOODecrRefCount( + Object *oPtr) +{ if (oPtr->refCount-- <= 1) { Class *clsPtr = oPtr->classPtr; + if (oPtr->classPtr != NULL) { ckfree(clsPtr->superclasses.list); ckfree(clsPtr->subclasses.list); @@ -1195,18 +1290,6 @@ int TclOODecrRefCount(Object *oPtr) { return 0; } -/* setting the "empty" location to NULL makes debugging a little easier */ -#define REMOVEBODY { \ - for (; idx < num - 1; idx++) { \ - list[idx] = list[idx+1]; \ - } \ - list[idx] = NULL; \ - return; \ -} -void RemoveClass(Class **list, int num, int idx) REMOVEBODY - -void RemoveObject(Object **list, int num, int idx) REMOVEBODY - /* * ---------------------------------------------------------------------- * @@ -1226,6 +1309,7 @@ TclOORemoveFromInstances( { int i, res = 0; Object *instPtr; + if (Deleted(clsPtr->thisPtr)) { return res; } @@ -1291,6 +1375,7 @@ TclOORemoveFromSubclasses( { int i, res = 0; Class *subclsPtr; + if (Deleted(superPtr->thisPtr)) { return res; } @@ -1331,7 +1416,8 @@ TclOOAddToSubclasses( if (superPtr->subclasses.size == ALLOC_CHUNK) { superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size); + superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, + sizeof(Class *) * superPtr->subclasses.size); } } superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr; @@ -1418,6 +1504,25 @@ TclOOAddToMixinSubs( * ---------------------------------------------------------------------- */ +static inline void +InitClassPath( + Tcl_Interp *interp, + Class *clsPtr) +{ + Foundation *fPtr = GetFoundation(interp); + + if (fPtr->helpersNs != NULL) { + Tcl_Namespace *path[2]; + + path[0] = fPtr->helpersNs; + path[1] = fPtr->ooNs; + TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path); + } else { + TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1, + &fPtr->ooNs); + } +} + static Class * AllocClass( Tcl_Interp *interp, /* Interpreter within which to allocate the @@ -1434,7 +1539,8 @@ AllocClass( /* * Configure the namespace path for the class's object. */ - initClassPath(interp, clsPtr); + + InitClassPath(interp, clsPtr); /* * Classes are subclasses of oo::object, i.e. the objects they create are @@ -1460,19 +1566,6 @@ AllocClass( Tcl_InitObjHashTable(&clsPtr->classMethods); return clsPtr; } -static void -initClassPath(Tcl_Interp *interp, Class *clsPtr) { - Foundation *fPtr = GetFoundation(interp); - if (fPtr->helpersNs != NULL) { - Tcl_Namespace *path[2]; - path[0] = fPtr->helpersNs; - path[1] = fPtr->ooNs; - TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path); - } else { - TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1, - &fPtr->ooNs); - } -} /* * ---------------------------------------------------------------------- @@ -1503,7 +1596,9 @@ Tcl_NewObjectInstance( ClientData clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); - if (oPtr == NULL) {return NULL;} + if (oPtr == NULL) { + return NULL; + } /* * Run constructors, except when objc < 0, which is a special flag case @@ -1572,7 +1667,9 @@ TclNRNewObjectInstance( Object *oPtr; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); - if (oPtr == NULL) {return TCL_ERROR;} + if (oPtr == NULL) { + return TCL_ERROR; + } /* * Run constructors, except when objc < 0 (a special flag case used for @@ -1623,29 +1720,33 @@ TclNewObjectInstanceCommon( Foundation *fPtr = GetFoundation(interp); Object *oPtr; const char *simpleName = NULL; - Namespace *nsPtr = NULL, *dummy, - *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); + Namespace *nsPtr = NULL, *dummy; + Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp); int isNew; if (nameStr) { - TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN, - &nsPtr, &dummy, &dummy, &simpleName); + TclGetNamespaceForQualName(interp, nameStr, inNsPtr, + TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName); /* * Disallow creation of an object over an existing command. */ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew); - if (isNew) { - /* Just kidding */ - Tcl_DeleteHashEntry(hPtr); - } else { + if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create object \"%s\": command already exists with" " that name", nameStr)); Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return NULL; } + + /* + * We could make a hash entry! Don't actually want to do that here so + * nuke it immediately because we'll create it properly soon. + */ + + Tcl_DeleteHashEntry(hPtr); } /* @@ -1655,6 +1756,7 @@ TclNewObjectInstanceCommon( oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); oPtr->selfCls = classPtr; TclOOAddToInstances(oPtr, classPtr); + /* * Check to see if we're really creating a class. If so, allocate the * class structure as well. @@ -1690,8 +1792,8 @@ FinalizeAlloc( Tcl_Object *objectPtr = data[3]; /* - * Ensure an error if the object was deleted in the constructor. - * Don't want to lose errors by accident. [Bug 2903011] + * Ensure an error if the object was deleted in the constructor. Don't + * want to lose errors by accident. [Bug 2903011] */ if (result != TCL_ERROR && Deleted(oPtr)) { @@ -1713,13 +1815,21 @@ FinalizeAlloc( (void) TclOOObjectName(interp, oPtr); Tcl_DeleteCommandFromToken(interp, oPtr->command); } - /* This decrements the refcount of oPtr */ + + /* + * This decrements the refcount of oPtr. + */ + TclOODeleteContext(contextPtr); return TCL_ERROR; } Tcl_RestoreInterpState(interp, state); *objectPtr = (Tcl_Object) oPtr; - /* This decrements the refcount of oPtr */ + + /* + * This decrements the refcount of oPtr. + */ + TclOODeleteContext(contextPtr); return TCL_OK; } @@ -1828,7 +1938,7 @@ Tcl_CopyObjectInstance( */ o2Ptr->flags = oPtr->flags & ~( - OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); + OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. */ diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index c71425b..7da9da0 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -110,7 +110,11 @@ TclOODeleteContext( TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); - /* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */ + + /* + * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore + */ + TclOODecrRefCount(oPtr); } } @@ -901,6 +905,7 @@ InitCallChain( * ---------------------------------------------------------------------- * * IsStillValid -- + * * Calculates whether the given call chain can be used for executing a * method for the given object. The condition on a chain from a cached * location being reusable is: @@ -1172,7 +1177,11 @@ TclOOGetCallContext( returnContext: contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; - /* Corresponding TclOODecrRefCount() in TclOODeleteContext */ + + /* + * Corresponding TclOODecrRefCount() in TclOODeleteContext + */ + AddRef(oPtr); contextPtr->callPtr = callPtr; contextPtr->skip = 2; diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 7f3ea18..c08b350 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -123,6 +123,7 @@ static const struct DeclaredSlot slots[] = { * ---------------------------------------------------------------------- * * BumpGlobalEpoch -- + * * Utility that ensures that call chains that are invalid will get thrown * away at an appropriate time. Note that exactly which epoch gets * advanced will depend on exactly what the class is tangled up in; in @@ -167,6 +168,7 @@ BumpGlobalEpoch( * ---------------------------------------------------------------------- * * RecomputeClassCacheFlag -- + * * Determine whether the object is prototypical of its class, and hence * able to use the class's method chain cache. * @@ -189,6 +191,7 @@ RecomputeClassCacheFlag( * ---------------------------------------------------------------------- * * TclOOObjectSetFilters -- + * * Install a list of filter method names into an object. * * ---------------------------------------------------------------------- @@ -247,6 +250,7 @@ TclOOObjectSetFilters( * ---------------------------------------------------------------------- * * TclOOClassSetFilters -- + * * Install a list of filter method names into a class. * * ---------------------------------------------------------------------- @@ -309,6 +313,7 @@ TclOOClassSetFilters( * ---------------------------------------------------------------------- * * TclOOObjectSetMixins -- + * * Install a list of mixin classes into an object. * * ---------------------------------------------------------------------- @@ -350,9 +355,12 @@ TclOOObjectSetMixins( FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr != oPtr->selfCls) { TclOOAddToInstances(oPtr, mixinPtr); - /* Corresponding TclOODecrRefCount() is in the caller of this + + /* + * Corresponding TclOODecrRefCount() is in the caller of this * function. */ + TclOODecrRefCount(mixinPtr->thisPtr); } } @@ -364,6 +372,7 @@ TclOOObjectSetMixins( * ---------------------------------------------------------------------- * * TclOOClassSetMixins -- + * * Install a list of mixin classes into a class. * * ---------------------------------------------------------------------- @@ -401,9 +410,12 @@ TclOOClassSetMixins( memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); - /* Corresponding TclOODecrRefCount() is in the caller of this - * function + + /* + * Corresponding TclOODecrRefCount() is in the caller of this + * function. */ + TclOODecrRefCount(mixinPtr->thisPtr); } } @@ -414,6 +426,7 @@ TclOOClassSetMixins( * ---------------------------------------------------------------------- * * RenameDeleteMethod -- + * * Core of the code to rename and delete methods. * * ---------------------------------------------------------------------- @@ -503,6 +516,7 @@ RenameDeleteMethod( * ---------------------------------------------------------------------- * * TclOOUnknownDefinition -- + * * Handles what happens when an unknown command is encountered during the * processing of a definition script. Works by finding a command in the * operating definition namespace that the requested command is a unique @@ -581,6 +595,7 @@ TclOOUnknownDefinition( * ---------------------------------------------------------------------- * * FindCommand -- + * * Specialized version of Tcl_FindCommand that handles command prefixes * and disallows namespace magic. * @@ -641,6 +656,7 @@ FindCommand( * ---------------------------------------------------------------------- * * InitDefineContext -- + * * Does the magic incantations necessary to push the special stack frame * used when processing object definitions. It is up to the caller to * dispose of the frame (with TclPopStackFrame) when finished. @@ -666,7 +682,9 @@ InitDefineContext( return TCL_ERROR; } - /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */ + /* + * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules. + */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, FRAME_IS_OO_DEFINE); @@ -681,6 +699,7 @@ InitDefineContext( * ---------------------------------------------------------------------- * * TclOOGetDefineCmdContext -- + * * Extracts the magic token from the current stack frame, or returns NULL * (and leaves an error message) otherwise. * @@ -717,6 +736,7 @@ TclOOGetDefineCmdContext( * ---------------------------------------------------------------------- * * GetClassInOuterContext -- + * * Wrapper round Tcl_GetObjectFromObj to perform the lookup in the * context that called oo::define (or equivalent). Note that this may * have to go up multiple levels to get the level that we started doing @@ -759,6 +779,7 @@ GetClassInOuterContext( * ---------------------------------------------------------------------- * * GenerateErrorInfo -- + * * Factored out code to generate part of the error trace messages. * * ---------------------------------------------------------------------- @@ -797,6 +818,7 @@ GenerateErrorInfo( * ---------------------------------------------------------------------- * * MagicDefinitionInvoke -- + * * Part of the implementation of the "oo::define" and "oo::objdefine" * commands that is used to implement the more-than-one-argument case, * applying ensemble-like tricks with dispatch so that error messages are @@ -860,6 +882,7 @@ MagicDefinitionInvoke( * ---------------------------------------------------------------------- * * TclOODefineObjCmd -- + * * Implementation of the "oo::define" command. Works by effectively doing * the same as 'namespace eval', but with extra magic applied so that the * object to be modified is known to the commands in the target @@ -934,6 +957,7 @@ TclOODefineObjCmd( * ---------------------------------------------------------------------- * * TclOOObjDefObjCmd -- + * * Implementation of the "oo::objdefine" command. Works by effectively * doing the same as 'namespace eval', but with extra magic applied so * that the object to be modified is known to the commands in the target @@ -1001,6 +1025,7 @@ TclOOObjDefObjCmd( * ---------------------------------------------------------------------- * * TclOODefineSelfObjCmd -- + * * Implementation of the "self" subcommand of the "oo::define" command. * Works by effectively doing the same as 'namespace eval', but with * extra magic applied so that the object to be modified is known to the @@ -1068,6 +1093,7 @@ TclOODefineSelfObjCmd( * ---------------------------------------------------------------------- * * TclOODefineObjSelfObjCmd -- + * * Implementation of the "self" subcommand of the "oo::objdefine" * command. * @@ -1101,6 +1127,7 @@ TclOODefineObjSelfObjCmd( * ---------------------------------------------------------------------- * * TclOODefineClassObjCmd -- + * * Implementation of the "class" subcommand of the "oo::objdefine" * command. * @@ -1175,7 +1202,10 @@ TclOODefineClassObjCmd( if (oPtr->selfCls != clsPtr) { TclOORemoveFromInstances(oPtr, oPtr->selfCls); - /* Reference count already incremented 3 lines up. */ + /* + * Reference count already incremented a few lines up. + */ + oPtr->selfCls = clsPtr; TclOOAddToInstances(oPtr, oPtr->selfCls); @@ -1192,6 +1222,7 @@ TclOODefineClassObjCmd( * ---------------------------------------------------------------------- * * TclOODefineConstructorObjCmd -- + * * Implementation of the "constructor" subcommand of the "oo::define" * command. * @@ -1260,6 +1291,7 @@ TclOODefineConstructorObjCmd( * ---------------------------------------------------------------------- * * TclOODefineDeleteMethodObjCmd -- + * * Implementation of the "deletemethod" subcommand of the "oo::define" * and "oo::objdefine" commands. * @@ -1316,6 +1348,7 @@ TclOODefineDeleteMethodObjCmd( * ---------------------------------------------------------------------- * * TclOODefineDestructorObjCmd -- + * * Implementation of the "destructor" subcommand of the "oo::define" * command. * @@ -1380,6 +1413,7 @@ TclOODefineDestructorObjCmd( * ---------------------------------------------------------------------- * * TclOODefineExportObjCmd -- + * * Implementation of the "export" subcommand of the "oo::define" and * "oo::objdefine" commands. * @@ -1474,6 +1508,7 @@ TclOODefineExportObjCmd( * ---------------------------------------------------------------------- * * TclOODefineForwardObjCmd -- + * * Implementation of the "forward" subcommand of the "oo::define" and * "oo::objdefine" commands. * @@ -1534,6 +1569,7 @@ TclOODefineForwardObjCmd( * ---------------------------------------------------------------------- * * TclOODefineMethodObjCmd -- + * * Implementation of the "method" subcommand of the "oo::define" and * "oo::objdefine" commands. * @@ -1591,6 +1627,7 @@ TclOODefineMethodObjCmd( * ---------------------------------------------------------------------- * * TclOODefineMixinObjCmd -- + * * Implementation of the "mixin" subcommand of the "oo::define" and * "oo::objdefine" commands. * @@ -1634,9 +1671,12 @@ TclOODefineMixinObjCmd( goto freeAndError; } mixins[i-1] = clsPtr; - /* Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins, + + /* + * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins, * TclOOClassSetMixinsk, or just below if this function fails. */ + AddRef(mixins[i-1]->thisPtr); } @@ -1661,6 +1701,7 @@ TclOODefineMixinObjCmd( * ---------------------------------------------------------------------- * * TclOODefineRenameMethodObjCmd -- + * * Implementation of the "renamemethod" subcommand of the "oo::define" * and "oo::objdefine" commands. * @@ -1717,6 +1758,7 @@ TclOODefineRenameMethodObjCmd( * ---------------------------------------------------------------------- * * TclOODefineUnexportObjCmd -- + * * Implementation of the "unexport" subcommand of the "oo::define" and * "oo::objdefine" commands. * @@ -1811,6 +1853,7 @@ TclOODefineUnexportObjCmd( * ---------------------------------------------------------------------- * * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor -- + * * How to install a constructor or destructor into a class; API to call * from C. * @@ -1865,6 +1908,7 @@ Tcl_ClassSetDestructor( * ---------------------------------------------------------------------- * * TclOODefineSlots -- + * * Create the "::oo::Slot" class and its standard instances. Class * definition is empty at the stage (added by scripting). * @@ -1908,6 +1952,7 @@ TclOODefineSlots( * ---------------------------------------------------------------------- * * ClassFilterGet, ClassFilterSet -- + * * Implementation of the "filter" slot accessors of the "oo::define" * command. * @@ -1987,6 +2032,7 @@ ClassFilterSet( * ---------------------------------------------------------------------- * * ClassMixinGet, ClassMixinSet -- + * * Implementation of the "mixin" slot accessors of the "oo::define" * command. * @@ -2077,9 +2123,12 @@ ClassMixinSet( Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } - /* Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or just - * below if this function fails + + /* + * Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or + * just below if this function fails. */ + AddRef(mixins[i]->thisPtr); } @@ -2099,6 +2148,7 @@ ClassMixinSet( * ---------------------------------------------------------------------- * * ClassSuperGet, ClassSuperSet -- + * * Implementation of the "superclass" slot accessors of the "oo::define" * command. * @@ -2199,7 +2249,11 @@ ClassSuperSet( superclasses[0] = oPtr->fPtr->objectCls; } superc = 1; - /* Corresponding TclOODecrRefCount is near the end of this function */ + + /* + * Corresponding TclOODecrRefCount is near the end of this function. + */ + AddRef(superclasses[0]->thisPtr); } else { for (i=0 ; ithisPtr); } } @@ -2252,7 +2310,11 @@ ClassSuperSet( oPtr->classPtr->superclasses.num = superc; FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOOAddToSubclasses(oPtr->classPtr, superPtr); - /* To account for the AddRef() earlier in this function */ + + /* + * To account for the AddRef() earlier in this function. + */ + TclOODecrRefCount(superPtr->thisPtr); } BumpGlobalEpoch(interp, oPtr->classPtr); @@ -2264,6 +2326,7 @@ ClassSuperSet( * ---------------------------------------------------------------------- * * ClassVarsGet, ClassVarsSet -- + * * Implementation of the "variable" slot accessors of the "oo::define" * command. * @@ -2406,6 +2469,7 @@ ClassVarsSet( * ---------------------------------------------------------------------- * * ObjectFilterGet, ObjectFilterSet -- + * * Implementation of the "filter" slot accessors of the "oo::objdefine" * command. * @@ -2473,6 +2537,7 @@ ObjFilterSet( * ---------------------------------------------------------------------- * * ObjectMixinGet, ObjectMixinSet -- + * * Implementation of the "mixin" slot accessors of the "oo::objdefine" * command. * @@ -2550,9 +2615,12 @@ ObjMixinSet( TclStackFree(interp, mixins); return TCL_ERROR; } - /* Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or + + /* + * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or * just above if this function fails. */ + AddRef(mixins[i]->thisPtr); } @@ -2565,6 +2633,7 @@ ObjMixinSet( * ---------------------------------------------------------------------- * * ObjectVarsGet, ObjectVarsSet -- + * * Implementation of the "variable" slot accessors of the "oo::objdefine" * command. * -- cgit v0.12 From 48456596fff560a8a2e3bb709c7683d07874d306 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Jan 2018 11:15:14 +0000 Subject: (partial) fix for [https://core.tcl.tk/tk/info/00a27923ee26437611e1ed83f96e15b6caabcd8b|00a27923ee]: text/entry dysfunctional when pasting an emoji on MacOSX. Don't handle incoming valid 4-byte UTF-8 characters as invalid byte sequences (since they aren't), but as being the Unicode replacement character. --- generic/tclUtf.c | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 6255a4e..f7ceaab 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -68,11 +68,7 @@ static const unsigned char totalBytes[256] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, -#if TCL_UTF_MAX > 3 4,4,4,4,4,4,4,4, -#else - 1,1,1,1,1,1,1,1, -#endif 1,1,1,1,1,1,1,1 }; @@ -334,13 +330,22 @@ Tcl_UtfToUniChar( * represents itself. */ } -#if TCL_UTF_MAX > 3 else if (byte < 0xF8) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ -#if TCL_UTF_MAX == 4 +#if TCL_UTF_MAX == 3 + byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) + | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000; + if (byte & 0x100000) { + /* out of range, < 0x10000 or > 0x10ffff */ + } else { + /* produce replacement character, and advance source pointer */ + *chPtr = (Tcl_UniChar) 0xFFFD; + return 4; + } +#elif TCL_UTF_MAX == 4 Tcl_UniChar surrogate; byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) @@ -371,7 +376,6 @@ Tcl_UtfToUniChar( * represents itself. */ } -#endif *chPtr = (Tcl_UniChar) byte; return 1; @@ -505,13 +509,13 @@ Tcl_NumUtfChars( } if (i < 0) i = INT_MAX; /* Bug [2738427] */ } else { - register const char *endPtr = src + length - TCL_UTF_MAX; + register const char *endPtr = src + length - 4; while (src < endPtr) { src += TclUtfToUniChar(src, &ch); i++; } - endPtr += TCL_UTF_MAX; + endPtr += 4; while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) { src += TclUtfToUniChar(src, &ch); i++; @@ -683,7 +687,7 @@ Tcl_UtfPrev( int i, byte; look = --src; - for (i = 0; i < TCL_UTF_MAX; i++) { + for (i = 0; i < 4; i++) { if (look < start) { if (src < start) { src = start; -- cgit v0.12 From 37b48e808c43273e27f69fff6280a7a29f3b7c4d Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 9 Jan 2018 18:10:06 +0000 Subject: Fix tests dependent on other tests in zipfs.test Add a workaround for the fact that dynamic libraries called out from a non-install location can't be located and mounted in time to be a candidate for tcl_library when running under the constraints of "make test" --- tests/zipfs.test | 65 +++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 48 insertions(+), 17 deletions(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index abf888b..43aa48b 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -23,6 +23,10 @@ testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [i #} -result {} set ziproot [zipfs root] +set CWD [pwd] +set tmpdir [file join $CWD tmp] +file mkdir $tmpdir + test zipfs-0.1 {zipfs basics} -constraints zipfs -body { package require zipfs @@ -32,6 +36,22 @@ test zipfs-0.1 {zipfs basics} -constraints zipfs -body { expr {${ziproot} in [file volumes]} } -result 1 +if {![string match ${ziproot}* $tcl_library]} { + ### + # "make test" does not map tcl_library from the dynamic library on Unix + # + # Hack the environment to pretend we did pull tcl_library from a zip + # archive + ### + set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]] + if {[file exists $tclzip]} { + zipfs mount $tclzip /lib/tcl + set ::tcl_library ${ziproot}lib/tcl/tcl_library + } else { + tcltest::skip zipfs-0.* + } +} + test zipfs-0.2 {zipfs basics} -constraints zipfs -body { string match ${ziproot}* $tcl_library } -result 1 @@ -116,25 +136,36 @@ test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs list a b c d e f } -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"} +file mkdir tmp + test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body { - zipfs mkzip /tmp/abc.zip $tcl_library/xxxx ;# FIXME: test independence + zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx } -result {empty archive} -test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body { - set pwd [pwd] +### +# The 2.2 series of tests operate within +# a zipfile created a temporary directory +### +set zipfile [file join $tmpdir abc.zip] +if {[file exists $zipfile]} { + file delete $zipfile +} + +test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body { cd $tcl_library/encoding - zipfs mkzip /tmp/abc.zip . - zipfs mount /tmp/abc.zip ${ziproot}abc ;# FIXME: test independence + zipfs mkzip $zipfile . + zipfs mount $zipfile ${ziproot}abc zipfs list -glob ${ziproot}abc/cp850.* } -cleanup { - cd $pwd + cd $CWD } -result "[zipfs root]abc/cp850.enc" -test zipfs-2.3 {zipfs info} -constraints zipfs -body { - zipfs info ${ziproot}abc/cp850.enc -} -result [list /tmp/abc.zip 1090 527 39318] ;# FIXME: result depends on content of encodings dir +test zipfs-2.2.1 {zipfs info} -constraints zipfs -body { + set r [zipfs info ${ziproot}abc/cp850.enc] + lrange $r 0 2 +} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable -test zipfs-2.4 {zipfs data} -constraints zipfs -body { +test zipfs-2.2.3 {zipfs data} -constraints zipfs -body { set zipfd [open ${ziproot}/abc/cp850.enc] ;# FIXME: leave open - see later test read $zipfd } -result {# Encoding file: cp850, single-byte @@ -159,21 +190,21 @@ S 00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 } ;# FIXME: result depends on content of encodings dir -test zipfs-2.5 {zipfs exists} -constraints zipfs -body { +test zipfs-2.2.4 {zipfs exists} -constraints zipfs -body { zipfs exists /abc/cp850.enc } -result 1 -test zipfs-2.6 {zipfs unmount while busy} -constraints zipfs -body { - zipfs unmount /tmp/abc.zip +test zipfs-2.2.5 {zipfs unmount while busy} -constraints zipfs -body { + zipfs unmount $zipfile } -returnCodes error -result {filesystem is busy} -test zipfs-2.7 {zipfs unmount} -constraints zipfs -body { +test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body { close $zipfd - zipfs unmount /tmp/abc.zip + zipfs unmount $zipfile zipfs exists /abc/cp850.enc -} -cleanup { - file delete /tmp/abc.zip ;# FIXME: test independence } -result 0 + +file delete -force $tmpdir ::tcltest::cleanupTests return -- cgit v0.12 From 04d3db559246ee9e2ac2a5e20e52cf57b7af808b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 10 Jan 2018 09:32:51 +0000 Subject: Don't use TclUtfToUniChar here: it doesn't give any advantage over Tcl_UtfToUniChar --- generic/tclUtil.c | 4 ++-- win/tclWinSerial.c | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 41795e8..15018de 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2223,7 +2223,7 @@ Tcl_StringCaseMatch( (nocase ? tolower(UCHAR(*str)) : UCHAR(*str)); str++; } else { - str += TclUtfToUniChar(str, &ch1); + str += Tcl_UtfToUniChar(str, &ch1); if (nocase) { ch1 = Tcl_UniCharToLower(ch1); } @@ -2252,7 +2252,7 @@ Tcl_StringCaseMatch( ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); pattern++; } else { - pattern += TclUtfToUniChar(pattern, &endChar); + pattern += Tcl_UtfToUniChar(pattern, &endChar); if (nocase) { endChar = Tcl_UniCharToLower(endChar); } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 894f431..acfeecb 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1741,12 +1741,12 @@ SerialSetOptionProc( Tcl_UniChar character = 0; int charLen; - charLen = TclUtfToUniChar(argv[0], &character); + charLen = Tcl_UtfToUniChar(argv[0], &character); if (argv[0][charLen]) { goto badXchar; } dcb.XonChar = (char) character; - charLen = TclUtfToUniChar(argv[1], &character); + charLen = Tcl_UtfToUniChar(argv[1], &character); if (argv[1][charLen]) { goto badXchar; } -- cgit v0.12 From 48d6a20861f95be856bef0e780c054757c9c3803 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 10 Jan 2018 14:02:03 +0000 Subject: Re-implement Tcl_WinTCharToUtf/Tcl_WinUtfToTChar in pure win32 api, even for TCL_UTF_MAX=3. We can do that now safely, because of the changed handling of valid 4-byte UTF-8 characters in the previous commit. --- generic/tclEvent.c | 1 - generic/tclIOUtil.c | 9 ------ generic/tclInt.h | 1 - generic/tclIntPlatDecls.h | 4 +++ generic/tclStubInit.c | 39 +++++++----------------- unix/tclUnixInit.c | 6 ---- win/tclWin32Dll.c | 76 ++--------------------------------------------- win/tclWinInit.c | 7 ----- 8 files changed, 17 insertions(+), 126 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 49fd2ae..93cf983 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1057,7 +1057,6 @@ TclInitSubsystems(void) * mutexes. */ TclInitIOSubsystem(); /* Inits a tsd key (noop). */ TclInitEncodingSubsystem(); /* Process wide encoding init. */ - TclpSetInterfaces(); TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ subsystemsInitialized = 1; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 8fb3aa8..144bab0 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -830,15 +830,6 @@ TclResetFilesystem(void) if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } - -#ifdef _WIN32 - /* - * Cleans up the win32 API filesystem proc lookup table. This must happen - * very late in finalization so that deleting of copied dlls can occur. - */ - - TclWinResetInterfaces(); -#endif } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 2ba0493..888adca 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3157,7 +3157,6 @@ MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); -MODULE_SCOPE void TclpSetInterfaces(void); MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp); MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr); MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr, diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 1222cee..ada1d2b 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -549,6 +549,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinConvertWSAError TclWinConvertError #undef TclpInetNtoa #define TclpInetNtoa inet_ntoa +#undef TclWinResetInterfaces +#define TclWinResetInterfaces() /* nop */ +#undef TclWinSetInterfaces +#define TclWinSetInterfaces(dummy) /* nop */ #if defined(_WIN32) # undef TclWinNToHS diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 227bf02..e25b148 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -104,6 +104,13 @@ static const char *TclGetStartupScriptFileName(void) #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS #undef TclWinGetPlatformId +#undef TclWinResetInterfaces +#undef TclWinSetInterfaces +static void +doNothing(void) +{ + /* dummy implementation, no need to do anything */ +} #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #define TclWinNToHS winNToHS static unsigned short TclWinNToHS(unsigned short ns) { @@ -115,9 +122,13 @@ TclWinGetPlatformId(void) { return 2; /* VER_PLATFORM_WIN32_NT */; } +#define TclWinResetInterfaces doNothing +#define TclWinSetInterfaces (void (*) (int)) doNothing #else #define TclWinNToHS 0 #define TclWinGetPlatformId 0 +#define TclWinResetInterfaces 0 +#define TclWinSetInterfaces 0 #endif #endif # define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt @@ -133,14 +144,8 @@ TclWinGetPlatformId(void) # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty -# define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing -# define TclWinResetInterfaces doNothing - -#if TCL_UTF_MAX < 4 -static Tcl_Encoding winTCharEncoding; -#endif static int TclpIsAtty(int fd) @@ -201,19 +206,12 @@ TclpGetPid(Tcl_Pid pid) return (int) (size_t) pid; } -static void -doNothing(void) -{ - /* dummy implementation, no need to do anything */ -} - char * Tcl_WinUtfToTChar( const char *string, int len, Tcl_DString *dsPtr) { -#if TCL_UTF_MAX > 3 WCHAR *wp; int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0); @@ -225,13 +223,6 @@ Tcl_WinUtfToTChar( Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; return (char *)wp; -#else - if (!winTCharEncoding) { - winTCharEncoding = Tcl_GetEncoding(0, "unicode"); - } - return Tcl_UtfToExternalDString(winTCharEncoding, - string, len, dsPtr); -#endif } char * @@ -240,7 +231,6 @@ Tcl_WinTCharToUtf( int len, Tcl_DString *dsPtr) { -#if TCL_UTF_MAX > 3 char *p; int size; @@ -256,13 +246,6 @@ Tcl_WinTCharToUtf( Tcl_DStringSetLength(dsPtr, size); p[size] = 0; return p; -#else - if (!winTCharEncoding) { - winTCharEncoding = Tcl_GetEncoding(0, "unicode"); - } - return Tcl_ExternalToUtfDString(winTCharEncoding, - string, len, dsPtr); -#endif } #if defined(TCL_WIDE_INT_IS_LONG) diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index cc66569..630460a 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -577,12 +577,6 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -void -TclpSetInterfaces(void) -{ - /* do nothing */ -} - static const char * SearchKnownEncodings( const char *encoding) diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index da1cdfe..599c126 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -32,10 +32,6 @@ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ #define cpuid __asm __emit 0fh __asm __emit 0a2h #endif -#if TCL_UTF_MAX < 4 -static Tcl_Encoding winTCharEncoding = NULL; -#endif - /* * The following declaration is for the VC++ DLL entry point. */ @@ -196,8 +192,6 @@ TclWinInit( if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) { Tcl_Panic("Windows NT is the only supported platform"); } - - TclWinResetInterfaces(); } /* @@ -234,38 +228,10 @@ TclWinNoBackslash( /* *--------------------------------------------------------------------------- * - * TclpSetInterfaces -- - * - * A helper proc. - * - * Results: - * None. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -void -TclpSetInterfaces(void) -{ -#if TCL_UTF_MAX < 4 - TclWinResetInterfaces(); - winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); -#endif -} - -/* - *--------------------------------------------------------------------------- - * * TclWinEncodingsCleanup -- * - * Called during finalization to free up any encodings we use. - * - * We also clean up any memory allocated in our mount point map which is - * used to follow certain kinds of symlinks. That code should never be - * used once encodings are taken down. + * Called during finalization to clean up any memory allocated in our + * mount point map which is used to follow certain kinds of symlinks. * * Results: * None. @@ -281,8 +247,6 @@ TclWinEncodingsCleanup(void) { MountPointMap *dlIter, *dlIter2; - TclWinResetInterfaces(); - /* * Clean up the mount point map. */ @@ -299,32 +263,6 @@ TclWinEncodingsCleanup(void) } /* - *--------------------------------------------------------------------------- - * - * TclWinResetInterfaces -- - * - * Called during finalization to reset us to a safe state for reuse. - * - * Results: - * None. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ -void -TclWinResetInterfaces(void) -{ -#if TCL_UTF_MAX < 4 - if (winTCharEncoding != NULL) { - Tcl_FreeEncoding(winTCharEncoding); - winTCharEncoding = NULL; - } -#endif -} - -/* *-------------------------------------------------------------------- * * TclWinDriveLetterForVolMountPoint @@ -533,7 +471,6 @@ Tcl_WinUtfToTChar( Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { -#if TCL_UTF_MAX > 3 TCHAR *wp; int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0); @@ -545,10 +482,6 @@ Tcl_WinUtfToTChar( Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; return wp; -#else - return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding, - string, len, dsPtr); -#endif } char * @@ -559,7 +492,6 @@ Tcl_WinTCharToUtf( Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { -#if TCL_UTF_MAX > 3 char *p; int size; @@ -575,10 +507,6 @@ Tcl_WinTCharToUtf( Tcl_DStringSetLength(dsPtr, size); p[size] = 0; return p; -#else - return Tcl_ExternalToUtfDString(winTCharEncoding, - (const char *) string, len, dsPtr); -#endif } /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index dc8bba7..91f149b 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -487,18 +487,11 @@ TclpSetInitialEncodings(void) { Tcl_DString encodingName; - TclpSetInterfaces(); Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } -void TclWinSetInterfaces( - int dummy) /* Not used. */ -{ - TclpSetInterfaces(); -} - const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) -- cgit v0.12 From 3b5858bcd23542b0ff0249a128808ef20922beb6 Mon Sep 17 00:00:00 2001 From: oehhar Date: Wed, 10 Jan 2018 23:17:43 +0000 Subject: TIP490: oo for msgcal: new solution enable any command for oo, new command mcpackagenamespacege --- changes | 2 ++ library/msgcat/msgcat.tcl | 49 ++++++++++++++++++++++-------- library/msgcat/pkgIndex.tcl | 2 +- tests/msgcat.test | 74 +++++++++++++++++++++++++++++++++++++++++++++ unix/Makefile.in | 4 +-- win/Makefile.in | 4 +-- 6 files changed, 118 insertions(+), 17 deletions(-) diff --git a/changes b/changes index f89704b..51c0477 100644 --- a/changes +++ b/changes @@ -8879,3 +8879,5 @@ in this changeset (new minor version) rather than bug fixes: 2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) --- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details + +2017-12-11 (TIP 490) add oo support for msgcat => msgcat 1.6.2 (oehlmann) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 646bc17..849adc6 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -14,12 +14,12 @@ package require Tcl 8.5- # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. -package provide msgcat 1.6.1 +package provide msgcat 1.6.2 namespace eval msgcat { namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\ mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\ - mcpackageconfig mcpackagelocale + mcpackagenamespaceget mcpackageconfig mcpackagelocale # Records the list of locales to search variable Loclist {} @@ -193,9 +193,6 @@ namespace eval msgcat { # format command. proc msgcat::mc {src args} { - # this may be replaced by: - # return [mcget -namespace [uplevel 1 [list ::namespace current]] --\ - # $src {*}$args] # Check for the src in each namespace starting from the local and # ending in the global. @@ -203,7 +200,7 @@ proc msgcat::mc {src args} { variable Msgs variable Loclist - set ns [uplevel 1 [list ::namespace current]] + set ns [PackageNamespaceGet] set loclist [PackagePreferences $ns] set nscur $ns @@ -245,7 +242,7 @@ proc msgcat::mcexists {args} { variable Loclist variable PackageConfig - set ns [uplevel 1 [list ::namespace current]] + set ns [PackageNamespaceGet] set loclist [PackagePreferences $ns] while {[llength $args] != 1} { @@ -462,7 +459,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { } set locale [string tolower $locale] } - set ns [uplevel 1 {::namespace current}] + set ns [PackageNamespaceGet] switch -exact -- $subcommand { get { return [lindex [PackagePreferences $ns] 0] } @@ -551,7 +548,7 @@ proc msgcat::mcforgetpackage {} { # todo: this may be implemented using an ensemble variable PackageConfig variable Msgs - set ns [uplevel 1 {::namespace current}] + set ns [PackageNamespaceGet] # Remove MC items dict unset Msgs $ns # Remove config items @@ -561,6 +558,15 @@ proc msgcat::mcforgetpackage {} { return } +# msgcat::mcgetmynamespace -- +# +# Return the package namespace of the caller +# This consideres to be called from a class or object. + +proc msgcat::mcpackagenamespaceget {} { + return [PackageNamespaceGet] +} + # msgcat::mcpackageconfig -- # # Get or modify the per caller namespace (e.g. packages) config options. @@ -616,7 +622,7 @@ proc msgcat::mcforgetpackage {} { proc msgcat::mcpackageconfig {subcommand option {value ""}} { variable PackageConfig # get namespace - set ns [uplevel 1 {::namespace current}] + set ns [PackageNamespaceGet] if {$option ni {"mcfolder" "loadcmd" "changecmd" "unknowncmd"}} { return -code error "bad option \"$option\": must be mcfolder, loadcmd,\ @@ -923,7 +929,7 @@ proc msgcat::mcset {locale src {dest ""}} { set dest $src } - set ns [uplevel 1 [list ::namespace current]] + set ns [PackageNamespaceGet] set locale [string tolower $locale] @@ -975,7 +981,7 @@ proc msgcat::mcmset {locale pairs} { } set locale [string tolower $locale] - set ns [uplevel 1 [list ::namespace current]] + set ns [PackageNamespaceGet] foreach {src dest} $pairs { dict set Msgs $ns $locale $src $dest @@ -1106,6 +1112,25 @@ proc msgcat::ConvertLocale {value} { return $ret } +# helper function to find package namespace of stack-frame -2 +# There are 3 possibilities: +# - called from a proc +# - called from a oo class +# - called from a classless oo object +proc ::msgcat::PackageNamespaceGet {} { + uplevel 2 { + # Check for no object + if {0 == [llength [info commands self]]} {return [namespace current]} + set Class [info object class [self]] + # Check for classless defined object + if {$Class eq {::oo::object}} { + return [namespace qualifiers [self]] + } + # Class defined object + return [namespace qualifiers $Class] + } +} + # Initialize the default locale proc msgcat::Init {} { global env diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 72c5dc0..bc58cbe 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded msgcat 1.6.1 [list source [file join $dir msgcat.tcl]] +package ifneeded msgcat 1.6.2 [list source [file join $dir msgcat.tcl]] diff --git a/tests/msgcat.test b/tests/msgcat.test index 1c3ce58..9dc8b48 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -1073,6 +1073,80 @@ namespace eval ::msgcat::test { } -returnCodes 1\ -result {fail} + + # Tests msgcat-15.*: tcloo coverage + + # There are 3 use-cases, where 2 must be tested now: + # - namespace defined, class defined oo, classless + + test msgcat-15.1 {mc in class} -setup { + namespace eval ::bar { + ::msgcat::mcset foo_BAR con2 con2bar + oo::class create ClassCur + oo::define ClassCur method method1 {} {::msgcat::mc con2} + } + namespace eval ::baz { + set ObjCur [::bar::ClassCur new] + } + variable locale [mclocale] + mclocale foo_BAR + } -cleanup { + mclocale $locale + namespace eval ::bar {::msgcat::mcforgetpackage} + namespace forget ::bar ::baz + } -body { + $::baz::ObjCur method1 + } -result con2bar + + test msgcat-15.2 {mc in classless object} -setup { + namespace eval ::bar { + ::msgcat::mcset foo_BAR con2 con2bar + oo::object create ObjCur + oo::objdefine ObjCur method method1 {} {::msgcat::mc con2} + } + variable locale [mclocale] + mclocale foo_BAR + } -cleanup { + mclocale $locale + namespace eval ::bar {::msgcat::mcforgetpackage} + namespace forget ::bar + } -body { + ::bar::ObjCur method1 + } -result con2bar + + # Test msgcat-16.*: command mcpackagenamespaceget + + test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body { + namespace eval ::baz {msgcat::mcpackagenamespaceget} + } -result ::baz + + test msgcat-16.2 {mcpackagenamespaceget in class} -setup { + namespace eval ::bar { + oo::class create ClassCur + oo::define ClassCur method method1 {} {msgcat::mcpackagenamespaceget} + } + namespace eval ::baz { + set ObjCur [::bar::ClassCur new] + } + } -cleanup { + namespace forget ::bar ::baz + } -body { + $::baz::ObjCur method1 + } -result ::bar + + test msgcat-16.3 {mcpackagenamespaceget in classless object} -setup { + namespace eval ::bar { + oo::object create ObjCur + oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget} + } + } -cleanup { + namespace forget ::bar + } -body { + ::bar::ObjCur method1 + } -result ::bar + + + interp bgerror {} $bgerrorsaved cleanupTests diff --git a/unix/Makefile.in b/unix/Makefile.in index f3b9782..a343864 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -855,8 +855,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; - @echo "Installing package msgcat 1.6.1 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm; + @echo "Installing package msgcat 1.6.2 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.2.tm; @echo "Installing package tcltest 2.4.1 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm; diff --git a/win/Makefile.in b/win/Makefile.in index a3275ba..f3e1bd6 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -664,8 +664,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.6.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm; + @echo "Installing package msgcat 1.6.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.2.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; -- cgit v0.12 From eb3422673ff62a7427f2e6d166840fce68237d74 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 11 Jan 2018 14:11:38 +0000 Subject: Add test-cases for bug [11ae2be95dac9417], and make a start fixing it. Almost works. --- generic/tclCmdMZ.c | 12 ++++++++++-- generic/tclStringObj.c | 33 +++++++++++++++++++++++++++++++-- tests/string.test | 7 +++++++ 3 files changed, 48 insertions(+), 4 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index a206cc5..a23f007 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1435,7 +1435,7 @@ StringIndexCmd( } /* - * Get the char length to calulate what 'end' means. + * Get the char length to calculate what 'end' means. */ length = Tcl_GetCharLength(objv[1]); @@ -1444,7 +1444,15 @@ StringIndexCmd( } if ((index >= 0) && (index < length)) { - Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index); + int ch = Tcl_GetUniChar(objv[1], index); + + if (ch >= 0x10000) { + printf("HI: %x\n", ch); + } + if (ch == -1) { + printf("LO: %x\n", ch); + return TCL_OK; + } /* * If we have a ByteArray object, we're careful to generate a new diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 01f8d80..aa5aba3 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -460,7 +460,8 @@ Tcl_GetCharLength( * Tcl_GetUniChar -- * * Get the index'th Unicode character from the String object. The index - * is assumed to be in the appropriate range. + * is assumed to be in the appropriate range. If index references a lower + * surrogate preceded by a higher surrogate, the result = -1; * * Results: * Returns the index'th Unicode character in the Object. @@ -478,6 +479,7 @@ Tcl_GetUniChar( int index) /* Get the index'th Unicode character. */ { String *stringPtr; + int ch; /* * Optimize the case where we're really dealing with a bytearray object @@ -512,7 +514,23 @@ Tcl_GetUniChar( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - return (int) stringPtr->unicode[index]; + + ch = stringPtr->unicode[index]; +#if TCL_UTF_MAX == 4 + /* See: bug [11ae2be95dac9417] */ + if ((ch&0xF800) == 0xD800) { + if (ch&0x400) { + if ((index > 0) && ((stringPtr->unicode[index-1]&0xFC00) == 0xD800)) { + ch = -1; /* low surrogate preceded by high surrogate */ + } + } else if ((++index < stringPtr->numChars) + && ((stringPtr->unicode[index]&0xFC00) == 0xDC00)) { + /* high surrogate followed by low surrogate */ + ch = (((ch & 0x3FF) << 10) | (stringPtr->unicode[index] & 0x3FF)) + 0x10000; + } + } +#endif + return ch; } /* @@ -656,6 +674,17 @@ Tcl_GetRange( stringPtr = GET_STRING(objPtr); } +#if TCL_UTF_MAX == 4 + /* See: bug [11ae2be95dac9417] */ + if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00) + && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) { + ++first; + } + if ((last+1numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00) + && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) { + ++last; + } +#endif return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); } diff --git a/tests/string.test b/tests/string.test index cebaf4c..58328bb 100644 --- a/tests/string.test +++ b/tests/string.test @@ -24,6 +24,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint testindexobj [expr {[info commands testindexobj] != {}}] +testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] @@ -302,6 +303,9 @@ test string-5.19 {string index, bytearray object out of bounds} { test string-5.20 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] 20 } {} +test string-5.21 {string index, surrogates, bug [11ae2be95dac9417]} fullutf { + list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3] +} [list \U100000 {} b] proc largest_int {} { @@ -1288,6 +1292,9 @@ test string-12.22 {string range, shimmering binary/index} { binary scan $s a* x string range $s $s end } 000000001 +test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf { + list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3] +} [list \U100000 {} b] test string-13.1 {string repeat} { list [catch {string repeat} msg] $msg -- cgit v0.12 From 9947048fbda326ad65c7f4a163a00d1d51efd791 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Thu, 11 Jan 2018 16:45:52 +0000 Subject: Tweaks to zipfs.test --- tests/zipfs.test | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 43aa48b..c9dd0ac 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -160,6 +160,13 @@ test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body { cd $CWD } -result "[zipfs root]abc/cp850.enc" +skip [concat [skip] zipfs-2.2.*] + + +if {![zipfs exists /abc/cp850.enc]} { + tcltest::skip zipfs-2.2.* +} + test zipfs-2.2.1 {zipfs info} -constraints zipfs -body { set r [zipfs info ${ziproot}abc/cp850.enc] lrange $r 0 2 @@ -204,7 +211,7 @@ test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body { zipfs exists /abc/cp850.enc } -result 0 -file delete -force $tmpdir +catch {file delete -force $tmpdir} ::tcltest::cleanupTests return -- cgit v0.12 From 1fda13591a6eff53b73bfa288078edb56ab8a26c Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 11 Jan 2018 16:46:09 +0000 Subject: Corrected test cleanups --- tests/msgcat.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/msgcat.test b/tests/msgcat.test index 9dc8b48..387ce85 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -1093,7 +1093,7 @@ namespace eval ::msgcat::test { } -cleanup { mclocale $locale namespace eval ::bar {::msgcat::mcforgetpackage} - namespace forget ::bar ::baz + namespace delete ::bar ::baz } -body { $::baz::ObjCur method1 } -result con2bar @@ -1109,7 +1109,7 @@ namespace eval ::msgcat::test { } -cleanup { mclocale $locale namespace eval ::bar {::msgcat::mcforgetpackage} - namespace forget ::bar + namespace delete ::bar } -body { ::bar::ObjCur method1 } -result con2bar @@ -1129,7 +1129,7 @@ namespace eval ::msgcat::test { set ObjCur [::bar::ClassCur new] } } -cleanup { - namespace forget ::bar ::baz + namespace delete ::bar ::baz } -body { $::baz::ObjCur method1 } -result ::bar @@ -1140,7 +1140,7 @@ namespace eval ::msgcat::test { oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget} } } -cleanup { - namespace forget ::bar + namespace delete ::bar } -body { ::bar::ObjCur method1 } -result ::bar -- cgit v0.12 From c8219a9a2995c5658cd709f4bb7b5b933e6575e9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 12 Jan 2018 10:03:58 +0000 Subject: Fix [11ae2be95d]: tip-389 branch: string range errors with code points greater than U+FFFF --- generic/tclExecute.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f2cda0c..63281a8 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5445,7 +5445,7 @@ TEBCresume( valuePtr->bytes+index, 1); } else { char buf[TCL_UTF_MAX]; - Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index); + int ch = Tcl_GetUniChar(valuePtr, index); /* * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1) @@ -5453,7 +5453,7 @@ TEBCresume( * practical use. */ - length = Tcl_UniCharToUtf(ch, buf); + length = (ch != -1) ? Tcl_UniCharToUtf(ch, buf) : 0; objResultPtr = Tcl_NewStringObj(buf, length); } -- cgit v0.12 From e9f2695255b873c200a7fc465f860b4fd5c97a02 Mon Sep 17 00:00:00 2001 From: oehhar Date: Fri, 12 Jan 2018 14:03:04 +0000 Subject: replace "return [uplevel 1 [list [namespace origin ..." by tailcall --- library/msgcat/msgcat.tcl | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 849adc6..885240f 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -216,7 +216,7 @@ proc msgcat::mc {src args} { # call package local or default unknown command set args [linsert $args 0 [lindex $loclist 0] $src] switch -exact -- [Invoke unknowncmd $args $ns result 1] { - 0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] } + 0 { tailcall mcunknown {*}$args } 1 { return [DefaultUnknown {*}$args] } default { return $result } } @@ -762,8 +762,7 @@ proc msgcat::ListComplement {list1 list2 {inlistname ""}} { # Returns the number of message catalogs that were loaded. proc msgcat::mcload {langdir} { - return [uplevel 1 [list\ - [namespace origin mcpackageconfig] set mcfolder $langdir]] + tailcall mcpackageconfig set mcfolder $langdir } # msgcat::LoadAll -- @@ -957,7 +956,7 @@ proc msgcat::mcflset {src {dest ""}} { return -code error "must only be used inside a message catalog loaded\ with ::msgcat::mcload" } - return [uplevel 1 [list [namespace origin mcset] $FileLocale $src $dest]] + tailcall mcset $FileLocale $src $dest } # msgcat::mcmset -- @@ -1008,7 +1007,7 @@ proc msgcat::mcflmset {pairs} { return -code error "must only be used inside a message catalog loaded\ with ::msgcat::mcload" } - return [uplevel 1 [list [namespace origin mcmset] $FileLocale $pairs]] + tailcal mcmset $FileLocale $pairs } # msgcat::mcunknown -- @@ -1030,7 +1029,7 @@ proc msgcat::mcflmset {pairs} { # Returns the translated value. proc msgcat::mcunknown {args} { - return [uplevel 1 [list [namespace origin DefaultUnknown] {*}$args]] + tailcall DefaultUnknown {*}$args } # msgcat::DefaultUnknown -- -- cgit v0.12 From 2cfe8bb5619eb9a1de655bda6a208e9e2fb8b81b Mon Sep 17 00:00:00 2001 From: oehhar Date: Fri, 12 Jan 2018 14:13:03 +0000 Subject: Use the test "[namespace which self] ne "::oo::Helpers::self"" to check if we are within an object (undocumented test proposed by dkf on clt 2018-01-12 --- library/msgcat/msgcat.tcl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 885240f..66cedea 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -1119,7 +1119,10 @@ proc msgcat::ConvertLocale {value} { proc ::msgcat::PackageNamespaceGet {} { uplevel 2 { # Check for no object - if {0 == [llength [info commands self]]} {return [namespace current]} + # (undocumented test proposed by dkf 2018-01-12) + if { [namespace which self] ne "::oo::Helpers::self"} { + return [namespace current] + } set Class [info object class [self]] # Check for classless defined object if {$Class eq {::oo::object}} { -- cgit v0.12 From e1ffd3f0057b68e75bce64f9c514b9993fb8a79c Mon Sep 17 00:00:00 2001 From: oehhar Date: Fri, 12 Jan 2018 14:52:25 +0000 Subject: Implement the "mcn" command as "mc" with explicit namespace. --- library/msgcat/msgcat.tcl | 32 ++++++++++++++++++++++++++++---- tests/msgcat.test | 12 ++++++++++++ 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 66cedea..29ccf0a 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -17,7 +17,8 @@ package require Tcl 8.5- package provide msgcat 1.6.2 namespace eval msgcat { - namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\ + namespace export mc mcn mcexists mcload mclocale mcmax\ + mcmset mcpreferences mcset\ mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\ mcpackagenamespaceget mcpackageconfig mcpackagelocale @@ -192,7 +193,30 @@ namespace eval msgcat { # Returns the translated string. Propagates errors thrown by the # format command. -proc msgcat::mc {src args} { +proc msgcat::mc {args} { + tailcall mcn [PackageNamespaceGet] {*}$args +} + +# msgcat::mcn -- +# +# Find the translation for the given string based on the current +# locale setting. Check the passed namespace first, then look in each +# parent namespace until the source is found. If additional args are +# specified, use the format command to work them into the traslated +# string. +# If no catalog item is found, mcunknown is called in the caller frame +# and its result is returned. +# +# Arguments: +# ns Package namespace of the translation +# src The string to translate. +# args Args to pass to the format command +# +# Results: +# Returns the translated string. Propagates errors thrown by the +# format command. + +proc msgcat::mcn {ns src args} { # Check for the src in each namespace starting from the local and # ending in the global. @@ -200,7 +224,6 @@ proc msgcat::mc {src args} { variable Msgs variable Loclist - set ns [PackageNamespaceGet] set loclist [PackagePreferences $ns] set nscur $ns @@ -1072,8 +1095,9 @@ proc msgcat::DefaultUnknown {locale src args} { proc msgcat::mcmax {args} { set max 0 + set ns [PackageNamespaceGet] foreach string $args { - set translated [uplevel 1 [list [namespace origin mc] $string]] + set translated [uplevel 1 [list [namespace origin mcn] $ns $string]] set len [string length $translated] if {$len>$max} { set max $len diff --git a/tests/msgcat.test b/tests/msgcat.test index 387ce85..c8f325b 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -1144,7 +1144,19 @@ namespace eval ::msgcat::test { } -body { ::bar::ObjCur method1 } -result ::bar + + + # Test msgcat-17.*: mcn command + test msgcat-17.1 {mcn} -setup { + namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar} + variable locale [mclocale] + mclocale foo_BAR + } -cleanup { + mclocale $locale + } -body { + ::msgcat::mcn [namespace current]::bar con1 + } -result con1bar interp bgerror {} $bgerrorsaved -- cgit v0.12 From ecaec63f48c02c5bb7c0e7585ebc1d746b77ffd9 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sat, 13 Jan 2018 15:23:38 +0000 Subject: Extended command msgcat::mcexists by switch "-namespace ns" to explicitly specify namespace --- library/msgcat/msgcat.tcl | 22 ++++++--- tests/msgcat.test | 120 ++++++++++++++++++++++++++++++++++++---------- 2 files changed, 109 insertions(+), 33 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 29ccf0a..e57802b 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -265,23 +265,31 @@ proc msgcat::mcexists {args} { variable Loclist variable PackageConfig - set ns [PackageNamespaceGet] - set loclist [PackagePreferences $ns] - while {[llength $args] != 1} { set args [lassign $args option] switch -glob -- $option { - -exactnamespace { set exactnamespace 1 } - -exactlocale { set loclist [lrange $loclist 0 0] } + -exactnamespace - -exactlocale { set $option 1 } + -namespace { + if {[llength $args] < 2} { + return -code error\ + "Argument missing for switch \"-namespace\"" + } + set args [lassign $args ns] + } -* { return -code error "unknown option \"$option\"" } default { return -code error "wrong # args: should be\ \"[lindex [info level 0] 0] ?-exactnamespace?\ - ?-exactlocale? src\"" + ?-exactlocale? ?-namespace ns? src\"" } } } set src [lindex $args 0] + + if {![info exists ns]} { set ns [PackageNamespaceGet] } + + set loclist [PackagePreferences $ns] + if {[info exists -exactlocale]} { set loclist [lrange $loclist 0 0] } while {$ns ne ""} { foreach loc $loclist { @@ -289,7 +297,7 @@ proc msgcat::mcexists {args} { return 1 } } - if {[info exists exactnamespace]} {return 0} + if {[info exists -exactnamespace]} {return 0} set ns [namespace parent $ns] } return 0 diff --git a/tests/msgcat.test b/tests/msgcat.test index c8f325b..a99086d 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -688,7 +688,7 @@ namespace eval ::msgcat::test { test msgcat-9.1 {mcexists no parameter} -body { mcexists } -returnCodes 1\ - -result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"} + -result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? ?-namespace ns? src"} test msgcat-9.2 {mcexists unknown option} -body { mcexists -unknown src @@ -724,12 +724,34 @@ namespace eval ::msgcat::test { mcset foo k1 v1 } -cleanup { mclocale $locale + namespace delete ::foo } -body { - namespace eval ::msgcat::test::sub { + namespace eval ::foo { list [::msgcat::mcexists k1]\ - [::msgcat::mcexists -exactnamespace k1] + [::msgcat::mcexists -namespace ::msgcat::test k1] } - } -result {1 0} + } -result {0 1} + + test msgcat-9.6 {mcexists -namespace - ns argument missing} -setup { + mcforgetpackage + variable locale [mclocale] + mclocale foo_bar + mcset foo k1 v1 + } -cleanup { + mclocale $locale + namespace delete ::foo + } -body { + namespace eval ::foo { + list [::msgcat::mcexists k1]\ + [::msgcat::mcexists -namespace ::msgcat::test k1] + } + } -result {0 1} + + test msgcat-9.1 {mcexists -namespace with no parameter} -body { + mcexists -namespace src + } -returnCodes 1\ + -result {Argument missing for switch "-namespace"} + # Tests msgcat-10.*: [mcloadedlocales] @@ -1080,26 +1102,29 @@ namespace eval ::msgcat::test { # - namespace defined, class defined oo, classless test msgcat-15.1 {mc in class} -setup { - namespace eval ::bar { + # full namespace is ::msgcat::test:bar + namespace eval bar { ::msgcat::mcset foo_BAR con2 con2bar oo::class create ClassCur oo::define ClassCur method method1 {} {::msgcat::mc con2} } - namespace eval ::baz { - set ObjCur [::bar::ClassCur new] + # full namespace is ::msgcat::test:baz + namespace eval baz { + set ObjCur [::msgcat::test::bar::ClassCur new] } variable locale [mclocale] mclocale foo_BAR } -cleanup { mclocale $locale - namespace eval ::bar {::msgcat::mcforgetpackage} - namespace delete ::bar ::baz + namespace eval bar {::msgcat::mcforgetpackage} + namespace delete bar baz } -body { - $::baz::ObjCur method1 + $baz::ObjCur method1 } -result con2bar test msgcat-15.2 {mc in classless object} -setup { - namespace eval ::bar { + # full namespace is ::msgcat::test:bar + namespace eval bar { ::msgcat::mcset foo_BAR con2 con2bar oo::object create ObjCur oo::objdefine ObjCur method method1 {} {::msgcat::mc con2} @@ -1108,42 +1133,85 @@ namespace eval ::msgcat::test { mclocale foo_BAR } -cleanup { mclocale $locale - namespace eval ::bar {::msgcat::mcforgetpackage} - namespace delete ::bar + namespace eval bar {::msgcat::mcforgetpackage} + namespace delete bar } -body { - ::bar::ObjCur method1 + bar::ObjCur method1 } -result con2bar + test msgcat-15.3 {mc in classless object with explicite namespace eval}\ + -setup { + # full namespace is ::msgcat::test:bar + namespace eval bar { + ::msgcat::mcset foo_BAR con2 con2bar + oo::object create ObjCur + oo::objdefine ObjCur method method1 {} { + namespace eval ::msgcat::test::baz { + ::msgcat::mc con2 + } + } + } + namespace eval baz { + ::msgcat::mcset foo_BAR con2 con2baz + } + variable locale [mclocale] + mclocale foo_BAR + } -cleanup { + mclocale $locale + namespace eval bar {::msgcat::mcforgetpackage} + namespace eval baz {::msgcat::mcforgetpackage} + namespace delete bar baz + } -body { + bar::ObjCur method1 + } -result con2baz + # Test msgcat-16.*: command mcpackagenamespaceget test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body { - namespace eval ::baz {msgcat::mcpackagenamespaceget} - } -result ::baz + namespace eval baz {msgcat::mcpackagenamespaceget} + } -result ::msgcat::test::baz test msgcat-16.2 {mcpackagenamespaceget in class} -setup { - namespace eval ::bar { + namespace eval bar { oo::class create ClassCur oo::define ClassCur method method1 {} {msgcat::mcpackagenamespaceget} } - namespace eval ::baz { - set ObjCur [::bar::ClassCur new] + namespace eval baz { + set ObjCur [::msgcat::test::bar::ClassCur new] } } -cleanup { - namespace delete ::bar ::baz + namespace delete bar baz } -body { - $::baz::ObjCur method1 - } -result ::bar + $baz::ObjCur method1 + } -result ::msgcat::test::bar test msgcat-16.3 {mcpackagenamespaceget in classless object} -setup { - namespace eval ::bar { + namespace eval bar { oo::object create ObjCur oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget} } } -cleanup { - namespace delete ::bar + namespace delete bar + } -body { + bar::ObjCur method1 + } -result ::msgcat::test::bar + + test msgcat-16.4\ + {mcpackagenamespaceget in classless object with explicite namespace eval}\ + -setup { + namespace eval bar { + oo::object create ObjCur + oo::objdefine ObjCur method method1 {} { + namespace eval ::msgcat::test::baz { + msgcat::mcpackagenamespaceget + } + } + } + } -cleanup { + namespace delete bar baz } -body { - ::bar::ObjCur method1 - } -result ::bar + bar::ObjCur method1 + } -result ::msgcat::test::baz # Test msgcat-17.*: mcn command -- cgit v0.12 From eaacc9bb568b4c69d6a5bda83a9f11d9f0f46a80 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sat, 13 Jan 2018 16:44:38 +0000 Subject: Changed msgcat version from 1.6.2 to 1.7.0 -> this is not a patch release --- changes | 2 +- library/msgcat/msgcat.tcl | 2 +- library/msgcat/pkgIndex.tcl | 2 +- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/changes b/changes index 51c0477..5b5a93e 100644 --- a/changes +++ b/changes @@ -8880,4 +8880,4 @@ in this changeset (new minor version) rather than bug fixes: --- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details -2017-12-11 (TIP 490) add oo support for msgcat => msgcat 1.6.2 (oehlmann) +2017-12-11 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index e57802b..4233005 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -14,7 +14,7 @@ package require Tcl 8.5- # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. -package provide msgcat 1.6.2 +package provide msgcat 1.7.0 namespace eval msgcat { namespace export mc mcn mcexists mcload mclocale mcmax\ diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index bc58cbe..fe3b3a1 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded msgcat 1.6.2 [list source [file join $dir msgcat.tcl]] +package ifneeded msgcat 1.7.0 [list source [file join $dir msgcat.tcl]] diff --git a/unix/Makefile.in b/unix/Makefile.in index a343864..a3c0e4c 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -855,8 +855,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; - @echo "Installing package msgcat 1.6.2 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.2.tm; + @echo "Installing package msgcat 1.7.0 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.7.0.tm; @echo "Installing package tcltest 2.4.1 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm; diff --git a/win/Makefile.in b/win/Makefile.in index f3e1bd6..a97f1a1 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -664,8 +664,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.6.2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.2.tm; + @echo "Installing package msgcat 1.7.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.7.0.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; -- cgit v0.12 From 87c12599bfbcd60c4b90780c1a7e653c95c2436c Mon Sep 17 00:00:00 2001 From: oehhar Date: Sat, 13 Jan 2018 17:14:22 +0000 Subject: Test numbering and naming corrected --- tests/msgcat.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/msgcat.test b/tests/msgcat.test index a99086d..a71ee3f 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -732,7 +732,7 @@ namespace eval ::msgcat::test { } } -result {0 1} - test msgcat-9.6 {mcexists -namespace - ns argument missing} -setup { + test msgcat-9.6 {mcexists -namespace ns parameter} -setup { mcforgetpackage variable locale [mclocale] mclocale foo_bar @@ -747,7 +747,7 @@ namespace eval ::msgcat::test { } } -result {0 1} - test msgcat-9.1 {mcexists -namespace with no parameter} -body { + test msgcat-9.7 {mcexists -namespace - ns argument missing} -body { mcexists -namespace src } -returnCodes 1\ -result {Argument missing for switch "-namespace"} -- cgit v0.12 From e841295386a779136b49e7ca3843a43279a8c185 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sat, 13 Jan 2018 17:17:39 +0000 Subject: Install msgcat 1.7 in library folder 8.6 instead 8.5. It uses tailcall and will not work with 8.5 --- unix/Makefile.in | 2 +- win/Makefile.in | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index a3c0e4c..baaab95 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -856,7 +856,7 @@ install-libraries: libraries $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; @echo "Installing package msgcat 1.7.0 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.7.0.tm; + @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/msgcat-1.7.0.tm; @echo "Installing package tcltest 2.4.1 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm; diff --git a/win/Makefile.in b/win/Makefile.in index a97f1a1..131f22b 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -665,7 +665,7 @@ install-libraries: libraries install-tzdata install-msgs $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.7.0.tm; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/msgcat-1.7.0.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; -- cgit v0.12 From e89d1e331e09f13b01ad0436d00bf199214d4d46 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 16 Jan 2018 14:13:14 +0000 Subject: Solve case where msgcat is called within a class definition script (works only for 8.7) --- library/msgcat/msgcat.tcl | 29 +++++++++++++++++---------- tests/msgcat.test | 50 ++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 60 insertions(+), 19 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 4233005..0b1079b 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -1151,17 +1151,26 @@ proc msgcat::ConvertLocale {value} { proc ::msgcat::PackageNamespaceGet {} { uplevel 2 { # Check for no object - # (undocumented test proposed by dkf 2018-01-12) - if { [namespace which self] ne "::oo::Helpers::self"} { - return [namespace current] - } - set Class [info object class [self]] - # Check for classless defined object - if {$Class eq {::oo::object}} { - return [namespace qualifiers [self]] + switch -exact -- [namespace which self] { + {::oo::define::self} { + # We are within a class definition + return [namespace qualifiers [self]] + } + {::oo::Helpers::self} { + # We are within an object + set Class [info object class [self]] + # Check for classless defined object + if {$Class eq {::oo::object}} { + return [namespace qualifiers [self]] + } + # Class defined object + return [namespace qualifiers $Class] + } + default { + # Not in object environment + return [namespace current] + } } - # Class defined object - return [namespace qualifiers $Class] } } diff --git a/tests/msgcat.test b/tests/msgcat.test index a71ee3f..7f872ed 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -1098,10 +1098,26 @@ namespace eval ::msgcat::test { # Tests msgcat-15.*: tcloo coverage - # There are 3 use-cases, where 2 must be tested now: - # - namespace defined, class defined oo, classless + # There are 4 use-cases, where 3 must be tested now: + # - namespace defined, in class definition, class defined oo, classless - test msgcat-15.1 {mc in class} -setup { + test msgcat-15.1 {mc in class setup} -setup { + # full namespace is ::msgcat::test:bar + namespace eval bar { + ::msgcat::mcset foo_BAR con2 con2bar + oo::class create ClassCur + } + variable locale [mclocale] + mclocale foo_BAR + } -cleanup { + mclocale $locale + namespace eval bar {::msgcat::mcforgetpackage} + namespace delete bar + } -body { + oo::define bar::ClassCur msgcat::mc con2 + } -result con2bar + + test msgcat-15.2 {mc in class} -setup { # full namespace is ::msgcat::test:bar namespace eval bar { ::msgcat::mcset foo_BAR con2 con2bar @@ -1122,7 +1138,7 @@ namespace eval ::msgcat::test { $baz::ObjCur method1 } -result con2bar - test msgcat-15.2 {mc in classless object} -setup { + test msgcat-15.3 {mc in classless object} -setup { # full namespace is ::msgcat::test:bar namespace eval bar { ::msgcat::mcset foo_BAR con2 con2bar @@ -1139,7 +1155,7 @@ namespace eval ::msgcat::test { bar::ObjCur method1 } -result con2bar - test msgcat-15.3 {mc in classless object with explicite namespace eval}\ + test msgcat-15.4 {mc in classless object with explicite namespace eval}\ -setup { # full namespace is ::msgcat::test:bar namespace eval bar { @@ -1171,7 +1187,18 @@ namespace eval ::msgcat::test { namespace eval baz {msgcat::mcpackagenamespaceget} } -result ::msgcat::test::baz - test msgcat-16.2 {mcpackagenamespaceget in class} -setup { + test msgcat-16.2 {mcpackagenamespaceget in class setup} -setup { + namespace eval bar { + oo::class create ClassCur + oo::define ClassCur variable a + } + } -cleanup { + namespace delete bar + } -body { + oo::define bar::ClassCur msgcat::mcpackagenamespaceget + } -result ::msgcat::test::bar + + test msgcat-16.3 {mcpackagenamespaceget in class} -setup { namespace eval bar { oo::class create ClassCur oo::define ClassCur method method1 {} {msgcat::mcpackagenamespaceget} @@ -1185,7 +1212,7 @@ namespace eval ::msgcat::test { $baz::ObjCur method1 } -result ::msgcat::test::bar - test msgcat-16.3 {mcpackagenamespaceget in classless object} -setup { + test msgcat-16.4 {mcpackagenamespaceget in classless object} -setup { namespace eval bar { oo::object create ObjCur oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget} @@ -1196,7 +1223,7 @@ namespace eval ::msgcat::test { bar::ObjCur method1 } -result ::msgcat::test::bar - test msgcat-16.4\ + test msgcat-16.5\ {mcpackagenamespaceget in classless object with explicite namespace eval}\ -setup { namespace eval bar { @@ -1216,7 +1243,12 @@ namespace eval ::msgcat::test { # Test msgcat-17.*: mcn command - test msgcat-17.1 {mcn} -setup { + test msgcat-17.1 {mcn no parameters} -body { + mcn + } -returnCodes 1\ + -result {wrong # args: should be "mcn ns src ?arg ...?"} + + test msgcat-17.2 {mcn} -setup { namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar} variable locale [mclocale] mclocale foo_BAR -- cgit v0.12 From 7c60d44ce6b8c71d89857ce711a3f7f62ce2de2c Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 16 Jan 2018 14:53:41 +0000 Subject: Comment updated --- library/msgcat/msgcat.tcl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 0b1079b..33ff5cb 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -1144,9 +1144,10 @@ proc msgcat::ConvertLocale {value} { } # helper function to find package namespace of stack-frame -2 -# There are 3 possibilities: +# There are 4 possibilities: # - called from a proc -# - called from a oo class +# - called within a class definition script +# - called from an class defined oo object # - called from a classless oo object proc ::msgcat::PackageNamespaceGet {} { uplevel 2 { -- cgit v0.12 From 3502aebe1064bb99245ba6117c80459cace5ac0c Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Tue, 16 Jan 2018 23:25:50 +0000 Subject: Tweaks to the tclZipfs.c file to allow the same C source to be used both in the core and as a static package for external shells (Via TEA) --- generic/tclZipfs.c | 112 +++++++++++++++++++++++++++++++++++------------------ 1 file changed, 75 insertions(+), 37 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 49f3b04..305fb7f 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -9,6 +9,10 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * This file is distributed in two ways: + * generic/tclZipfs.c file in the TIP430 enabled tcl cores + * compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430 projects */ #include "tclInt.h" @@ -34,13 +38,27 @@ #include "zlib.h" #include "crypt.h" +#ifdef CFG_RUNTIME_DLLFILE /* +** We are compiling as part of the core. ** TIP430 style zipfs prefix */ #define ZIPFS_VOLUME "//zipfs:/" #define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT "//zipfs:/app" #define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" +#else +/* +** We are compiling from the /compat folder of tclconfig +** Pre TIP430 style zipfs prefix +** //zipfs:/ doesn't work straight out of the box on either windows or Unix +** without other changes made to tip 430 +*/ +#define ZIPFS_VOLUME "zipfs:/" +#define ZIPFS_VOLUME_LEN 7 +#define ZIPFS_APP_MOUNT "zipfs:/app" +#define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" +#endif /* * Various constants and offsets found in ZIP archive files */ @@ -249,7 +267,7 @@ static const char pwrot[16] = { * Table to compute CRC32. */ -static const unsigned long crc32tab[256] = { +static const z_crc_t crc32tab[256] = { 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, @@ -307,6 +325,8 @@ static const unsigned long crc32tab[256] = { const char *zipfs_literal_tcl_library=NULL; /* Function prototypes */ +int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,const char *passwd); +static int TclZipfs_AppHook_FindTclInit(const char *archive); static int Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr); static Tcl_Obj *Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr); static Tcl_Obj *Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr); @@ -2667,6 +2687,60 @@ ZipFSListObjCmd( return TCL_OK; } + +Tcl_Obj *TclZipfs_TclLibrary(void) { + if(zipfs_literal_tcl_library) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } else { + Tcl_Obj *vfsinitscript; + int found=0; + + /* Look for the library file system within the executable */ + vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); + if(found==TCL_OK) { + zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library"; + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } +#if defined(_WIN32) || defined(_WIN64) + HMODULE hModule = TclWinGetTclInstance(); + WCHAR wName[MAX_PATH + LIBRARY_SIZE]; + char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, dllname, MAX_PATH); + } else { + ToUtf(wName, dllname); + } + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } +#else +#ifdef CFG_RUNTIME_DLLFILE + /* Mount zip file and dll before releasing to search */ + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } +#endif +#endif +#ifdef CFG_RUNTIME_ZIPFILE + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } + if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } +#endif + } + if(zipfs_literal_tcl_library) { + return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); + } + return NULL; +} + /* *------------------------------------------------------------------------- * @@ -4224,42 +4298,6 @@ int TclZipfs_AppHook(int *argc, char ***argv) return TCL_OK; } -Tcl_Obj *TclZipfs_TclLibrary(void) { - if(zipfs_literal_tcl_library) { - return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); - } else { -#if defined(_WIN32) || defined(_WIN64) - HMODULE hModule = TclWinGetTclInstance(); - WCHAR wName[MAX_PATH + LIBRARY_SIZE]; - char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; - - if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { - GetModuleFileNameA(hModule, dllname, MAX_PATH); - } else { - ToUtf(wName, dllname); - } - /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { - return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); - } -#else - /* Mount zip file and dll before releasing to search */ - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { - return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); - } -#endif - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { - return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); - } - if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { - return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); - } - } - if(zipfs_literal_tcl_library) { - return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); - } - return NULL; -} #ifndef HAVE_ZLIB -- cgit v0.12 From a866c42f19f6a9824006d8113367245c7df75b01 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 17 Jan 2018 01:09:07 +0000 Subject: Modifications to index zip file systems by mountpoint, and separate the process of mounting a zip archive from the process of indexing its contents. This work is progress towards being able to pass a data block to the zipfs system as a new file system to be mounted. --- doc/zipfs.3 | 6 +- doc/zipfs.n | 14 +-- generic/tclZipfs.c | 262 ++++++++++++++++++++++++++++------------------------- tests/zipfs.test | 9 +- 4 files changed, 155 insertions(+), 136 deletions(-) diff --git a/doc/zipfs.3 b/doc/zipfs.3 index b23afae..7514525 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -18,7 +18,7 @@ int \fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR) .sp int -\fBTclzipfs_Mount\fR(\fIinterp, zipname, mntpt, passwd\fR) +\fBTclzipfs_Mount\fR(\fIinterp, mntpt, zipname, passwd\fR) .sp int \fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR) @@ -55,12 +55,12 @@ or in the standard tcl install location. \fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR. Errors during that process are reported in the interpreter \fIinterp\fR. -If \fIzipname\fR is a NULL pointer, information on all currently mounted +If \fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP file systems is written into \fIinterp\fR's result as a sequence of mount points and ZIP file names. .PP \fBTclzipfs_Unmount()\fR undoes the effect of \fBTclzipfs_Mount()\fR, -i.e. it unmounts the mounted ZIP archive file \fIzipname\fR. Errors are +i.e. it unmounts the mounted ZIP file system at \fImountpoint\fR. Errors are reported in the interpreter \fIinterp\fR. .SH KEYWORDS compress, filesystem, zip diff --git a/doc/zipfs.n b/doc/zipfs.n index a026b6d..31a0707 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -23,9 +23,9 @@ zipfs \- Mount and work with ZIP files within Tcl \fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR \fBzipfs mkkey\fR \fIpassword\fR \fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR -\fBzipfs mount\fR \fI?zipfile?\fR \fI?mountpoint?\fR \fI?password?\fR +\fBzipfs mount\fR \fI?mountpoint?\fR \fI?zipfile?\fR \fI?password?\fR \fBzipfs root\fR -\fBzipfs unmount\fR \fIzipfile\fR +\fBzipfs unmount\fR \fImountpoint\fR .fi .BE .SH DESCRIPTION @@ -96,15 +96,15 @@ Caution: the choice of the \fIindir\fR parameter archive's content. .RE .TP -\fBzipfs mount ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR? +\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR? . The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS. After this command executes, files contained in \fIzipfile\fR will appear to Tcl to be regular files at the mount point. .RS .PP -With no \fImountpoint\fR, returns the mount point for \fIzipfile\fR. -With no \fIzipfile\fR, return all zipfile/mount pairs. +With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR. +With no \fImountpoint\fR, return all zipfile/mount pairs. If \fImountpoint\fR is specified as an empty string, mount on file path. .RE .TP @@ -113,9 +113,9 @@ Returns a constant string which indicates the mount point for zipfs volumes for the current platform. On Windows, this value is zipfs:/. On Unux, //zipfs:/ .RE .TP -\fBzipfs unmount \fIzipfile\fR +\fBzipfs unmount \fImountpoint\fR . -Unmounts a previously mounted ZIP archive file \fIzipfile\fR. +Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR. .SH "SEE ALSO" tclsh(1), file(n), zlib(n) .SH "KEYWORDS" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 305fb7f..5be25c3 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -186,8 +186,8 @@ typedef struct ZipFile { #if HAS_DRIVES int mntdrv; /* Drive letter of mount point */ #endif - int mntptlen; /* Length of mount point */ - char mntpt[1]; /* Mount point */ + char *mntpt; /* Mount point */ + size_t mntptlen; } ZipFile; /* @@ -325,7 +325,7 @@ static const z_crc_t crc32tab[256] = { const char *zipfs_literal_tcl_library=NULL; /* Function prototypes */ -int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,const char *passwd); +int TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); static int TclZipfs_AppHook_FindTclInit(const char *archive); static int Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr); static Tcl_Obj *Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr); @@ -942,7 +942,105 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) zf->chan = NULL; } } - + +/* + *------------------------------------------------------------------------- + * + * ZipFSIndexArchive -- + * + * This function takes a memory mapped zip file and indexes the contents. + * When "needZip" is zero an embedded ZIP archive in an executable file is accepted. + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. + * + * Side effects: + * The given ZipFile struct is filled with information about the ZIP archive file. + * + *------------------------------------------------------------------------- + */ +static int +ZipFSIndexArchive(Tcl_Interp *interp, int needZip, ZipFile *zf) +{ + int i; + unsigned char *p, *q; + p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; + while (p >= zf->data) { + if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { + if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { + break; + } + p -= ZIP_SIG_LEN; + } else { + --p; + } + } + if (p < zf->data) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"wrong end signature"); + goto error; + } + zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); + if (zf->nfiles == 0) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"empty archive"); + goto error; + } + q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); + p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); + if ( + (p < zf->data) || (p > (zf->data + zf->length)) || + (q < zf->data) || (q > (zf->data + zf->length)) + ) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"archive directory not found"); + goto error; + } + zf->baseoffs = zf->baseoffsp = p - q; + zf->centoffs = p - zf->data; + q = p; + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra; + + if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { + ZIPFS_ERROR(interp,"wrong header length"); + goto error; + } + if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { + ZIPFS_ERROR(interp,"wrong header signature"); + goto error; + } + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + q = zf->data + zf->baseoffs; + if ((zf->baseoffs >= 6) && (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { + i = q[-5]; + if (q - 5 - i > zf->data) { + zf->pwbuf[0] = i; + memcpy(zf->pwbuf + 1, q - 5 - i, i); + zf->baseoffsp -= i ? (5 + i) : 0; + } + } + return TCL_OK; + +error: + ZipFSCloseArchive(interp, zf); + return TCL_ERROR; +} + /* *------------------------------------------------------------------------- * @@ -967,12 +1065,10 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) */ static int -ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, - ZipFile *zf) +ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile *zf) { int i; ClientData handle; - unsigned char *p, *q; #if defined(_WIN32) || defined(_WIN64) zf->data = NULL; @@ -1051,82 +1147,14 @@ ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, } #endif } - p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; - while (p >= zf->data) { - if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { - if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { - break; - } - p -= ZIP_SIG_LEN; - } else { - --p; - } - } - if (p < zf->data) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - ZIPFS_ERROR(interp,"wrong end signature"); - goto error; - } - zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); - if (zf->nfiles == 0) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - ZIPFS_ERROR(interp,"empty archive"); - goto error; - } - q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); - p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); - if ( - (p < zf->data) || (p > (zf->data + zf->length)) || - (q < zf->data) || (q > (zf->data + zf->length)) - ) { - if (!needZip) { - zf->baseoffs = zf->baseoffsp = zf->length; - return TCL_OK; - } - ZIPFS_ERROR(interp,"archive directory not found"); - goto error; - } - zf->baseoffs = zf->baseoffsp = p - q; - zf->centoffs = p - zf->data; - q = p; - for (i = 0; i < zf->nfiles; i++) { - int pathlen, comlen, extra; - - if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { - ZIPFS_ERROR(interp,"wrong header length"); - goto error; - } - if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { - ZIPFS_ERROR(interp,"wrong header signature"); - goto error; - } - pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); - comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); - extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); - q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; - } - q = zf->data + zf->baseoffs; - if ((zf->baseoffs >= 6) && (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { - i = q[-5]; - if (q - 5 - i > zf->data) { - zf->pwbuf[0] = i; - memcpy(zf->pwbuf + 1, q - 5 - i, i); - zf->baseoffsp -= i ? (5 + i) : 0; - } - } - return TCL_OK; + return ZipFSIndexArchive(interp,needZip,zf); error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; } + static void TclZipfs_C_Init(void) { static const Tcl_Time t = { 0, 0 }; if (!ZipFS.initialized) { @@ -1166,8 +1194,9 @@ static void TclZipfs_C_Init(void) { int TclZipfs_Mount( - Tcl_Interp *interp, const char *zipname, + Tcl_Interp *interp, const char *mntpt, + const char *zipname, const char *passwd ) { char *realname, *p; @@ -1185,7 +1214,7 @@ TclZipfs_Mount( if (!ZipFS.initialized) { TclZipfs_C_Init(); } - if (zipname == NULL) { + if (mntpt == NULL) { Tcl_HashSearch search; int ret = TCL_OK; @@ -1207,36 +1236,26 @@ TclZipfs_Mount( Unlock(); return ret; } - if (mntpt == NULL) { + /* + * Mount point sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ + Tcl_DStringInit(&dsm); + mntpt = CanonicalPath("",mntpt, &dsm, 1); + + if (zipname == NULL) { if (interp == NULL) { Unlock(); return TCL_OK; } + Tcl_DStringInit(&ds); -#if HAS_DRIVES - p = AbsolutePath(zipname, &drive, &ds); -#else - p = AbsolutePath(zipname, &ds); -#endif - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, p); + + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); if (hPtr != NULL) { -#if HAS_DRIVES - if (drive == zf->mntdrv) { - Tcl_Obj *string; - char drvbuf[3]; - - drvbuf[0] = zf->mntdrv; - drvbuf[1] = ':'; - drvbuf[2] = '\0'; - string = Tcl_NewStringObj(drvbuf, 2); - Tcl_AppendToObj(string, zf->mntpt, zf->mntptlen); - Tcl_SetObjResult(interp, string); - } -#else if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { - Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); } -#endif } Unlock(); return TCL_OK; @@ -1262,20 +1281,13 @@ TclZipfs_Mount( #else realname = AbsolutePath(zipname, &ds); #endif - /* - * Mount point sometimes is a relative or otherwise denormalized path. - * But an absolute name is needed as mount point here. - */ - Tcl_DStringInit(&dsm); - mntpt = CanonicalPath("",mntpt, &dsm, 1); WriteLock(); - hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew); + hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mntpt, &isNew); if (!isNew) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (interp != NULL) { - Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ? - zf->mntpt : "/", "\"", (char *) NULL); + Tcl_AppendResult(interp, zf->name, " is already mounted on ", mntpt, (char *) NULL); } Unlock(); ZipFSCloseArchive(interp, &zf0); @@ -1294,9 +1306,9 @@ TclZipfs_Mount( return TCL_ERROR; } *zf = zf0; - zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); - strcpy(zf->mntpt, mntpt); - zf->mntptlen = strlen(zf->mntpt); + zf->mntpt = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + zf->mntptlen=strlen(zf->mntpt); + zf->name = strdup(zipname); zf->entries = NULL; zf->topents = NULL; zf->nopen = 0; @@ -1526,17 +1538,24 @@ nextent: */ int -TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) +TclZipfs_Unmount(Tcl_Interp *interp, const char *mntpt) { ZipFile *zf; ZipEntry *z, *znext; Tcl_HashEntry *hPtr; + Tcl_DString dsm; int ret = TCL_OK, unmounted = 0; WriteLock(); if (!ZipFS.initialized) goto done; - - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname); + /* + * Mount point sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ + Tcl_DStringInit(&dsm); + mntpt = CanonicalPath("", mntpt, &dsm, 1); + + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); /* don't report error */ if (hPtr == NULL) goto done; @@ -1560,6 +1579,7 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) Tcl_Free((char *) z); } ZipFSCloseArchive(interp, zf); + free(zf->name); //Allocated by strdup Tcl_Free((char *) zf); unmounted = 1; done: @@ -3906,7 +3926,7 @@ Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, *objPtrRef= Tcl_NewLongObj(z->offset); goto done; case 3: - *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1); + *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, z->zipfile->mntptlen); goto done; case 4: *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); @@ -4189,7 +4209,7 @@ static int TclZipfs_AppHook_FindTclInit(const char *archive){ if(zipfs_literal_tcl_library) { return TCL_ERROR; } - if(TclZipfs_Mount(NULL, archive, ZIPFS_ZIP_MOUNT, NULL)) { + if(TclZipfs_Mount(NULL, ZIPFS_ZIP_MOUNT, archive, NULL)) { /* Either the file doesn't exist or it is not a zip archive */ return TCL_ERROR; } @@ -4230,7 +4250,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) /* ** Look for init.tcl in one of the locations mounted later in this function */ - if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { + if(!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) { int found; Tcl_Obj *vfsinitscript; vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1); @@ -4272,7 +4292,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) } return TCL_OK; } else { - if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) { + if(!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) { int found; Tcl_Obj *vfsinitscript; vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1); @@ -4313,7 +4333,7 @@ int TclZipfs_AppHook(int *argc, char ***argv) */ int -TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, +TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd) { return TclZipfs_Init(interp, 1); diff --git a/tests/zipfs.test b/tests/zipfs.test index c9dd0ac..060e4a6 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -27,7 +27,6 @@ set CWD [pwd] set tmpdir [file join $CWD tmp] file mkdir $tmpdir - test zipfs-0.1 {zipfs basics} -constraints zipfs -body { package require zipfs } -result {2.0} @@ -45,7 +44,7 @@ if {![string match ${ziproot}* $tcl_library]} { ### set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]] if {[file exists $tclzip]} { - zipfs mount $tclzip /lib/tcl + zipfs mount /lib/tcl $tclzip set ::tcl_library ${ziproot}lib/tcl/tcl_library } else { tcltest::skip zipfs-0.* @@ -154,7 +153,7 @@ if {[file exists $zipfile]} { test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body { cd $tcl_library/encoding zipfs mkzip $zipfile . - zipfs mount $zipfile ${ziproot}abc + zipfs mount ${ziproot}abc $zipfile zipfs list -glob ${ziproot}abc/cp850.* } -cleanup { cd $CWD @@ -202,12 +201,12 @@ test zipfs-2.2.4 {zipfs exists} -constraints zipfs -body { } -result 1 test zipfs-2.2.5 {zipfs unmount while busy} -constraints zipfs -body { - zipfs unmount $zipfile + zipfs unmount /abc } -returnCodes error -result {filesystem is busy} test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body { close $zipfd - zipfs unmount $zipfile + zipfs unmount /abc zipfs exists /abc/cp850.enc } -result 0 -- cgit v0.12 From 1c58e29da28ad2a5a2307da0d8384bedc8891040 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 12:56:22 +0000 Subject: Remove Tcl_CaseObjCmd from tclInt.h as well (was missing in previous commit) --- generic/tclCmdMZ.c | 1 + generic/tclInt.h | 5 ----- generic/tclIntPlatDecls.h | 1 - 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 1fc2d17..a206cc5 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2893,6 +2893,7 @@ StringCatCmd( * *---------------------------------------------------------------------- */ + static int StringBytesCmd( ClientData dummy, /* Not used. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index e9b9936..eadcb8e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3221,11 +3221,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -#endif MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 437ed24..99d6753 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -504,7 +504,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */ #define TclWinConvertWSAError TclWinConvertError #if !defined(_WIN32) -- cgit v0.12 From d695e02d2fd744a4391dcf3c4a8a20e499cc47b1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 14:17:21 +0000 Subject: Remove obsolete documentation (belonging to now-removed functions). Remove obsolete 8.4 bytecodes. And a few other (internal) macro's which are no longer in use. --- doc/Backslash.3 | 47 --------------- doc/CrtMathFnc.3 | 162 -------------------------------------------------- doc/DString.3 | 6 -- doc/Encoding.3 | 19 +----- doc/ParseCmd.3 | 24 ++------ doc/case.n | 60 ------------------- doc/mathfunc.n | 5 +- generic/tcl.decls | 7 +-- generic/tcl.h | 64 +------------------- generic/tclBasic.c | 12 ---- generic/tclCompile.h | 2 - generic/tclDecls.h | 14 ++--- generic/tclEvent.c | 6 +- generic/tclExecute.c | 143 -------------------------------------------- generic/tclIndexObj.c | 10 ---- generic/tclInt.h | 13 ---- generic/tclPanic.c | 4 +- generic/tclProc.c | 4 -- tests/execute.test | 4 -- tools/genStubs.tcl | 2 - 20 files changed, 24 insertions(+), 584 deletions(-) delete mode 100644 doc/Backslash.3 delete mode 100644 doc/CrtMathFnc.3 delete mode 100644 doc/case.n diff --git a/doc/Backslash.3 b/doc/Backslash.3 deleted file mode 100644 index 0805f8e..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -1,47 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_Backslash \- parse a backslash sequence -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -char -\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) -.SH ARGUMENTS -.AS char *countPtr out -.AP char *src in -Pointer to a string starting with a backslash. -.AP int *countPtr out -If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled -in with number of characters in the backslash sequence, including -the backslash character. -.BE - -.SH DESCRIPTION -.PP -The use of \fBTcl_Backslash\fR is deprecated in favor of -\fBTcl_UtfBackslash\fR. -.PP -This is a utility procedure provided for backwards compatibility with -non-internationalized Tcl extensions. It parses a backslash sequence and -returns the low byte of the Unicode character corresponding to the sequence. -\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of -characters in the backslash sequence. -.PP -See the Tcl manual entry for information on the valid backslash sequences. -All of the sequences described in the Tcl manual entry are supported by -\fBTcl_Backslash\fR. -.SH "SEE ALSO" -Tcl(n), Tcl_UtfBackslash(3) - -.SH KEYWORDS -backslash, parse diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 deleted file mode 100644 index acceb5b..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -1,162 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions -.SH "NOTICE OF EVENTUAL DEPRECATION" -.PP -The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions -are rendered somewhat obsolete by the ability to create functions for -expressions by placing commands in the \fBtcl::mathfunc\fR namespace, -as described in the \fBmathfunc\fR manual page; the API described on -this page is not expected to be maintained indefinitely. -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -void -\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) -.sp -int -\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, - clientDataPtr\fR) -.sp -Tcl_Obj * -\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) -.SH ARGUMENTS -.AS Tcl_ValueType *clientDataPtr out -.AP Tcl_Interp *interp in -Interpreter in which new function will be defined. -.AP "const char" *name in -Name for new function. -.AP int numArgs in -Number of arguments to new function; also gives size of \fIargTypes\fR array. -.AP Tcl_ValueType *argTypes in -Points to an array giving the permissible types for each argument to -function. -.AP Tcl_MathProc *proc in -Procedure that implements the function. -.AP ClientData clientData in -Arbitrary one-word value to pass to \fIproc\fR when it is invoked. -.AP int *numArgsPtr out -Points to a variable that will be set to contain the number of -arguments to the function. -.AP Tcl_ValueType **argTypesPtr out -Points to a variable that will be set to contain a pointer to an array -giving the permissible types for each argument to the function which -will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc **procPtr out -Points to a variable that will be set to contain a pointer to the -implementation code for the function (or NULL if the function is -implemented directly in bytecode). -.AP ClientData *clientDataPtr out -Points to a variable that will be set to contain the clientData -argument passed to \fITcl_CreateMathFunc\fR when the function was -created if the function is not implemented directly in bytecode. -.AP "const char" *pattern in -Pattern to match against function names so as to filter them (by -passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. -.BE -.SH DESCRIPTION -.PP -Tcl allows a number of mathematical functions to be used in -expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. -These functions are represented by commands in the namespace, -\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is -an obsolete way for applications to add additional functions -to those already provided by Tcl or to replace existing functions. -It should not be used by new applications, which should create -math functions using \fBTcl_CreateObjCommand\fR to create a command -in the \fBtcl::mathfunc\fR namespace. -.PP -In the \fBTcl_CreateMathFunc\fR interface, -\fIName\fR is the name of the function as it will appear in expressions. -If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR -namespace, then a new command is created in that namespace. -If \fIname\fR does exist, then the existing function is replaced. -\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. -Each entry in the \fIargTypes\fR array must be -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, -or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an -integer, a double-precision floating value, a wide (64-bit) integer, -or any, respectively. -.PP -Whenever the function is invoked in an expression Tcl will invoke -\fIproc\fR. \fIProc\fR should have arguments and result that match -the type \fBTcl_MathProc\fR: -.PP -.CS -typedef int \fBTcl_MathProc\fR( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tcl_Value *\fIargs\fR, - Tcl_Value *\fIresultPtr\fR); -.CE -.PP -When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR -arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. -\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, -which describe the actual arguments to the function: -.PP -.CS -typedef struct Tcl_Value { - Tcl_ValueType \fItype\fR; - long \fIintValue\fR; - double \fIdoubleValue\fR; - Tcl_WideInt \fIwideValue\fR; -} \fBTcl_Value\fR; -.CE -.PP -The \fItype\fR field indicates the type of the argument and is -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. -It will match the \fIargTypes\fR value specified for the function unless -the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts -the argument supplied in the expression to the type requested in -\fIargTypes\fR, if that is necessary. -Depending on the value of the \fItype\fR field, the \fIintValue\fR, -\fIdoubleValue\fR or \fIwideValue\fR -field will contain the actual value of the argument. -.PP -\fIProc\fR should compute its result and store it either as an integer -in \fIresultPtr->intValue\fR or as a floating value in -\fIresultPtr->doubleValue\fR. -It should set also \fIresultPtr->type\fR to one of -\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR -to indicate which value was set. -Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. -If an error occurs while executing the function, \fIproc\fR should -return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. -.PP -\fBTcl_GetMathFuncInfo\fR retrieves the values associated with -function \fIname\fR that were passed to a preceding -\fBTcl_CreateMathFunc\fR call. Normally, the return code is -\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR -is returned and an error message is placed in the interpreter's -result. -.PP -If an error did not occur, the array reference placed in the variable -pointed to by \fIargTypesPtr\fR is newly allocated, and should be -released by passing it to \fBTcl_Free\fR. Some functions (the -standard set implemented in the core, and those defined by placing -commands in the \fBtcl::mathfunc\fR namespace) do not have -argument type information; attempting to retrieve values for -them causes a NULL to be stored in the variable pointed to by -\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR -will not be modified. The variable pointed to by \fInumArgsPointer\fR -will contain -1, and no argument types will be stored in the variable -pointed to by \fIargTypesPointer\fR. -.PP -\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all -the math functions defined in the interpreter whose name matches -\fIpattern\fR. The returned value has a reference count of zero. -.SH "SEE ALSO" -expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) -.SH KEYWORDS -expression, mathematical function diff --git a/doc/DString.3 b/doc/DString.3 index 00f1b8a..2828278 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -34,8 +34,6 @@ char * .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp -\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR) -.sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) @@ -128,10 +126,6 @@ caller to fill in the new space. even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP -\fBTcl_DStringTrunc\fR changes the length of a dynamic string. -This procedure is now deprecated. \fBTcl_DStringSetLength\fR should -be used instead. -.PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 79fca0f..40eb614 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings +Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include \fR @@ -62,12 +62,6 @@ Tcl_Obj * .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) -.sp -const char * -\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR) -.sp -void -\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR) .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in @@ -287,7 +281,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned. \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by -\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the +\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP @@ -402,15 +396,6 @@ are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. -.PP -\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR -are obsolete interfaces best replaced with calls to -\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR. -They are called to access and set the first element of the \fIsearchPath\fR -list. Since Tcl searches \fIsearchPath\fR for encoding data files in -list order, these routines establish the -.QW default -directory in which to find encoding data files. .SH "ENCODING FILES" Space would prohibit precompiling into Tcl every possible encoding algorithm, so many encodings are stored on disk as dynamically-loadable diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 667d697..01b4065 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include \fR @@ -33,20 +33,16 @@ const char * .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp -Tcl_Obj * -\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) -.sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR -and \fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR and +\fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, -determines the context for evaluating the -script and also is used for error reporting; must not be NULL. +For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating +the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in @@ -191,16 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. -.PP -\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in -the return convention used: it returns the result in a new Tcl_Obj. -The reference count of the value returned as result has been -incremented, so the caller must -invoke \fBTcl_DecrRefCount\fR when it is finished with the value. -If an error or other exception occurs while evaluating the tokens -(such as a reference to a non-existent variable) then the return value -is NULL and an error message is left in \fIinterp\fR's result. The use -of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index c48d634..0000000 --- a/doc/case.n +++ /dev/null @@ -1,60 +0,0 @@ -'\" -'\" Copyright (c) 1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH case n 7.0 Tcl "Tcl Built-In Commands" -.so man.macros -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -case \- Evaluate one of several scripts, depending on a given value -.SH SYNOPSIS -\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...? -.sp -\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?} -.BE - -.SH DESCRIPTION -.PP -\fINote: the \fBcase\fI command is obsolete and is supported only -for backward compatibility. At some point in the future it may be -removed entirely. You should use the \fBswitch\fI command instead.\fR -.PP -The \fBcase\fR command matches \fIstring\fR against each of -the \fIpatList\fR arguments in order. -Each \fIpatList\fR argument is a list of one or -more patterns. If any of these patterns matches \fIstring\fR then -\fBcase\fR evaluates the following \fIbody\fR argument -by passing it recursively to the Tcl interpreter and returns the result -of that evaluation. -Each \fIpatList\fR argument consists of a single -pattern or list of patterns. Each pattern may contain any of the wild-cards -described under \fBstring match\fR. If a \fIpatList\fR -argument is \fBdefault\fR, the corresponding body will be evaluated -if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument -matches \fIstring\fR and no default is given, then the \fBcase\fR -command returns an empty string. -.PP -Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments. -The first uses a separate argument for each of the patterns and commands; -this form is convenient if substitutions are desired on some of the -patterns or commands. -The second form places all of the patterns and commands together into -a single argument; the argument must have proper list structure, with -the elements of the list being the patterns and commands. -The second form makes it easy to construct multi-line case commands, -since the braces around the whole list make it unnecessary to include a -backslash at the end of each line. -Since the \fIpatList\fR arguments are in braces in the second form, -no command or variable substitutions are performed on them; this makes -the behavior of the second form different than the first form in some -cases. - -.SH "SEE ALSO" -switch(n) - -.SH KEYWORDS -case, match, regular expression diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 7233d46..ca091c1 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -106,10 +106,7 @@ of which work solely with floating-point numbers unless otherwise noted: In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define -new commands in the \fBtcl::mathfunc\fR namespace. In addition, an -obsolete interface named \fBTcl_CreateMathFunc\fR() is available to -extensions that are written in C. The latter interface is not recommended -for new implementations. +new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR diff --git a/generic/tcl.decls b/generic/tcl.decls index 5a261cb..c1930f6 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -818,7 +818,7 @@ declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } declare 230 { - void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) + void Tcl_SetPanicProc(TCL_NORETURN Tcl_PanicProc *panicProc) } declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) @@ -1887,7 +1887,7 @@ declare 518 { # TIP#121 (exit handler) dkf for Joe Mistachkin declare 519 { - Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) + Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN Tcl_ExitProc *proc) } # TIP#143 (resource limits) dkf @@ -2394,9 +2394,6 @@ declare 1 macosx { # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } diff --git a/generic/tcl.h b/generic/tcl.h index 3724083..8eb8f49 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -74,7 +74,7 @@ extern "C" { # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif -#endif /* !RC_INVOKED */ +#endif /* RC_INVOKED */ /* * A special definition used to allow this header file to be included from @@ -114,11 +114,6 @@ extern "C" { # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) -# if defined(BUILD_tcl) || defined(BUILD_tk) -# define TCL_NORETURN1 __attribute__ ((noreturn)) -# else -# define TCL_NORETURN1 /* nothing */ -# endif #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) @@ -128,7 +123,6 @@ extern "C" { # define TCL_NORETURN /* nothing */ # define TCL_NOINLINE /* nothing */ # endif -# define TCL_NORETURN1 /* nothing */ #endif /* @@ -233,46 +227,10 @@ extern "C" { #endif /* - *---------------------------------------------------------------------------- - * The following code is copied from winnt.h. If we don't replicate it here, - * then can't be included after tcl.h, since tcl.h also defines - * VOID. This block is skipped under Cygwin and Mingw. - */ - -#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) -#ifndef VOID -#define VOID void -typedef char CHAR; -typedef short SHORT; -typedef long LONG; -#endif -#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ - -/* - * Macro to use instead of "void" for arguments that must have type "void *" - * in ANSI C; maps them to type "char *" in non-ANSI systems. - */ - -#ifndef __VXWORKS__ -# ifndef NO_VOID -# define VOID void -# else -# define VOID char -# endif -#endif - -/* * Miscellaneous declarations. */ -#ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif -# define _CLIENTDATA -#endif +typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where @@ -573,22 +531,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_SUBST_ALL 007 /* - * Argument descriptors for math function callbacks in expressions: - */ - -typedef enum { - TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT -} Tcl_ValueType; - -typedef struct Tcl_Value { - Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, - * or both. */ - long intValue; /* Integer value. */ - double doubleValue; /* Double-precision floating value. */ - Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ -} Tcl_Value; - -/* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ @@ -633,8 +575,6 @@ typedef void (Tcl_FreeProc) (char *blockPtr); typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); -typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, - Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 841dd1f..463e455 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -38,18 +38,6 @@ #endif /* - * The following structure defines the client data for a math function - * registered with Tcl_CreateMathFunc - */ - -typedef struct OldMathFuncData { - Tcl_MathProc *proc; /* Handler function */ - int numArgs; /* Number of args expected */ - Tcl_ValueType *argTypes; /* Types of the args */ - ClientData clientData; /* Client data for the handler function */ -} OldMathFuncData; - -/* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler diff --git a/generic/tclCompile.h b/generic/tclCompile.h index fcf6d91..2b752ff 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -594,8 +594,6 @@ typedef struct ByteCode { #define INST_UMINUS 59 #define INST_BITNOT 60 #define INST_LNOT 61 -#define INST_CALL_BUILTIN_FUNC1 62 -#define INST_CALL_FUNC1 63 #define INST_TRY_CVT_TO_NUMERIC 64 /* Opcodes 65 to 66 */ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3a0db04..ba335ef 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -684,7 +684,7 @@ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ EXTERN void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *panicProc); + TCL_NORETURN Tcl_PanicProc *panicProc); /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); /* 232 */ @@ -1469,7 +1469,7 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 519 */ -EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); +EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN Tcl_ExitProc *proc); /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, @@ -1804,7 +1804,7 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ - TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ + TCL_NORETURN void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ char * (*tcl_Alloc) (unsigned int size); /* 3 */ void (*tcl_Free) (char *ptr); /* 4 */ char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ @@ -1951,7 +1951,7 @@ typedef struct TclStubs { int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ void (*reserved131)(void); void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ - TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ + TCL_NORETURN void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */ int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */ @@ -2056,7 +2056,7 @@ typedef struct TclStubs { void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ - void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ + void (*tcl_SetPanicProc) (TCL_NORETURN Tcl_PanicProc *panicProc); /* 230 */ int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ int (*tcl_SetServiceMode) (int mode); /* 233 */ @@ -2120,7 +2120,7 @@ typedef struct TclStubs { int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ - TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */ + TCL_NORETURN void (*tcl_ExitThread) (int status); /* 294 */ int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ @@ -2345,7 +2345,7 @@ typedef struct TclStubs { Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ - Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ + Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN Tcl_ExitProc *proc); /* 519 */ void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 93cf983..f806516 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -89,7 +89,7 @@ static int subsystemsInitialized = 0; * non-NULL value. */ -static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL; +static TCL_NORETURN Tcl_ExitProc *appExitPtr = NULL; typedef struct ThreadSpecificData { ExitHandler *firstExitPtr; /* First in list of all exit handlers for this @@ -857,7 +857,7 @@ Tcl_DeleteThreadExitHandler( Tcl_ExitProc * Tcl_SetExitProc( - TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */ + TCL_NORETURN Tcl_ExitProc *proc) /* New exit handler for app or NULL */ { Tcl_ExitProc *prevExitProc; @@ -938,7 +938,7 @@ Tcl_Exit( int status) /* Exit status for application; typically 0 * for normal return, 1 for error return. */ { - TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr; + TCL_NORETURN Tcl_ExitProc *currentAppExitPtr; Tcl_MutexLock(&exitMutex); currentAppExitPtr = appExitPtr; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 935e864..42da922 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -101,64 +101,6 @@ long tclObjsAlloced = 0; long tclObjsFreed = 0; long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ - -/* - * Support pre-8.5 bytecodes unless specifically requested otherwise. - */ - -#ifndef TCL_SUPPORT_84_BYTECODE -#define TCL_SUPPORT_84_BYTECODE 1 -#endif - -#if TCL_SUPPORT_84_BYTECODE -/* - * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 - * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. - */ - -typedef struct { - const char *name; /* Name of function. */ - int numArgs; /* Number of arguments for function. */ -} BuiltinFunc; - -/* - * Table describing the built-in math functions. Entries in this table are - * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's - * operand byte. - */ - -static BuiltinFunc const tclBuiltinFuncTable[] = { - {"acos", 1}, - {"asin", 1}, - {"atan", 1}, - {"atan2", 2}, - {"ceil", 1}, - {"cos", 1}, - {"cosh", 1}, - {"exp", 1}, - {"floor", 1}, - {"fmod", 2}, - {"hypot", 2}, - {"log", 1}, - {"log10", 1}, - {"pow", 2}, - {"sin", 1}, - {"sinh", 1}, - {"sqrt", 1}, - {"tan", 1}, - {"tanh", 1}, - {"abs", 1}, - {"double", 1}, - {"int", 1}, - {"rand", 0}, - {"round", 1}, - {"srand", 1}, - {"wide", 1}, - {NULL, 0}, -}; - -#define LAST_BUILTIN_FUNC 25 -#endif /* * NR_TEBC @@ -2900,91 +2842,6 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else - /* - * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. - */ - - case INST_CALL_BUILTIN_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); - case INST_CALL_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); -#endif - case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index eeed0e5..ce6ab68 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -891,18 +891,8 @@ Tcl_WrongNumArgs( * future... */ -#ifndef AVOID_HACKS_FOR_ITCL - int isFirst = 1; /* Special flag used to inhibit the treating - * of the first word as a list element so the - * hacky way Itcl generates error messages for - * its ensembles will still work. [Bug - * 1066837] */ -# define MAY_QUOTE_WORD (!isFirst) -# define AFTER_FIRST_WORD (isFirst = 0) -#else /* !AVOID_HACKS_FOR_ITCL */ # define MAY_QUOTE_WORD 1 # define AFTER_FIRST_WORD (void) 0 -#endif /* AVOID_HACKS_FOR_ITCL */ TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { diff --git a/generic/tclInt.h b/generic/tclInt.h index eadcb8e..fe7b93d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -26,19 +26,6 @@ #undef ACCEPT_NAN /* - * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3. - * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them - * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+ - * releases. Perhaps Tcl 8.7 will add even better public interfaces - * supporting all the re-invocation mechanisms extensions like Itcl 3 - * need. As an absolute last resort, folks who must make Itcl 3 work - * unchanged with Tcl 8.7 can remove this line to regain the migration - * support. Tcl 9 will no longer offer even that option. - */ - -#define AVOID_HACKS_FOR_ITCL 1 - -/* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 78ccf7c..c9ccf8a 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -26,7 +26,7 @@ #if defined(__CYGWIN__) static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic; #else -static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; +static TCL_NORETURN Tcl_PanicProc *panicProc = NULL; #endif /* @@ -47,7 +47,7 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *proc) + TCL_NORETURN Tcl_PanicProc *proc) { #if defined(_WIN32) /* tclWinDebugPanic only installs if there is no panicProc yet. */ diff --git a/generic/tclProc.c b/generic/tclProc.c index 70dc4dc..f5b3a64 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1051,11 +1051,7 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { -#ifdef AVOID_HACKS_FOR_ITCL - desiredObjs[0] = framePtr->objv[skip-1]; -#else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); -#endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); diff --git a/tests/execute.test b/tests/execute.test index 7bd2601..91a7de2 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -459,10 +459,6 @@ test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { list [catch {expr {! $x}} msg] $msg } {1 {can't use non-numeric string "foo" as operand of "!"}} -# INST_BITNOT not tested -# INST_CALL_BUILTIN_FUNC1 not tested -# INST_CALL_FUNC1 not tested - # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { set x [testintobj set 1 1] diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 830ba2b..a345437 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -600,8 +600,6 @@ proc genStubs::makeSlot {name decl index} { } if {[string range $rtype end-8 end] eq "__stdcall"} { append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " - } elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} { - append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") " } else { append text $rtype " (*" $lfname ") " } -- cgit v0.12 From 608373fcb170fe76512b46c7ce07cc0691720ae5 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 17 Jan 2018 15:56:32 +0000 Subject: Modifications to allow the mounting of zip file systems from data blocks Added a new stubs entry to mount a data block as a zip file system --- generic/tcl.decls | 15 +- generic/tclDecls.h | 14 +- generic/tclStubInit.c | 1 + generic/tclZipfs.c | 493 +++++++++++++++++++++++++++++++++++++------------- tests/zipfs.test | 73 +++++++- 5 files changed, 458 insertions(+), 138 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 87beab3..8d03db1 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2334,8 +2334,11 @@ declare 631 { # TIP #430 declare 632 { - int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt, - const char *passwd) + int TclZipfs_Mount( + Tcl_Interp *interp, + const char *mntpt, + const char *zipname, + const char *passwd) } declare 633 { int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) @@ -2343,6 +2346,14 @@ declare 633 { declare 634 { Tcl_Obj *TclZipfs_TclLibrary(void) } +declare 635 { + int TclZipfs_Mount_Buffer( + Tcl_Interp *interp, + const char *mntpt, + unsigned char *data, + size_t datalen, + int copy) +} ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8ba9e5c..40fa7e2 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1839,14 +1839,17 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 632 */ -EXTERN int TclZipfs_Mount(Tcl_Interp *interp, - const char *zipname, const char *mntpt, - const char *passwd); +EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, + const char *zipname, const char *passwd); /* 633 */ EXTERN int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname); /* 634 */ EXTERN Tcl_Obj * TclZipfs_TclLibrary(void); +/* 635 */ +EXTERN int TclZipfs_Mount_Buffer(Tcl_Interp *interp, + const char *mntpt, unsigned char *data, + size_t datalen, int copy); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2514,9 +2517,10 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ - int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *zipname, const char *mntpt, const char *passwd); /* 632 */ + int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */ Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */ + int (*tclZipfs_Mount_Buffer) (Tcl_Interp *interp, const char *mntpt, unsigned char *data, size_t datalen, int copy); /* 635 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3817,6 +3821,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclZipfs_Unmount) /* 633 */ #define TclZipfs_TclLibrary \ (tclStubsPtr->tclZipfs_TclLibrary) /* 634 */ +#define TclZipfs_Mount_Buffer \ + (tclStubsPtr->tclZipfs_Mount_Buffer) /* 635 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index fdc8aec..28d26a6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1616,6 +1616,7 @@ const TclStubs tclStubs = { TclZipfs_Mount, /* 632 */ TclZipfs_Unmount, /* 633 */ TclZipfs_TclLibrary, /* 634 */ + TclZipfs_Mount_Buffer, /* 635 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 5be25c3..b81c58f 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -168,6 +168,8 @@ TCL_DECLARE_MUTEX(localtimeMutex) typedef struct ZipFile { char *name; /* Archive name */ + size_t namelen; + char is_membuf; /* When true, not a file but a memory buffer */ Tcl_Channel chan; /* Channel handle or NULL */ unsigned char *data; /* Memory mapped or malloc'ed file */ long length; /* Length of memory mapped file */ @@ -186,8 +188,8 @@ typedef struct ZipFile { #if HAS_DRIVES int mntdrv; /* Drive letter of mount point */ #endif - char *mntpt; /* Mount point */ - size_t mntptlen; + int mntptlen; + char *mntpt; /* Mount point */ } ZipFile; /* @@ -325,7 +327,19 @@ static const z_crc_t crc32tab[256] = { const char *zipfs_literal_tcl_library=NULL; /* Function prototypes */ -int TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); +int TclZipfs_Mount( + Tcl_Interp *interp, + const char *mntpt, + const char *zipname, + const char *passwd +); +int TclZipfs_Mount_Buffer( + Tcl_Interp *interp, + const char *mntpt, + unsigned char *data, + size_t datalen, + int copy +); static int TclZipfs_AppHook_FindTclInit(const char *archive); static int Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr); static Tcl_Obj *Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr); @@ -919,6 +933,18 @@ ZipFSLookupMount(char *filename) static void ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) { + if(zf->namelen) { + free(zf->name); //Allocated by strdup + } + if(zf->is_membuf==1) { + /* Pointer to memory */ + if (zf->tofree != NULL) { + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; + } + zf->data = NULL; + return; + } #if defined(_WIN32) || defined(_WIN64) if ((zf->data != NULL) && (zf->tofree == NULL)) { UnmapViewOfFile(zf->data); @@ -946,7 +972,7 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) /* *------------------------------------------------------------------------- * - * ZipFSIndexArchive -- + * ZipFS_Find_TOC -- * * This function takes a memory mapped zip file and indexes the contents. * When "needZip" is zero an embedded ZIP archive in an executable file is accepted. @@ -961,7 +987,7 @@ ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) *------------------------------------------------------------------------- */ static int -ZipFSIndexArchive(Tcl_Interp *interp, int needZip, ZipFile *zf) +ZipFS_Find_TOC(Tcl_Interp *interp, int needZip, ZipFile *zf) { int i; unsigned char *p, *q; @@ -1034,6 +1060,7 @@ ZipFSIndexArchive(Tcl_Interp *interp, int needZip, ZipFile *zf) zf->baseoffsp -= i ? (5 + i) : 0; } } + return TCL_OK; error: @@ -1069,7 +1096,8 @@ ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile * { int i; ClientData handle; - + + zf->is_membuf=0; #if defined(_WIN32) || defined(_WIN64) zf->data = NULL; zf->mh = INVALID_HANDLE_VALUE; @@ -1147,61 +1175,33 @@ ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile * } #endif } - return ZipFSIndexArchive(interp,needZip,zf); + return ZipFS_Find_TOC(interp,needZip,zf); error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; } - -static void TclZipfs_C_Init(void) { - static const Tcl_Time t = { 0, 0 }; - if (!ZipFS.initialized) { -#ifdef TCL_THREADS - /* - * Inflate condition variable. - */ - Tcl_MutexLock(&ZipFSMutex); - Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); - Tcl_MutexUnlock(&ZipFSMutex); -#endif - Tcl_FSRegister(NULL, &zipfsFilesystem); - Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); - ZipFS.initialized = ZipFS.idCount = 1; - } -} - - /* *------------------------------------------------------------------------- * - * TclZipfs_Mount -- + * ZipFSRootNode -- * - * This procedure is invoked to mount a given ZIP archive file on - * a given mountpoint with optional ZIP password. + * This function generates the root node for a ZIPFS filesystem * * Results: - * A standard Tcl result. + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. * * Side effects: - * A ZIP archive file is read, analyzed and mounted, resources are - * allocated. - * *------------------------------------------------------------------------- */ -int -TclZipfs_Mount( - Tcl_Interp *interp, - const char *mntpt, - const char *zipname, - const char *passwd -) { - char *realname, *p; +static int +ZipFS_Catalogue_Filesystem(Tcl_Interp *interp, ZipFile *zf0, const char *mntpt, const char *passwd, const char *zipname) +{ int i, pwlen, isNew; - ZipFile *zf, zf0; + ZipFile *zf; ZipEntry *z; Tcl_HashEntry *hPtr; Tcl_DString ds, dsm, fpBuf; @@ -1209,58 +1209,8 @@ TclZipfs_Mount( #if HAS_DRIVES int drive = 0; #endif - - ReadLock(); - if (!ZipFS.initialized) { - TclZipfs_C_Init(); - } - if (mntpt == NULL) { - Tcl_HashSearch search; - int ret = TCL_OK; - - i = 0; - hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); - while (hPtr != NULL) { - if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { - if (interp != NULL) { - Tcl_AppendElement(interp, zf->mntpt); - Tcl_AppendElement(interp, zf->name); - } - ++i; - } - hPtr = Tcl_NextHashEntry(&search); - } - if (interp == NULL) { - ret = (i > 0) ? TCL_OK : TCL_BREAK; - } - Unlock(); - return ret; - } - /* - * Mount point sometimes is a relative or otherwise denormalized path. - * But an absolute name is needed as mount point here. - */ - Tcl_DStringInit(&dsm); - mntpt = CanonicalPath("",mntpt, &dsm, 1); + WriteLock(); - if (zipname == NULL) { - if (interp == NULL) { - Unlock(); - return TCL_OK; - } - - Tcl_DStringInit(&ds); - - hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); - if (hPtr != NULL) { - if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { - Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); - } - } - Unlock(); - return TCL_OK; - } - Unlock(); pwlen = 0; if (passwd != NULL) { pwlen = strlen(passwd); @@ -1272,17 +1222,17 @@ TclZipfs_Mount( return TCL_ERROR; } } - if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) { - return TCL_ERROR; - } + /* + * Mount point sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ Tcl_DStringInit(&ds); -#if HAS_DRIVES - realname = AbsolutePath(zipname, NULL, &ds); -#else - realname = AbsolutePath(zipname, &ds); -#endif - - WriteLock(); + Tcl_DStringInit(&dsm); + if (strcmp(mntpt, "/") == 0) { + mntpt = ""; + } else { + mntpt = CanonicalPath("",mntpt, &dsm, 1); + } hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mntpt, &isNew); if (!isNew) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); @@ -1290,30 +1240,29 @@ TclZipfs_Mount( Tcl_AppendResult(interp, zf->name, " is already mounted on ", mntpt, (char *) NULL); } Unlock(); - ZipFSCloseArchive(interp, &zf0); + ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } - if (strcmp(mntpt, "/") == 0) { - mntpt = ""; - } zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); if (zf == NULL) { if (interp != NULL) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); } Unlock(); - ZipFSCloseArchive(interp, &zf0); + ZipFSCloseArchive(interp, zf0); return TCL_ERROR; - } - *zf = zf0; - zf->mntpt = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); - zf->mntptlen=strlen(zf->mntpt); - zf->name = strdup(zipname); - zf->entries = NULL; - zf->topents = NULL; - zf->nopen = 0; - Tcl_SetHashValue(hPtr, (ClientData) zf); - if ((zf->pwbuf[0] == 0) && pwlen) { + } + Unlock(); + *zf = *zf0; + zf->mntpt = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + zf->mntptlen=strlen(zf->mntpt); + zf->name = strdup(zipname); + zf->namelen= strlen(zipname); + zf->entries = NULL; + zf->topents = NULL; + zf->nopen = 0; + Tcl_SetHashValue(hPtr, (ClientData) zf); + if ((zf->pwbuf[0] == 0) && pwlen) { int k = 0; i = pwlen; zf->pwbuf[k++] = i; @@ -1352,7 +1301,6 @@ TclZipfs_Mount( } q = zf->data + zf->centoffs; Tcl_DStringInit(&fpBuf); - Tcl_DStringInit(&ds); for (i = 0; i < zf->nfiles; i++) { int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; unsigned char *lq, *gq = NULL; @@ -1514,12 +1462,229 @@ TclZipfs_Mount( nextent: q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; } - Unlock(); Tcl_DStringFree(&fpBuf); Tcl_DStringFree(&ds); Tcl_FSMountsChanged(NULL); + Unlock(); return TCL_OK; } + +static void TclZipfs_C_Init(void) { + static const Tcl_Time t = { 0, 0 }; + if (!ZipFS.initialized) { +#ifdef TCL_THREADS + /* + * Inflate condition variable. + */ + Tcl_MutexLock(&ZipFSMutex); + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); + Tcl_MutexUnlock(&ZipFSMutex); +#endif + Tcl_FSRegister(NULL, &zipfsFilesystem); + Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); + ZipFS.initialized = ZipFS.idCount = 1; + } +} + + +/* + *------------------------------------------------------------------------- + * + * TclZipfs_Mount -- + * + * This procedure is invoked to mount a given ZIP archive file on + * a given mountpoint with optional ZIP password. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is read, analyzed and mounted, resources are + * allocated. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfs_Mount( + Tcl_Interp *interp, + const char *mntpt, + const char *zipname, + const char *passwd +) { + int i, pwlen; + ZipFile *zf; + + ReadLock(); + if (!ZipFS.initialized) { + TclZipfs_C_Init(); + } + if (mntpt == NULL) { + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int ret = TCL_OK; + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + + if (zipname == NULL) { + Tcl_HashEntry *hPtr; + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); + } + } + Unlock(); + return TCL_OK; + } + Unlock(); + pwlen = 0; + if (passwd != NULL) { + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; + } + } + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + return TCL_ERROR; + } + if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) { + return TCL_ERROR; + } + return ZipFS_Catalogue_Filesystem(interp,zf,mntpt,passwd,zipname); +} + +/* + *------------------------------------------------------------------------- + * + * TclZipfs_Mount_Buffer -- + * + * This procedure is invoked to mount a given ZIP archive file on + * a given mountpoint with optional ZIP password. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is read, analyzed and mounted, resources are + * allocated. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfs_Mount_Buffer( + Tcl_Interp *interp, + const char *mntpt, + unsigned char *data, + size_t datalen, + int copy +) { + int i; + ZipFile *zf; + + ReadLock(); + if (!ZipFS.initialized) { + TclZipfs_C_Init(); + } + if (mntpt == NULL) { + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int ret = TCL_OK; + + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + + if (data == NULL) { + Tcl_HashEntry *hPtr; + + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); + } + } + Unlock(); + return TCL_OK; + } + Unlock(); + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + return TCL_ERROR; + } + zf->is_membuf=1; + zf->length=datalen; + if(copy) { + zf->data=(unsigned char *)Tcl_AttemptAlloc(datalen); + if (zf->data == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + return TCL_ERROR; + } + memcpy(zf->data,data,datalen); + zf->tofree=zf->data; + } else { + zf->data=data; + zf->tofree=NULL; + } + if(ZipFS_Find_TOC(interp,0,zf)!=TCL_OK) { + return TCL_ERROR; + } + return ZipFS_Catalogue_Filesystem(interp,zf,mntpt,NULL,"Memory Buffer"); +} /* *------------------------------------------------------------------------- @@ -1579,7 +1744,6 @@ TclZipfs_Unmount(Tcl_Interp *interp, const char *mntpt) Tcl_Free((char *) z); } ZipFSCloseArchive(interp, zf); - free(zf->name); //Allocated by strdup Tcl_Free((char *) zf); unmounted = 1; done: @@ -1612,13 +1776,88 @@ ZipFSMountObjCmd( ) { if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, - "?zipfile? ?mountpoint? ?password?"); + "?mountpoint? ?zipfile? ?password?"); return TCL_ERROR; } return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, (objc > 2) ? Tcl_GetString(objv[2]) : NULL, (objc > 3) ? Tcl_GetString(objv[3]) : NULL); } + +/* + *------------------------------------------------------------------------- + * + * ZipFSMountObjCmd -- + * + * This procedure is invoked to process the "zipfs::mount" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is mounted, resources are allocated. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMountBufferObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + const char *mntpt; + unsigned char *data; + int length; + if (objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); + return TCL_ERROR; + } + if(objc<2) { + int i; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int ret = TCL_OK; + ZipFile *zf; + + ReadLock(); + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + mntpt=Tcl_GetString(objv[1]); + if(objc<3) { + Tcl_HashEntry *hPtr; + ZipFile *zf; + + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); + } + } + Unlock(); + return TCL_OK; + } + data=Tcl_GetByteArrayFromObj(objv[2],&length); + return TclZipfs_Mount_Buffer(interp, mntpt,data,length,1); +} /* *------------------------------------------------------------------------- @@ -2477,11 +2716,10 @@ ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, /* *------------------------------------------------------------------------- * - * ZipFSExistsObjCmd -- + * ZipFSCanonicalObjCmd -- * - * This procedure is invoked to process the "zipfs::exists" command. - * It tests for the existence of a file in the ZIP filesystem and - * places a boolean into the interp's result. + * This procedure is invoked to process the "zipfs::canonical" command. + * It returns the canonical name for a file within zipfs * * Results: * Always TCL_OK. @@ -4137,6 +4375,7 @@ TclZipfs_Init(Tcl_Interp *interp) if(interp != NULL) { static const EnsembleImplMap initMap[] = { {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, + {"mount_data", ZipFSMountBufferObjCmd, NULL, NULL, NULL, 0}, {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, diff --git a/tests/zipfs.test b/tests/zipfs.test index 060e4a6..5f5b93c 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -105,7 +105,7 @@ test zipfs-0.12 {zipfs basics: join} -constraints zipfs -body { test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs mount a b c d e f -} -result {wrong # args: should be "zipfs mount ?zipfile? ?mountpoint? ?password?"} +} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"} test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body { zipfs unmount a b c d e f @@ -159,11 +159,8 @@ test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body { cd $CWD } -result "[zipfs root]abc/cp850.enc" -skip [concat [skip] zipfs-2.2.*] - - if {![zipfs exists /abc/cp850.enc]} { - tcltest::skip zipfs-2.2.* + skip [concat [skip] zipfs-2.2.*] } test zipfs-2.2.1 {zipfs info} -constraints zipfs -body { @@ -210,7 +207,73 @@ test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body { zipfs exists /abc/cp850.enc } -result 0 + +### +# Repeat the tests for a buffer mounted archive +### +test zipfs-2.3.0 {zipfs mkzip} -constraints zipfs -body { + cd $tcl_library/encoding + zipfs mkzip $zipfile . + set fin [open $zipfile r] + fconfigure $fin -translation binary + set dat [read $fin] + close $fin + zipfs mount_data def $dat + zipfs list -glob ${ziproot}def/cp850.* +} -cleanup { + cd $CWD +} -result "[zipfs root]def/cp850.enc" + +if {![zipfs exists /def/cp850.enc]} { + skip [concat [skip] zipfs-2.3.*] +} + +test zipfs-2.3.1 {zipfs info} -constraints zipfs -body { + set r [zipfs info ${ziproot}def/cp850.enc] + lrange $r 0 2 +} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable + +test zipfs-2.3.3 {zipfs data} -constraints zipfs -body { + set zipfd [open ${ziproot}/def/cp850.enc] ;# FIXME: leave open - see later test + read $zipfd +} -result {# Encoding file: cp850, single-byte +S +003F 0 1 +00 +0000000100020003000400050006000700080009000A000B000C000D000E000F +0010001100120013001400150016001700180019001A001B001C001D001E001F +0020002100220023002400250026002700280029002A002B002C002D002E002F +0030003100320033003400350036003700380039003A003B003C003D003E003F +0040004100420043004400450046004700480049004A004B004C004D004E004F +0050005100520053005400550056005700580059005A005B005C005D005E005F +0060006100620063006400650066006700680069006A006B006C006D006E006F +0070007100720073007400750076007700780079007A007B007C007D007E007F +00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5 +00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192 +00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB +2591259225932502252400C100C200C000A9256325512557255D00A200A52510 +25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4 +00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 +00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 +00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 +} ;# FIXME: result depends on content of encodings dir + +test zipfs-2.3.4 {zipfs exists} -constraints zipfs -body { + zipfs exists /def/cp850.enc +} -result 1 + +test zipfs-2.3.5 {zipfs unmount while busy} -constraints zipfs -body { + zipfs unmount /def +} -returnCodes error -result {filesystem is busy} + +test zipfs-2.3.6 {zipfs unmount} -constraints zipfs -body { + close $zipfd + zipfs unmount /def + zipfs exists /def/cp850.enc +} -result 0 + catch {file delete -force $tmpdir} + ::tcltest::cleanupTests return -- cgit v0.12 From 4786f9814b9d6bf0d105c2c0a38082df4c26296e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 16:01:42 +0000 Subject: clean-up some more remainings of the Itcl hack. Taken over from "novem". --- generic/tclIndexObj.c | 23 ++--------------------- generic/tclProc.c | 4 ++-- 2 files changed, 4 insertions(+), 23 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ce6ab68..bb329ad 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -881,19 +881,6 @@ Tcl_WrongNumArgs( Interp *iPtr = (Interp *) interp; const char *elementStr; - /* - * [incr Tcl] does something fairly horrific when generating error - * messages for its ensembles; it passes the whole set of ensemble - * arguments as a list in the first argument. This means that this code - * causes a problem in iTcl if it attempts to correctly quote all - * arguments, which would be the correct thing to do. We work around this - * nasty behaviour for now, and hope that we can remove it all in the - * future... - */ - -# define MAY_QUOTE_WORD 1 -# define AFTER_FIRST_WORD (void) 0 - TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; @@ -960,7 +947,7 @@ Tcl_WrongNumArgs( flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { + if (len != elemLen) { char *quotedElementStr = TclStackAlloc(interp, (unsigned)len + 1); @@ -972,8 +959,6 @@ Tcl_WrongNumArgs( Tcl_AppendToObj(objPtr, elementStr, elemLen); } - AFTER_FIRST_WORD; - /* * Add a space if the word is not the last one (which has a * moderately complex condition here). @@ -1011,7 +996,7 @@ Tcl_WrongNumArgs( flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { + if (len != elemLen) { char *quotedElementStr = TclStackAlloc(interp, (unsigned) len + 1); @@ -1024,8 +1009,6 @@ Tcl_WrongNumArgs( } } - AFTER_FIRST_WORD; - /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). @@ -1048,8 +1031,6 @@ Tcl_WrongNumArgs( Tcl_AppendStringsToObj(objPtr, "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); Tcl_SetObjResult(interp, objPtr); -#undef MAY_QUOTE_WORD -#undef AFTER_FIRST_WORD } /* diff --git a/generic/tclProc.c b/generic/tclProc.c index f5b3a64..da729ef 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1051,7 +1051,7 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { - desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); + desiredObjs[0] = framePtr->objv[skip-1]; } Tcl_IncrRefCount(desiredObjs[0]); @@ -1310,7 +1310,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ -1, &new, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } -- cgit v0.12 From eb5da6ae825ef4d30e2d0c2caff0055ca60bb05c Mon Sep 17 00:00:00 2001 From: stu Date: Wed, 17 Jan 2018 19:01:03 +0000 Subject: OpenBSD now has AI_ADDRCONFIG. --- generic/tclIOSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 6abfa60..24c26f6 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -223,7 +223,7 @@ TclCreateSocketAddress( * using AI_ADDRCONFIG is probably low even in situations where it works, * we'll leave it out for now. After all, it is just an optimisation. * - * Missing on: OpenBSD, NetBSD. + * Missing on NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ -- cgit v0.12 From 93fa41f6c79f481b1325108db444ed1de7d3cfd4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Jan 2018 15:17:45 +0000 Subject: Now really remove Tcl_EvalTokens/Tcl_Backslash as promised in the TIP. And remove library/tzdata/SystemV/* which contains non-standard timezones. See: [d3c5f2eb2ff63f10] They were originally gone since the tzdata2014f update, but it's unwise to do that in a patch release. Some documentation updates. --- doc/DString.3 | 2 +- doc/Eval.3 | 10 ++------- generic/tclBasic.c | 48 ------------------------------------------ generic/tclDictObj.c | 2 +- generic/tclExecute.c | 2 +- generic/tclInt.h | 3 --- generic/tclOO.h | 4 ++-- generic/tclUtil.c | 34 ------------------------------ library/tzdata/SystemV/AST4 | 5 ----- library/tzdata/SystemV/AST4ADT | 5 ----- library/tzdata/SystemV/CST6 | 5 ----- library/tzdata/SystemV/CST6CDT | 5 ----- library/tzdata/SystemV/EST5 | 5 ----- library/tzdata/SystemV/EST5EDT | 5 ----- library/tzdata/SystemV/HST10 | 5 ----- library/tzdata/SystemV/MST7 | 5 ----- library/tzdata/SystemV/MST7MDT | 5 ----- library/tzdata/SystemV/PST8 | 5 ----- library/tzdata/SystemV/PST8PDT | 5 ----- library/tzdata/SystemV/YST9 | 5 ----- library/tzdata/SystemV/YST9YDT | 5 ----- tools/checkLibraryDoc.tcl | 2 -- 22 files changed, 7 insertions(+), 165 deletions(-) delete mode 100644 library/tzdata/SystemV/AST4 delete mode 100644 library/tzdata/SystemV/AST4ADT delete mode 100644 library/tzdata/SystemV/CST6 delete mode 100644 library/tzdata/SystemV/CST6CDT delete mode 100644 library/tzdata/SystemV/EST5 delete mode 100644 library/tzdata/SystemV/EST5EDT delete mode 100644 library/tzdata/SystemV/HST10 delete mode 100644 library/tzdata/SystemV/MST7 delete mode 100644 library/tzdata/SystemV/MST7MDT delete mode 100644 library/tzdata/SystemV/PST8 delete mode 100644 library/tzdata/SystemV/PST8PDT delete mode 100644 library/tzdata/SystemV/YST9 delete mode 100644 library/tzdata/SystemV/YST9YDT diff --git a/doc/DString.3 b/doc/DString.3 index 2828278..b93f119 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings +Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings .SH SYNOPSIS .nf \fB#include \fR diff --git a/doc/Eval.3 b/doc/Eval.3 index 6596e44..7fd7bfa 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -122,16 +122,10 @@ might be a UTF-8 special code. The string is parsed and executed directly bytecodes. In situations where it is known that the script will never be executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR. \fBTcl_Eval\fR returns a completion code and result just like -\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before -Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to -\fIinterp->result\fR (use is deprecated) where it can be accessed directly. - This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which -does not do the copy. +\fBTcl_EvalObjEx\fR. .PP \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes -additional arguments \fInumBytes\fR and \fIflags\fR. For the -efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred -over \fBTcl_Eval\fR. +additional arguments \fInumBytes\fR and \fIflags\fR. .PP \fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures that are now deprecated. They are similar to \fBTcl_EvalEx\fR and diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 463e455..7fdcb24 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4514,54 +4514,6 @@ Tcl_EvalTokensStandard( /* *---------------------------------------------------------------------- * - * Tcl_EvalTokens -- - * - * Given an array of tokens parsed from a Tcl command (e.g., the tokens - * that make up a word or the index for an array variable) this function - * evaluates the tokens and concatenates their values to form a single - * result value. - * - * Results: - * The return value is a pointer to a newly allocated Tcl_Obj containing - * the value of the array of tokens. The reference count of the returned - * object has been incremented. If an error occurs in evaluating the - * tokens then a NULL value is returned and an error message is left in - * interp's result. - * - * Side effects: - * A new object is allocated to hold the result. - * - *---------------------------------------------------------------------- - * - * This uses a non-standard return convention; its use is now deprecated. It - * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used - * in the core any longer. It is only kept for backward compatibility. - */ - -Tcl_Obj * -Tcl_EvalTokens( - Tcl_Interp *interp, /* Interpreter in which to lookup variables, - * execute nested commands, and report - * errors. */ - Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to - * evaluate and concatenate. */ - int count) /* Number of tokens to consider at tokenPtr. - * Must be at least 1. */ -{ - Tcl_Obj *resPtr; - - if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) { - return NULL; - } - resPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(resPtr); - Tcl_ResetResult(interp); - return resPtr; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalEx, TclEvalEx -- * * This function evaluates a Tcl script without using the compiler or diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 3b983e3..e9018db 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -235,7 +235,7 @@ AllocChainEntry( cPtr = ckalloc(sizeof(ChainEntry)); cPtr->entry.key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); - cPtr->entry.clientData = NULL; + Tcl_SetHashValue(&cPtr->entry, NULL); cPtr->prevPtr = cPtr->nextPtr = NULL; return &cPtr->entry; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 42da922..9b9c3fa 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -73,7 +73,7 @@ int tclTraceExec = 0; * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is - * disjoint for backward-compatability reasons. + * disjoint for backward-compatibility reasons. */ static const char *const operatorStrings[] = { diff --git a/generic/tclInt.h b/generic/tclInt.h index fe7b93d..7996100 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -178,9 +178,6 @@ typedef struct Tcl_ResolverInfo { * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers - * - * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag - * (Bug #835020) */ #define TCL_AVOID_RESOLVERS 0x40000 diff --git a/generic/tclOO.h b/generic/tclOO.h index d051e79..13a4a10 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -95,7 +95,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking - * binary compatability. + * binary compatibility. */ #define TCL_OO_METHOD_VERSION_CURRENT 1 @@ -122,7 +122,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_ObjectMetadataType * structure. This allows new versions of the structure to be introduced - * without breaking binary compatability. + * without breaking binary compatibility. */ #define TCL_OO_METADATA_VERSION_CURRENT 1 diff --git a/generic/tclUtil.c b/generic/tclUtil.c index efb51ca..7b969af 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1600,40 +1600,6 @@ Tcl_Merge( /* *---------------------------------------------------------------------- * - * Tcl_Backslash -- - * - * Figure out how to handle a backslash sequence. - * - * Results: - * The return value is the character that should be substituted in place - * of the backslash sequence that starts at src. If readPtr isn't NULL - * then it is filled in with a count of the number of characters in the - * backslash sequence. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -char -Tcl_Backslash( - const char *src, /* Points to the backslash character of a - * backslash sequence. */ - int *readPtr) /* Fill in with number of characters read from - * src, unless NULL. */ -{ - char buf[TCL_UTF_MAX]; - Tcl_UniChar ch = 0; - - Tcl_UtfBackslash(src, readPtr, buf); - TclUtfToUniChar(buf, &ch); - return (char) ch; -} - -/* - *---------------------------------------------------------------------- - * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null diff --git a/library/tzdata/SystemV/AST4 b/library/tzdata/SystemV/AST4 deleted file mode 100644 index eced0d2..0000000 --- a/library/tzdata/SystemV/AST4 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Puerto_Rico)]} { - LoadTimeZoneFile America/Puerto_Rico -} -set TZData(:SystemV/AST4) $TZData(:America/Puerto_Rico) diff --git a/library/tzdata/SystemV/AST4ADT b/library/tzdata/SystemV/AST4ADT deleted file mode 100644 index c24308f..0000000 --- a/library/tzdata/SystemV/AST4ADT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Halifax)]} { - LoadTimeZoneFile America/Halifax -} -set TZData(:SystemV/AST4ADT) $TZData(:America/Halifax) diff --git a/library/tzdata/SystemV/CST6 b/library/tzdata/SystemV/CST6 deleted file mode 100644 index d46c015..0000000 --- a/library/tzdata/SystemV/CST6 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Regina)]} { - LoadTimeZoneFile America/Regina -} -set TZData(:SystemV/CST6) $TZData(:America/Regina) diff --git a/library/tzdata/SystemV/CST6CDT b/library/tzdata/SystemV/CST6CDT deleted file mode 100644 index 234af89..0000000 --- a/library/tzdata/SystemV/CST6CDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Chicago)]} { - LoadTimeZoneFile America/Chicago -} -set TZData(:SystemV/CST6CDT) $TZData(:America/Chicago) diff --git a/library/tzdata/SystemV/EST5 b/library/tzdata/SystemV/EST5 deleted file mode 100644 index 52818c1..0000000 --- a/library/tzdata/SystemV/EST5 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Indianapolis)]} { - LoadTimeZoneFile America/Indianapolis -} -set TZData(:SystemV/EST5) $TZData(:America/Indianapolis) diff --git a/library/tzdata/SystemV/EST5EDT b/library/tzdata/SystemV/EST5EDT deleted file mode 100644 index 6cf2743..0000000 --- a/library/tzdata/SystemV/EST5EDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/New_York)]} { - LoadTimeZoneFile America/New_York -} -set TZData(:SystemV/EST5EDT) $TZData(:America/New_York) diff --git a/library/tzdata/SystemV/HST10 b/library/tzdata/SystemV/HST10 deleted file mode 100644 index a4316af..0000000 --- a/library/tzdata/SystemV/HST10 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(Pacific/Honolulu)]} { - LoadTimeZoneFile Pacific/Honolulu -} -set TZData(:SystemV/HST10) $TZData(:Pacific/Honolulu) diff --git a/library/tzdata/SystemV/MST7 b/library/tzdata/SystemV/MST7 deleted file mode 100644 index e67a781..0000000 --- a/library/tzdata/SystemV/MST7 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Phoenix)]} { - LoadTimeZoneFile America/Phoenix -} -set TZData(:SystemV/MST7) $TZData(:America/Phoenix) diff --git a/library/tzdata/SystemV/MST7MDT b/library/tzdata/SystemV/MST7MDT deleted file mode 100644 index fda5bf1..0000000 --- a/library/tzdata/SystemV/MST7MDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Denver)]} { - LoadTimeZoneFile America/Denver -} -set TZData(:SystemV/MST7MDT) $TZData(:America/Denver) diff --git a/library/tzdata/SystemV/PST8 b/library/tzdata/SystemV/PST8 deleted file mode 100644 index 8e30bb8..0000000 --- a/library/tzdata/SystemV/PST8 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(Pacific/Pitcairn)]} { - LoadTimeZoneFile Pacific/Pitcairn -} -set TZData(:SystemV/PST8) $TZData(:Pacific/Pitcairn) diff --git a/library/tzdata/SystemV/PST8PDT b/library/tzdata/SystemV/PST8PDT deleted file mode 100644 index 8281a9a..0000000 --- a/library/tzdata/SystemV/PST8PDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Los_Angeles)]} { - LoadTimeZoneFile America/Los_Angeles -} -set TZData(:SystemV/PST8PDT) $TZData(:America/Los_Angeles) diff --git a/library/tzdata/SystemV/YST9 b/library/tzdata/SystemV/YST9 deleted file mode 100644 index 32d3717..0000000 --- a/library/tzdata/SystemV/YST9 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(Pacific/Gambier)]} { - LoadTimeZoneFile Pacific/Gambier -} -set TZData(:SystemV/YST9) $TZData(:Pacific/Gambier) diff --git a/library/tzdata/SystemV/YST9YDT b/library/tzdata/SystemV/YST9YDT deleted file mode 100644 index fba405f..0000000 --- a/library/tzdata/SystemV/YST9YDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Anchorage)]} { - LoadTimeZoneFile America/Anchorage -} -set TZData(:SystemV/YST9YDT) $TZData(:America/Anchorage) diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index a220ea8..47063c0 100755 --- a/tools/checkLibraryDoc.tcl +++ b/tools/checkLibraryDoc.tcl @@ -50,8 +50,6 @@ set StructList { Tcl_TimerToken \ Tcl_Token \ Tcl_Trace \ - Tcl_Value \ - Tcl_ValueType \ Tcl_Var \ Tk_3DBorder \ Tk_ArgvInfo \ -- cgit v0.12 From a43cab006e1fbad733c53c09c3f2f78d4fc8ad60 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Jan 2018 16:08:02 +0000 Subject: No longer use (the undocumented) CONST86 anywhere, just keep the define in tcl.h. --- generic/tcl.decls | 8 ++++---- generic/tcl.h | 8 ++++---- generic/tclDecls.h | 16 ++++++++-------- generic/tclInt.decls | 4 ++-- generic/tclIntDecls.h | 8 ++++---- 5 files changed, 22 insertions(+), 22 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index c1930f6..5a8d00b 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -166,7 +166,7 @@ declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { - CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) + const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) @@ -568,7 +568,7 @@ declare 157 { const char *optionName, Tcl_DString *dsPtr) } declare 158 { - CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) + const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) } declare 159 { int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, @@ -1632,7 +1632,7 @@ declare 452 { int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 { - const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, + const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 { @@ -1710,7 +1710,7 @@ declare 476 { Tcl_Obj *pathPtr) } declare 477 { - CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) + const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) } declare 478 { Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) diff --git a/generic/tcl.h b/generic/tcl.h index 8eb8f49..b913ee3 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -208,7 +208,7 @@ extern "C" { # endif #endif -#ifndef CONST86 +#if !defined(CONST86) # define CONST86 const #endif @@ -1205,8 +1205,8 @@ typedef struct Tcl_Time { long usec; /* Microseconds. */ } Tcl_Time; -typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr); -typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); +typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr); +typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr); /* * TIP #233 (Virtualized Time) @@ -1478,7 +1478,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); -typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, +typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ba335ef..995878c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -171,7 +171,7 @@ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ -EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); +EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ @@ -493,7 +493,7 @@ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ -EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); +EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); @@ -1285,7 +1285,7 @@ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ -EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, +EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); @@ -1346,7 +1346,7 @@ EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ -EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); +EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ @@ -1858,7 +1858,7 @@ typedef struct TclStubs { int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ - CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ + const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ @@ -1976,7 +1976,7 @@ typedef struct TclStubs { int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ - CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ + const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ @@ -2279,7 +2279,7 @@ typedef struct TclStubs { int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */ int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */ int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */ - const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ + const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */ int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */ @@ -2303,7 +2303,7 @@ typedef struct TclStubs { int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */ - CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ + const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */ int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */ void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index c7a2efc..35116da 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -184,7 +184,7 @@ declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { - CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) + const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } # Removed in 8.5a2: #declare 43 { @@ -412,7 +412,7 @@ declare 98 { # Tcl_Obj *objPtr, int flags) #} declare 101 { - CONST86 char *TclSetPreInitScript(const char *string) + const char *TclSetPreInitScript(const char *string) } declare 102 { void TclSetupEnv(Tcl_Interp *interp) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index ec6a889..85353f9 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -132,7 +132,7 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ -EXTERN CONST86 char * TclpGetUserHome(const char *name, +EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ @@ -237,7 +237,7 @@ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ -EXTERN CONST86 char * TclSetPreInitScript(const char *string); +EXTERN const char * TclSetPreInitScript(const char *string); /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ @@ -626,7 +626,7 @@ typedef struct TclIntStubs { TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ - CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ + const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ void (*reserved43)(void); int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ @@ -685,7 +685,7 @@ typedef struct TclIntStubs { int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); - CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ + const char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ void (*reserved104)(void); -- cgit v0.12 From e16df96d28704115312eee43ffc5019a766d2cfd Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Fri, 19 Jan 2018 20:27:15 +0000 Subject: Fixed a problem where a Windows hack was occuring after it was called in the tclZipfs.c file, preventing it from compiling properly. --- generic/tclZipfs.c | 38 ++++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index b81c58f..bb9d45f 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -2945,6 +2945,24 @@ ZipFSListObjCmd( return TCL_OK; } +#if defined(_WIN32) || defined(_WIN64) +#define LIBRARY_SIZE 64 +static int +ToUtf( + const WCHAR *wSrc, + char *dst) +{ + char *start; + + start = dst; + while (*wSrc != '\0') { + dst += Tcl_UniCharToUtf(*wSrc, dst); + wSrc++; + } + *dst = '\0'; + return (int) (dst - start); +} +#endif Tcl_Obj *TclZipfs_TclLibrary(void) { if(zipfs_literal_tcl_library) { @@ -4422,26 +4440,6 @@ TclZipfs_Init(Tcl_Interp *interp) #endif } -#if defined(_WIN32) || defined(_WIN64) -#define LIBRARY_SIZE 64 -static int -ToUtf( - const WCHAR *wSrc, - char *dst) -{ - char *start; - - start = dst; - while (*wSrc != '\0') { - dst += Tcl_UniCharToUtf(*wSrc, dst); - wSrc++; - } - *dst = '\0'; - return (int) (dst - start); -} - -#endif - static int TclZipfs_AppHook_FindTclInit(const char *archive){ Tcl_Obj *vfsinitscript; int found; -- cgit v0.12 From 1c35ed873acea5b757b3236e5b04e551eba800aa Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 20 Jan 2018 16:02:31 +0000 Subject: Follow-up to previous commit (TIP #485 implementation). Actually remove Tcl_Backslash and Tcl_EvalTokens when compiling with -DTCL_NO_DEPRECATED. --- generic/tclBasic.c | 2 ++ generic/tclUtil.c | 2 ++ 2 files changed, 4 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 52f26a9..c23491c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4937,6 +4937,7 @@ Tcl_EvalTokensStandard( NULL, NULL); } +#if !defined(TCL_NO_DEPRECATED) && TCL_MINOR_VERSION < 9 /* *---------------------------------------------------------------------- * @@ -4984,6 +4985,7 @@ Tcl_EvalTokens( Tcl_ResetResult(interp); return resPtr; } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 15018de..dcd0415 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1604,6 +1604,7 @@ Tcl_Merge( return result; } +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* *---------------------------------------------------------------------- * @@ -1637,6 +1638,7 @@ Tcl_Backslash( TclUtfToUniChar(buf, &ch); return (char) ch; } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- -- cgit v0.12 From 03a71b070685eecb97de3d3cfe830823b056054e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Jan 2018 09:18:19 +0000 Subject: Put old "int" type back. Not used by Tcl anymore, but this restores compatibility with Tk < 8.6.9 and some extensions: "nsf", "tdbcload", "tclxml" and "VecTcl" (this workaround was used by "boolean" as well, when its internal implementation changed, there's still an oldBooleanType because of that) --- generic/tclInt.h | 1 + generic/tclObj.c | 31 +++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/generic/tclInt.h b/generic/tclInt.h index 50d0469..d74cd0e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2713,6 +2713,7 @@ MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; +MODULE_SCOPE const Tcl_ObjType tclOldIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; diff --git a/generic/tclObj.c b/generic/tclObj.c index 8ec95ce..e02f6c4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -210,6 +210,9 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) +static void UpdateStringOfOldInt(Tcl_Obj *objPtr); +#endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); @@ -272,6 +275,15 @@ const Tcl_ObjType tclIntType = { UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) +const Tcl_ObjType tclOldIntType = { + "int", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfOldInt, /* updateStringProc */ + SetIntFromAny /* setFromAnyProc */ +}; +#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ @@ -400,6 +412,9 @@ TclInitObjSubsystem(void) /* For backward compatibility only ... */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_RegisterObjType(&tclIntType); +#if !defined(TCL_WIDE_INT_IS_LONG) + Tcl_RegisterObjType(&tclOldIntType); +#endif Tcl_RegisterObjType(&oldBooleanType); #endif @@ -2548,6 +2563,22 @@ UpdateStringOfInt( memcpy(objPtr->bytes, buffer, (unsigned) len + 1); objPtr->length = len; } + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) +static void +UpdateStringOfOldInt( + register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ +{ + char buffer[TCL_INTEGER_SPACE]; + register int len; + + len = TclFormatInt(buffer, objPtr->internalRep.longValue); + + objPtr->bytes = ckalloc(len + 1); + memcpy(objPtr->bytes, buffer, (unsigned) len + 1); + objPtr->length = len; +} +#endif /* *---------------------------------------------------------------------- -- cgit v0.12 From fb10dc69eead85da6836ed1c28ee1269d1738337 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Jan 2018 09:54:40 +0000 Subject: make the old "int" type "static", since it's just used in a single file. --- generic/tclInt.h | 1 - generic/tclObj.c | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index d74cd0e..50d0469 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2713,7 +2713,6 @@ MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; -MODULE_SCOPE const Tcl_ObjType tclOldIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; diff --git a/generic/tclObj.c b/generic/tclObj.c index e02f6c4..ebe1450 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -276,7 +276,7 @@ const Tcl_ObjType tclIntType = { SetIntFromAny /* setFromAnyProc */ }; #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -const Tcl_ObjType tclOldIntType = { +static const Tcl_ObjType oldIntType = { "int", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ @@ -413,7 +413,7 @@ TclInitObjSubsystem(void) #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_RegisterObjType(&tclIntType); #if !defined(TCL_WIDE_INT_IS_LONG) - Tcl_RegisterObjType(&tclOldIntType); + Tcl_RegisterObjType(&oldIntType); #endif Tcl_RegisterObjType(&oldBooleanType); #endif -- cgit v0.12 From 92c0d0a0116d9bf6af0b41c0206824f23953f9c2 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 22 Jan 2018 13:38:47 +0000 Subject: typo --- generic/tclBasic.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c23491c..fa54551 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4937,7 +4937,7 @@ Tcl_EvalTokensStandard( NULL, NULL); } -#if !defined(TCL_NO_DEPRECATED) && TCL_MINOR_VERSION < 9 +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* *---------------------------------------------------------------------- * -- cgit v0.12 From 0abda82b1ef6d5a059df46d1706ae64157523fe7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 23 Jan 2018 14:52:34 +0000 Subject: In Tcl 9.0, don't register oldBooleanType any more. And rename "booleanString" to "boolean" in tclBooleanType. Many extensions (e.g. [http://cyqlite.sourceforge.net/cgi-bin/sqlite/info/451bb2c1f8554eee|sqlite]) still test for "boolean", although that stopped working already for a long time. In Tcl 8.7, do the same when compiled with -DTCL_NO_DEPRECATED. --- generic/tclObj.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/generic/tclObj.c b/generic/tclObj.c index 4ec0a57..b922c39 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -242,6 +242,7 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * implementations. */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 static const Tcl_ObjType oldBooleanType = { "boolean", /* name */ NULL, /* freeIntRepProc */ @@ -249,8 +250,13 @@ static const Tcl_ObjType oldBooleanType = { NULL, /* updateStringProc */ TclSetBooleanFromAny /* setFromAnyProc */ }; +#endif const Tcl_ObjType tclBooleanType = { +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 "booleanString", /* name */ +#else + "boolean", /* name */ +#endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ @@ -406,7 +412,9 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclProcBodyType); /* For backward compatibility only ... */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_RegisterObjType(&oldBooleanType); +#endif #ifndef TCL_WIDE_INT_IS_LONG Tcl_RegisterObjType(&tclWideIntType); #endif -- cgit v0.12 From 83df36ac4194e2b04610ad61244a08b9b068a816 Mon Sep 17 00:00:00 2001 From: pspjuth Date: Thu, 25 Jan 2018 20:05:54 +0000 Subject: Allow -stride 1. --- doc/lsearch.n | 3 ++- generic/tclCmdIL.c | 4 ++-- tests/lsearch.test | 6 +++++- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/doc/lsearch.n b/doc/lsearch.n index 2f956a5..12c2786 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -158,7 +158,8 @@ by the element within each group given by the first index passed to index always points to the first element in a group. .PP The list length must be an integer multiple of \fIstrideLength\fR, which -in turn must be at least 2. +in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and +indicates no grouping. .TP \fB\-index\fR\0\fIindexList\fR . diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c514f84..e07b5ba 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -3101,9 +3101,9 @@ Tcl_LsearchObjCmd( result = TCL_ERROR; goto done; } - if (groupSize < 2) { + if (groupSize < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "stride length must be at least 2", -1)); + "stride length must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", NULL); result = TCL_ERROR; diff --git a/tests/lsearch.test b/tests/lsearch.test index 4e4b206..a53a8be 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -518,7 +518,7 @@ test lsearch-23.1 {lsearch -stride option, errors} -body { } -returnCodes error -result {"-stride" option must be followed by stride length} test lsearch-23.2 {lsearch -stride option, errors} -body { lsearch -stride 0 {a b} a -} -returnCodes error -result {stride length must be at least 2} +} -returnCodes error -result {stride length must be at least 1} test lsearch-23.3 {lsearch -stride option, errors} -body { lsearch -stride 2 {a b c} a } -returnCodes error -result {list size must be a multiple of the stride length} @@ -562,6 +562,10 @@ test lsearch-24.9 {lsearch -stride option} -body { test lsearch-24.10 {lsearch -stride option} -body { lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a } -result "a b c a e i" +test lsearch-24.11 {lsearch -stride option} -body { + # Stride 1 is same as no stride + lsearch -stride 1 {a b c d e f g h} d +} -result 3 # 25* mimics 19* but with -inline added to -subindices test lsearch-25.1 {lsearch -subindices option} { -- cgit v0.12 From 46e8af13b6ce6aaddd0d274991d58db7d44714ca Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 25 Jan 2018 22:11:34 +0000 Subject: Dup test name --- tests/lsearch.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/lsearch.test b/tests/lsearch.test index a53a8be..a7efcdd 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -651,7 +651,7 @@ test lsearch-28.7 {lsearch -sorted with -stride} -body { test lsearch-28.8 {lsearch -sorted with -stride} -body { lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9 } -result 5 -test lsearch-28.8 {lsearch -sorted with -stride} -body { +test lsearch-28.9 {lsearch -sorted with -stride} -body { lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9 } -result 9 -- cgit v0.12 From 2eba1ce11e24976640d99ae78cec26cc67508f15 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Jan 2018 13:29:01 +0000 Subject: Rename (internal) TclNewWideObj macro to TclNewIntObj. Change Tcl_SetIntObj/Tcl_SetLongObj to macro's referencing Tcl_SetWideIntObj (since all of those do the same now) --- generic/tclBasic.c | 2 +- generic/tclCmdMZ.c | 2 +- generic/tclDecls.h | 6 ++++-- generic/tclExecute.c | 46 +++++++++++++++++++++++----------------------- generic/tclInt.h | 6 +++--- generic/tclObj.c | 11 ++++++----- generic/tclScan.c | 4 ++-- generic/tclStubInit.c | 1 + generic/tclZlib.c | 2 +- 9 files changed, 42 insertions(+), 38 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 51d9a64..e2879f1 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3686,7 +3686,7 @@ OldMathFuncProc( */ if (funcResult.type == TCL_INT) { - TclNewWideObj(valuePtr, funcResult.intValue); + TclNewIntObj(valuePtr, funcResult.intValue); } else if (funcResult.type == TCL_WIDE_INT) { valuePtr = Tcl_NewWideIntObj(funcResult.wideValue); } else { diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 8ae3f51..fd9858b 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4303,7 +4303,7 @@ TclNRTryObjCmd( } info[0] = objv[i]; /* type */ - TclNewWideObj(info[1], code); /* returnCode */ + TclNewIntObj(info[1], code); /* returnCode */ if (info[2] == NULL) { /* errorCodePrefix */ TclNewObj(info[2]); } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464609c..49f34e8 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3935,7 +3935,6 @@ extern const TclStubs *tclStubsPtr; * without introducing a binary incompatibility. */ # undef Tcl_GetLongFromObj -# undef Tcl_SetLongObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj # undef Tcl_UniCharNcmp @@ -3943,7 +3942,6 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_UtfNcasecmp # undef Tcl_UniCharNcasecmp # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) -# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj) # define Tcl_ExprLong TclExprLong static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){ int intValue; @@ -3975,6 +3973,10 @@ extern const TclStubs *tclStubsPtr; #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) #undef Tcl_DbNewLongObj #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) +#undef Tcl_SetIntObj +#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value)) +#undef Tcl_SetLongObj +#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value)) /* * Deprecated Tcl procedures: diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 81f7fe7..eb730ce 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -325,7 +325,7 @@ VarHashCreateVar( NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ - TclNewWideObj(objResultPtr, -1); \ + TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -346,7 +346,7 @@ VarHashCreateVar( NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ - TclNewWideObj(objResultPtr, -1); \ + TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -357,7 +357,7 @@ VarHashCreateVar( #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ - TclNewWideObj(objResultPtr, -1); \ + TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -366,7 +366,7 @@ VarHashCreateVar( #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ - TclNewWideObj(objResultPtr, -1); \ + TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ @@ -851,9 +851,9 @@ TclCreateExecEnv( + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; - TclNewWideObj(eePtr->constants[0], 0); + TclNewIntObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); - TclNewWideObj(eePtr->constants[1], 1); + TclNewIntObj(eePtr->constants[1], 1); Tcl_IncrRefCount(eePtr->constants[1]); eePtr->interp = interp; eePtr->callbackPtr = NULL; @@ -1849,7 +1849,7 @@ TclIncrObj( */ if (!Overflowing(w1, w2, sum)) { - Tcl_SetWideIntObj(valuePtr, sum); + TclSetIntObj(valuePtr, sum); return TCL_OK; } } @@ -3649,7 +3649,7 @@ TEBCresume( TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ - TclNewWideObj(objResultPtr, sum); + TclNewIntObj(objResultPtr, sum); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { @@ -3687,7 +3687,7 @@ TEBCresume( } else { objResultPtr = objPtr; } - TclNewWideObj(incrPtr, increment); + TclNewIntObj(incrPtr, increment); if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { Tcl_DecrRefCount(incrPtr); TRACE_ERROR(interp); @@ -3701,7 +3701,7 @@ TEBCresume( * All other cases, flow through to generic handling. */ - TclNewWideObj(incrPtr, increment); + TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); doIncrScalar: @@ -4399,7 +4399,7 @@ TEBCresume( NEXT_INST_F(1, 0, 1); } case INST_INFO_LEVEL_NUM: - TclNewWideObj(objResultPtr, iPtr->varFramePtr->level); + TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { @@ -4768,7 +4768,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - TclNewWideObj(objResultPtr, length); + TclNewIntObj(objResultPtr, length); TRACE_APPEND(("%d\n", length)); NEXT_INST_F(1, 1, 1); @@ -5239,7 +5239,7 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); - TclNewWideObj(objResultPtr, length); + TclNewIntObj(objResultPtr, length); TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); @@ -5594,7 +5594,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewWideObj(objResultPtr, match); + TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: @@ -5602,7 +5602,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewWideObj(objResultPtr, match); + TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: @@ -5798,7 +5798,7 @@ TEBCresume( type1 = TCL_NUMBER_WIDE; } } - TclNewWideObj(objResultPtr, type1); + TclNewIntObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); NEXT_INST_F(1, 1, 1); @@ -5991,7 +5991,7 @@ TEBCresume( if (w1 > 0L) { objResultPtr = TCONST(0); } else { - TclNewWideObj(objResultPtr, -1); + TclNewIntObj(objResultPtr, -1); } TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -6190,7 +6190,7 @@ TEBCresume( TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } - Tcl_SetWideIntObj(valuePtr, wResult); + TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); @@ -6298,7 +6298,7 @@ TEBCresume( if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); if (Tcl_IsShared(valuePtr)) { - TclNewWideObj(objResultPtr, ~w1); + TclNewIntObj(objResultPtr, ~w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } @@ -6336,7 +6336,7 @@ TEBCresume( w1 = *((const Tcl_WideInt *) ptr1); if (w1 != LLONG_MIN) { if (Tcl_IsShared(valuePtr)) { - TclNewWideObj(objResultPtr, -w1); + TclNewIntObj(objResultPtr, -w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } @@ -6501,7 +6501,7 @@ TEBCresume( oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { - TclNewWideObj(iterVarPtr->value.objPtr, -1); + TclNewIntObj(iterVarPtr->value.objPtr, -1); Tcl_IncrRefCount(iterVarPtr->value.objPtr); } else { TclSetIntObj(oldValuePtr, -1); @@ -6872,7 +6872,7 @@ TEBCresume( NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: - TclNewWideObj(objResultPtr, result); + TclNewIntObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); @@ -7973,7 +7973,7 @@ ExecuteExtendedBinaryMathOp( if (Tcl_IsShared(valuePtr)) { \ return Tcl_NewWideIntObj(w); \ } else { \ - Tcl_SetWideIntObj(valuePtr, w); \ + TclSetIntObj(valuePtr, w); \ return NULL; \ } #define BIG_RESULT(b) \ diff --git a/generic/tclInt.h b/generic/tclInt.h index b061ed0..d5f4c9b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4583,7 +4583,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * - * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); + * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len); * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral); @@ -4592,7 +4592,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #ifndef TCL_MEM_DEBUG -#define TclNewWideObj(objPtr, i) \ +#define TclNewIntObj(objPtr, i) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ @@ -4625,7 +4625,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; } while (0) #else /* TCL_MEM_DEBUG */ -#define TclNewWideObj(objPtr, w) \ +#define TclNewIntObj(objPtr, w) \ (objPtr) = Tcl_NewWideIntObj(w) #define TclNewDoubleObj(objPtr, d) \ diff --git a/generic/tclObj.c b/generic/tclObj.c index b4dfc63..5f60d9d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1769,7 +1769,7 @@ Tcl_NewBooleanObj( { register Tcl_Obj *objPtr; - TclNewWideObj(objPtr, boolValue!=0); + TclNewIntObj(objPtr, boolValue!=0); return objPtr; } #endif /* TCL_MEM_DEBUG */ @@ -2416,7 +2416,7 @@ Tcl_NewIntObj( { register Tcl_Obj *objPtr; - TclNewWideObj(objPtr, intValue); + TclNewIntObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2630,7 +2630,7 @@ Tcl_NewLongObj( { register Tcl_Obj *objPtr; - TclNewWideObj(objPtr, longValue); + TclNewIntObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2722,6 +2722,7 @@ Tcl_DbNewLongObj( *---------------------------------------------------------------------- */ +#undef Tcl_SetLongObj void Tcl_SetLongObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ @@ -2891,7 +2892,7 @@ Tcl_NewWideIntObj( register Tcl_Obj *objPtr; TclNewObj(objPtr); - Tcl_SetWideIntObj(objPtr, wideValue); + TclSetIntObj(objPtr, wideValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2943,7 +2944,7 @@ Tcl_DbNewWideIntObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); - Tcl_SetWideIntObj(objPtr, wideValue); + TclSetIntObj(objPtr, wideValue); return objPtr; } diff --git a/generic/tclScan.c b/generic/tclScan.c index e0798df..1bdc3ef 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -942,7 +942,7 @@ Tcl_ScanObjCmd( (Tcl_WideUInt)wideValue); Tcl_SetStringObj(objPtr, buf, -1); } else { - Tcl_SetWideIntObj(objPtr, wideValue); + TclSetIntObj(objPtr, wideValue); } } else if (!(flags & SCAN_BIG)) { if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { @@ -956,7 +956,7 @@ Tcl_ScanObjCmd( sprintf(buf, "%lu", value); /* INTL: ISO digit */ Tcl_SetStringObj(objPtr, buf, -1); } else { - Tcl_SetLongObj(objPtr, value); + TclSetIntObj(objPtr, value); } } objs[objIndex++] = objPtr; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d255e97..86406c1 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -43,6 +43,7 @@ #undef TclpGetPid #undef TclSockMinimumBuffers #undef Tcl_SetIntObj +#undef Tcl_SetLongObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt diff --git a/generic/tclZlib.c b/generic/tclZlib.c index dc124f7..994bcef 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -373,7 +373,7 @@ ConvertErrorToList( default: TclNewLiteralStringObj(objv[2], "UNKNOWN"); - TclNewWideObj(objv[3], code); + TclNewIntObj(objv[3], code); return Tcl_NewListObj(4, objv); } } -- cgit v0.12 From fa7659336ca6c01fbed7cf8497b29e9191b0cb42 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 27 Jan 2018 18:17:09 +0000 Subject: Remove restriction on defining the class of a TclOO object not explicitly instantiated from ::oo::class. --- generic/tclOODefineCmds.c | 15 --------------- tests/oo.test | 4 ++-- 2 files changed, 2 insertions(+), 17 deletions(-) diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index c08b350..7c2a641 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -1143,7 +1143,6 @@ TclOODefineClassObjCmd( { Object *oPtr; Class *clsPtr; - Foundation *fPtr = TclOOGetFoundation(interp); /* * Parse the context to get the object to operate on. @@ -1180,20 +1179,6 @@ TclOODefineClassObjCmd( return TCL_ERROR; } - /* - * Apply semantic checks. In particular, classes and non-classes are not - * interchangable (too complicated to do the conversion!) so we must - * produce an error if any attempt is made to swap from one to the other. - */ - - if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "may not change a %sclass object into a %sclass object", - (oPtr->classPtr==NULL ? "non-" : ""), - (oPtr->classPtr==NULL ? "" : "non-"))); - Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL); - return TCL_ERROR; - } /* * Set the object's class. diff --git a/tests/oo.test b/tests/oo.test index 3be5f79..4f9490b 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1707,13 +1707,13 @@ test oo-13.2 {OO: changing an object's class} -body { oo::objdefine foo class oo::class } -cleanup { foo destroy -} -returnCodes 1 -result {may not change a non-class object into a class object} +} -result {} test oo-13.3 {OO: changing an object's class} -body { oo::class create foo oo::objdefine foo class oo::object } -cleanup { foo destroy -} -returnCodes 1 -result {may not change a class object into a non-class object} +} -result {} test oo-13.4 {OO: changing an object's class} -body { oo::class create foo { method m {} { -- cgit v0.12 From 876f2d5b633933c4d5a652a0bc4e1742893cc458 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 28 Jan 2018 14:37:53 +0000 Subject: Change the signature of PkgRequireCore in preparation to provide TclNRPackageObjCmd. --- generic/tclPkg.c | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 288d5dc..2b842b4 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -85,7 +85,7 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); -static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, +static int PkgRequireCore(Tcl_Interp *interp, const char *name, int reqc, Tcl_Obj *const reqv[], void *clientDataPtr); @@ -365,7 +365,10 @@ Tcl_PkgRequireEx( */ if (version == NULL) { - result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr); + if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) { + result = Tcl_GetStringResult(interp); + Tcl_ResetResult(interp); + } } else { if (exact && TCL_OK != CheckVersionAndConvert(interp, version, NULL, NULL)) { @@ -376,10 +379,12 @@ Tcl_PkgRequireEx( Tcl_AppendStringsToObj(ov, "-", version, NULL); } Tcl_IncrRefCount(ov); - result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr); + if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) { + result = Tcl_GetStringResult(interp); + Tcl_ResetResult(interp); + } TclDecrRefCount(ov); } - return result; } @@ -394,17 +399,14 @@ Tcl_PkgRequireProc( * available. */ void *clientDataPtr) { - const char *result = - PkgRequireCore(interp, name, reqc, reqv, clientDataPtr); - - if (result == NULL) { - return TCL_ERROR; + int code = CheckAllRequirements(interp, reqc, reqv); + if (code != TCL_OK) { + return code; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); - return TCL_OK; + return PkgRequireCore(interp, name, reqc, reqv, clientDataPtr); } -static const char * +int PkgRequireCore( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ @@ -424,10 +426,6 @@ PkgRequireCore( char *script, *pkgVersionI; Tcl_DString command; - if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) { - return NULL; - } - /* * It can take up to three passes to find the package: one pass to run the * "package unknown" script, one to run the "package ifneeded" script for @@ -453,7 +451,7 @@ PkgRequireCore( name, (char *) pkgPtr->clientData, name)); AddRequirementsToResult(interp, reqc, reqv); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL); - return NULL; + return TCL_ERROR; } /* @@ -678,7 +676,7 @@ PkgRequireCore( pkgPtr->version = NULL; } pkgPtr->clientData = NULL; - return NULL; + return code; } break; @@ -714,7 +712,7 @@ PkgRequireCore( if (code == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"package unknown\" script)"); - return NULL; + return code; } Tcl_ResetResult(interp); } @@ -725,7 +723,7 @@ PkgRequireCore( "can't find package %s", name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL); AddRequirementsToResult(interp, reqc, reqv); - return NULL; + return TCL_ERROR; } /* @@ -746,7 +744,7 @@ PkgRequireCore( Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL); AddRequirementsToResult(interp, reqc, reqv); - return NULL; + return TCL_ERROR; } } @@ -755,7 +753,8 @@ PkgRequireCore( *ptr = pkgPtr->clientData; } - return pkgPtr->version; + Tcl_SetObjResult(interp, Tcl_NewStringObj(pkgPtr->version, -1)); + return TCL_OK; } /* -- cgit v0.12 From 1a988444125d7bee60784dbe4958d4a428c310b4 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 28 Jan 2018 18:21:09 +0000 Subject: Preparation to provide TclNRPackageObjectCmd: Eliminate the loop in PkgRequireCore so that TclNRAddCallback can be added at the needed spots. This checkin creates a crash in test package-3.12 . Pushing the work off the 8.7.* branch and onto a feature branch for now. --- generic/tclPkg.c | 553 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 277 insertions(+), 276 deletions(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 2b842b4..02f66f0 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -88,6 +88,8 @@ static Package * FindPackage(Tcl_Interp *interp, const char *name); static int PkgRequireCore(Tcl_Interp *interp, const char *name, int reqc, Tcl_Obj *const reqv[], void *clientDataPtr); +static int SelectPackage (Tcl_Interp *interp, const char *name, + Package *pkgPtr, int reqc, Tcl_Obj *const reqv[]); /* * Helper macros. @@ -417,343 +419,342 @@ PkgRequireCore( * available. */ void *clientDataPtr) { - Interp *iPtr = (Interp *) interp; Package *pkgPtr; - PkgAvail *availPtr, *bestPtr, *bestStablePtr; - char *availVersion, *bestVersion, *bestStableVersion; - /* Internal rep. of versions */ - int availStable, code, satisfies, pass; + int code, satisfies; char *script, *pkgVersionI; Tcl_DString command; + pkgPtr = FindPackage(interp, name); + if (pkgPtr->version == NULL) { + code = SelectPackage(interp, name, pkgPtr, reqc, reqv); + if (code != TCL_OK) { + return code; + } + if (pkgPtr->version == NULL) { + /* + * The package is not in the database. If there is a "package unknown" + * command, invoke it. + */ + + script = ((Interp *) interp)->packageUnknown; + if (script != NULL) { + Tcl_DStringInit(&command); + Tcl_DStringAppend(&command, script, -1); + Tcl_DStringAppendElement(&command, name); + AddRequirementsToDString(&command, reqc, reqv); + + code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), + Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); + Tcl_DStringFree(&command); + + if ((code != TCL_OK) && (code != TCL_ERROR)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad return code: %d", code)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); + code = TCL_ERROR; + } + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (\"package unknown\" script)"); + return code; + } + Tcl_ResetResult(interp); + } + /* pkgPtr may now be invalid, so refresh it. */ + pkgPtr = FindPackage(interp, name); + code = SelectPackage(interp, name, pkgPtr, reqc, reqv); + if (code != TCL_OK) { + return code; + } + } + } + + if (pkgPtr->version == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find package %s", name)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL); + AddRequirementsToResult(interp, reqc, reqv); + return TCL_ERROR; + } + /* - * It can take up to three passes to find the package: one pass to run the - * "package unknown" script, one to run the "package ifneeded" script for - * a specific version, and a final pass to lookup the package loaded by - * the "package ifneeded" script. + * Ensure that the provided version meets the current requirements. */ - for (pass=1 ;; pass++) { - pkgPtr = FindPackage(interp, name); - if (pkgPtr->version != NULL) { - break; - } + if (reqc != 0) { + CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL); + satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); - /* - * Check whether we're already attempting to load some version of this - * package (circular dependency detection). - */ + ckfree(pkgVersionI); - if (pkgPtr->clientData != NULL) { + if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "circular package dependency:" - " attempt to provide %s %s requires %s", - name, (char *) pkgPtr->clientData, name)); + "version conflict for package \"%s\": have %s, need", + name, pkgPtr->version)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", + NULL); AddRequirementsToResult(interp, reqc, reqv); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL); return TCL_ERROR; } + } - /* - * The package isn't yet present. Search the list of available - * versions and invoke the script for the best available version. We - * are actually locating the best, and the best stable version. One of - * them is then chosen based on the selection mode. - */ - - bestPtr = NULL; - bestStablePtr = NULL; - bestVersion = NULL; - bestStableVersion = NULL; + if (clientDataPtr) { + const void **ptr = (const void **) clientDataPtr; - for (availPtr = pkgPtr->availPtr; availPtr != NULL; - availPtr = availPtr->nextPtr) { - if (CheckVersionAndConvert(interp, availPtr->version, - &availVersion, &availStable) != TCL_OK) { - /* - * The provided version number has invalid syntax. This - * should not happen. This should have been caught by the - * 'package ifneeded' registering the package. - */ + *ptr = pkgPtr->clientData; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(pkgPtr->version, -1)); + return TCL_OK; +} + +int SelectPackage (Tcl_Interp *interp, const char *name, Package *pkgPtr, int reqc, Tcl_Obj *const reqv[]) { + PkgAvail *availPtr, *bestPtr, *bestStablePtr; + char *availVersion, *bestVersion, *bestStableVersion; + /* Internal rep. of versions */ + char *script; + int availStable, code, satisfies; + Interp *iPtr = (Interp *) interp; - continue; - } + /* + * Check whether we're already attempting to load some version of this + * package (circular dependency detection). + */ - /* Check satisfaction of requirements before considering the current version further. */ - if (reqc > 0) { - satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); - if (!satisfies) { - ckfree(availVersion); - availVersion = NULL; - continue; - } - } + if (pkgPtr->clientData != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "circular package dependency:" + " attempt to provide %s %s requires %s", + name, (char *) pkgPtr->clientData, name)); + AddRequirementsToResult(interp, reqc, reqv); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL); + return TCL_ERROR; + } - if (bestPtr != NULL) { - int res = CompareVersions(availVersion, bestVersion, NULL); + /* + * The package isn't yet present. Search the list of available + * versions and invoke the script for the best available version. We + * are actually locating the best, and the best stable version. One of + * them is then chosen based on the selection mode. + */ - /* - * Note: Used internal reps in the comparison! - */ + bestPtr = NULL; + bestStablePtr = NULL; + bestVersion = NULL; + bestStableVersion = NULL; - if (res > 0) { - /* - * The version of the package sought is better than the - * currently selected version. - */ - ckfree(bestVersion); - bestVersion = NULL; - goto newbest; - } - } else { - newbest: - /* We have found a version which is better than our max. */ + for (availPtr = pkgPtr->availPtr; availPtr != NULL; + availPtr = availPtr->nextPtr) { + if (CheckVersionAndConvert(interp, availPtr->version, + &availVersion, &availStable) != TCL_OK) { + /* + * The provided version number has invalid syntax. This + * should not happen. This should have been caught by the + * 'package ifneeded' registering the package. + */ - bestPtr = availPtr; - CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL); - } + continue; + } - if (!availStable) { + /* Check satisfaction of requirements before considering the current version further. */ + if (reqc > 0) { + satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); + if (!satisfies) { ckfree(availVersion); availVersion = NULL; continue; } + } - if (bestStablePtr != NULL) { - int res = CompareVersions(availVersion, bestStableVersion, NULL); + if (bestPtr != NULL) { + int res = CompareVersions(availVersion, bestVersion, NULL); + + /* + * Note: Used internal reps in the comparison! + */ + if (res > 0) { /* - * Note: Used internal reps in the comparison! + * The version of the package sought is better than the + * currently selected version. */ - - if (res > 0) { - /* - * This stable version of the package sought is better - * than the currently selected stable version. - */ - ckfree(bestStableVersion); - bestStableVersion = NULL; - goto newstable; - } - } else { - newstable: - /* We have found a stable version which is better than our max stable. */ - bestStablePtr = availPtr; - CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL); + ckfree(bestVersion); + bestVersion = NULL; + goto newbest; } + } else { + newbest: + /* We have found a version which is better than our max. */ - ckfree(availVersion); - availVersion = NULL; - } /* end for */ - - /* - * Clean up memorized internal reps, if any. - */ - - if (bestVersion != NULL) { - ckfree(bestVersion); - bestVersion = NULL; + bestPtr = availPtr; + CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL); } - if (bestStableVersion != NULL) { - ckfree(bestStableVersion); - bestStableVersion = NULL; + if (!availStable) { + ckfree(availVersion); + availVersion = NULL; + continue; } - /* - * Now choose a version among the two best. For 'latest' we simply - * take (actually keep) the best. For 'stable' we take the best - * stable, if there is any, or the best if there is nothing stable. - */ - - if ((iPtr->packagePrefer == PKG_PREFER_STABLE) - && (bestStablePtr != NULL)) { - bestPtr = bestStablePtr; - } + if (bestStablePtr != NULL) { + int res = CompareVersions(availVersion, bestStableVersion, NULL); - if (bestPtr != NULL) { /* - * We found an ifneeded script for the package. Be careful while - * executing it: this could cause reentrancy, so (a) protect the - * script itself from deletion and (b) don't assume that bestPtr - * will still exist when the script completes. + * Note: Used internal reps in the comparison! */ - char *versionToProvide = bestPtr->version; - PkgFiles *pkgFiles; - PkgName *pkgName; - script = bestPtr->script; - - pkgPtr->clientData = versionToProvide; - Tcl_Preserve(versionToProvide); - Tcl_Preserve(script); - pkgFiles = TclInitPkgFiles(interp); - /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ - pkgName = ckalloc(sizeof(PkgName) + strlen(name)); - pkgName->nextPtr = pkgFiles->names; - strcpy(pkgName->name, name); - pkgFiles->names = pkgName; - if (bestPtr->pkgIndex) { - TclPkgFileSeen(interp, bestPtr->pkgIndex); - } - code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); - /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ - pkgFiles->names = pkgName->nextPtr; - ckfree(pkgName); - Tcl_Release(script); - - pkgPtr = FindPackage(interp, name); - if (code == TCL_OK) { - Tcl_ResetResult(interp); - if (pkgPtr->version == NULL) { - code = TCL_ERROR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to provide package %s %s failed:" - " no version of package %s provided", - name, versionToProvide, name)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", - NULL); - } else { - char *pvi, *vi; - - if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi, - NULL) != TCL_OK) { - code = TCL_ERROR; - } else if (CheckVersionAndConvert(interp, - versionToProvide, &vi, NULL) != TCL_OK) { - ckfree(pvi); - code = TCL_ERROR; - } else { - int res = CompareVersions(pvi, vi, NULL); - - ckfree(pvi); - ckfree(vi); - if (res != 0) { - code = TCL_ERROR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to provide package %s %s failed:" - " package %s %s provided instead", - name, versionToProvide, - name, pkgPtr->version)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", - "WRONGPROVIDE", NULL); - } - } - } - } else if (code != TCL_ERROR) { - Tcl_Obj *codePtr = Tcl_NewIntObj(code); - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to provide package %s %s failed:" - " bad return code: %s", - name, versionToProvide, TclGetString(codePtr))); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); - TclDecrRefCount(codePtr); - code = TCL_ERROR; - } - - if (code == TCL_ERROR) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"package ifneeded %s %s\" script)", - name, versionToProvide)); - } - Tcl_Release(versionToProvide); - - if (code != TCL_OK) { + if (res > 0) { /* - * Take a non-TCL_OK code from the script as an indication the - * package wasn't loaded properly, so the package system - * should not remember an improper load. - * - * This is consistent with our returning NULL. If we're not - * willing to tell our caller we got a particular version, we - * shouldn't store that version for telling future callers - * either. + * This stable version of the package sought is better + * than the currently selected stable version. */ - - if (pkgPtr->version != NULL) { - ckfree(pkgPtr->version); - pkgPtr->version = NULL; - } - pkgPtr->clientData = NULL; - return code; + ckfree(bestStableVersion); + bestStableVersion = NULL; + goto newstable; } - - break; - } - - /* - * The package is not in the database. If there is a "package unknown" - * command, invoke it (but only on the first pass; after that, we - * should not get here in the first place). - */ - - if (pass > 1) { - break; + } else { + newstable: + /* We have found a stable version which is better than our max stable. */ + bestStablePtr = availPtr; + CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL); } - script = ((Interp *) interp)->packageUnknown; - if (script != NULL) { - Tcl_DStringInit(&command); - Tcl_DStringAppend(&command, script, -1); - Tcl_DStringAppendElement(&command, name); - AddRequirementsToDString(&command, reqc, reqv); + ckfree(availVersion); + availVersion = NULL; + } /* end for */ - code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), - Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); - Tcl_DStringFree(&command); + /* + * Clean up memorized internal reps, if any. + */ - if ((code != TCL_OK) && (code != TCL_ERROR)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad return code: %d", code)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); - code = TCL_ERROR; - } - if (code == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (\"package unknown\" script)"); - return code; - } - Tcl_ResetResult(interp); - } + if (bestVersion != NULL) { + ckfree(bestVersion); + bestVersion = NULL; } - if (pkgPtr->version == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't find package %s", name)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL); - AddRequirementsToResult(interp, reqc, reqv); - return TCL_ERROR; + if (bestStableVersion != NULL) { + ckfree(bestStableVersion); + bestStableVersion = NULL; } /* - * At this point we know that the package is present. Make sure that the - * provided version meets the current requirements. + * Now choose a version among the two best. For 'latest' we simply + * take (actually keep) the best. For 'stable' we take the best + * stable, if there is any, or the best if there is nothing stable. */ - if (reqc != 0) { - CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL); - satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); + if ((iPtr->packagePrefer == PKG_PREFER_STABLE) + && (bestStablePtr != NULL)) { + bestPtr = bestStablePtr; + } - ckfree(pkgVersionI); + if (bestPtr != NULL) { + /* + * We found an ifneeded script for the package. Be careful while + * executing it: this could cause reentrancy, so (a) protect the + * script itself from deletion and (b) don't assume that bestPtr + * will still exist when the script completes. + */ + + char *versionToProvide = bestPtr->version; + PkgFiles *pkgFiles; + PkgName *pkgName; + script = bestPtr->script; + + pkgPtr->clientData = versionToProvide; + Tcl_Preserve(versionToProvide); + Tcl_Preserve(script); + pkgFiles = TclInitPkgFiles(interp); + /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ + pkgName = ckalloc(sizeof(PkgName) + strlen(name)); + pkgName->nextPtr = pkgFiles->names; + strcpy(pkgName->name, name); + pkgFiles->names = pkgName; + if (bestPtr->pkgIndex) { + TclPkgFileSeen(interp, bestPtr->pkgIndex); + } + code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); + /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ + pkgFiles->names = pkgName->nextPtr; + ckfree(pkgName); + Tcl_Release(script); + + pkgPtr = FindPackage(interp, name); + if (code == TCL_OK) { + Tcl_ResetResult(interp); + if (pkgPtr->version == NULL) { + code = TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "attempt to provide package %s %s failed:" + " no version of package %s provided", + name, versionToProvide, name)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", + NULL); + } else { + char *pvi, *vi; + + if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi, + NULL) != TCL_OK) { + code = TCL_ERROR; + } else if (CheckVersionAndConvert(interp, + versionToProvide, &vi, NULL) != TCL_OK) { + ckfree(pvi); + code = TCL_ERROR; + } else { + int res = CompareVersions(pvi, vi, NULL); + + ckfree(pvi); + ckfree(vi); + if (res != 0) { + code = TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "attempt to provide package %s %s failed:" + " package %s %s provided instead", + name, versionToProvide, + name, pkgPtr->version)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", + "WRONGPROVIDE", NULL); + } + } + } + } else if (code != TCL_ERROR) { + Tcl_Obj *codePtr = Tcl_NewIntObj(code); - if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "version conflict for package \"%s\": have %s, need", - name, pkgPtr->version)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", - NULL); - AddRequirementsToResult(interp, reqc, reqv); - return TCL_ERROR; + "attempt to provide package %s %s failed:" + " bad return code: %s", + name, versionToProvide, TclGetString(codePtr))); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); + TclDecrRefCount(codePtr); + code = TCL_ERROR; } - } - if (clientDataPtr) { - const void **ptr = (const void **) clientDataPtr; + if (code == TCL_ERROR) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"package ifneeded %s %s\" script)", + name, versionToProvide)); + } + Tcl_Release(versionToProvide); - *ptr = pkgPtr->clientData; + if (code != TCL_OK) { + /* + * Take a non-TCL_OK code from the script as an indication the + * package wasn't loaded properly, so the package system + * should not remember an improper load. + * + * This is consistent with our returning NULL. If we're not + * willing to tell our caller we got a particular version, we + * shouldn't store that version for telling future callers + * either. + */ + + if (pkgPtr->version != NULL) { + ckfree(pkgPtr->version); + pkgPtr->version = NULL; + } + pkgPtr->clientData = NULL; + return code; + } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(pkgPtr->version, -1)); return TCL_OK; } -- cgit v0.12 From 77821adfe89e6c3507ef12250dec40cf04ff8a0e Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 31 Jan 2018 00:07:22 +0000 Subject: Fix segmentation fault triggered by test package-3.12. Adapt signature of PkgRequireCore to conform to Tcl_ObjCmdProc, and call it in Tcl_PkgRequireProc on an NRE trampoline via Tcl_NRCallObjProc. Additional callbacks still needed to fully NRE-enable [package require]. --- generic/tclInt.h | 1 + generic/tclPkg.c | 83 ++++++++++++++++++++++++++++++++------------------------ 2 files changed, 49 insertions(+), 35 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index a3bd8ba..20d340e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2782,6 +2782,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 02f66f0..ce00fbf 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -65,6 +65,12 @@ typedef struct Package { const void *clientData; /* Client data. */ } Package; +typedef struct Require { + void * clientDataPtr; + const char *name; + Package *pkgPtr; +} Require; + /* * Prototypes for functions defined in this file: */ @@ -85,11 +91,10 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); -static int PkgRequireCore(Tcl_Interp *interp, const char *name, - int reqc, Tcl_Obj *const reqv[], - void *clientDataPtr); -static int SelectPackage (Tcl_Interp *interp, const char *name, - Package *pkgPtr, int reqc, Tcl_Obj *const reqv[]); +static int PkgRequireCore(ClientData clientData, Tcl_Interp *interp, + int reqc, Tcl_Obj *const reqv[]); +static int SelectPackage (Tcl_Interp *interp, Require *reqPtr, + int reqc, Tcl_Obj *const reqv[]); /* * Helper macros. @@ -402,35 +407,41 @@ Tcl_PkgRequireProc( void *clientDataPtr) { int code = CheckAllRequirements(interp, reqc, reqv); + Require require; if (code != TCL_OK) { return code; } - return PkgRequireCore(interp, name, reqc, reqv, clientDataPtr); + require.clientDataPtr = clientDataPtr; + require.name = name; + require.pkgPtr = NULL; + return Tcl_NRCallObjProc(interp, PkgRequireCore, &require, reqc, reqv); } int PkgRequireCore( + ClientData clientData, Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - const char *name, /* Name of desired package. */ int reqc, /* Requirements constraining the desired * version. */ - Tcl_Obj *const reqv[], /* 0 means to use the latest version + Tcl_Obj *const reqv[] /* 0 means to use the latest version * available. */ - void *clientDataPtr) + ) { - Package *pkgPtr; int code, satisfies; - char *script, *pkgVersionI; Tcl_DString command; + Require *reqPtr = clientData; + char *script, *pkgVersionI; + const char *name = reqPtr->name /* Name of desired package. */; + void *clientDataPtr = reqPtr->clientDataPtr; - pkgPtr = FindPackage(interp, name); - if (pkgPtr->version == NULL) { - code = SelectPackage(interp, name, pkgPtr, reqc, reqv); + reqPtr->pkgPtr = FindPackage(interp, name); + if (reqPtr->pkgPtr->version == NULL) { + code = SelectPackage(interp, reqPtr, reqc, reqv); if (code != TCL_OK) { return code; } - if (pkgPtr->version == NULL) { + if (reqPtr->pkgPtr->version == NULL) { /* * The package is not in the database. If there is a "package unknown" * command, invoke it. @@ -459,17 +470,17 @@ PkgRequireCore( return code; } Tcl_ResetResult(interp); - } - /* pkgPtr may now be invalid, so refresh it. */ - pkgPtr = FindPackage(interp, name); - code = SelectPackage(interp, name, pkgPtr, reqc, reqv); - if (code != TCL_OK) { - return code; + /* pkgPtr may now be invalid, so refresh it. */ + reqPtr->pkgPtr = FindPackage(interp, name); + code = SelectPackage(interp, reqPtr, reqc, reqv); + if (code != TCL_OK) { + return code; + } } } } - if (pkgPtr->version == NULL) { + if (reqPtr->pkgPtr->version == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't find package %s", name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL); @@ -482,7 +493,7 @@ PkgRequireCore( */ if (reqc != 0) { - CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL); + CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL); satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); ckfree(pkgVersionI); @@ -490,7 +501,7 @@ PkgRequireCore( if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "version conflict for package \"%s\": have %s, need", - name, pkgPtr->version)); + name, reqPtr->pkgPtr->version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL); AddRequirementsToResult(interp, reqc, reqv); @@ -501,18 +512,20 @@ PkgRequireCore( if (clientDataPtr) { const void **ptr = (const void **) clientDataPtr; - *ptr = pkgPtr->clientData; + *ptr = reqPtr->pkgPtr->clientData; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(pkgPtr->version, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1)); return TCL_OK; } -int SelectPackage (Tcl_Interp *interp, const char *name, Package *pkgPtr, int reqc, Tcl_Obj *const reqv[]) { +int SelectPackage (Tcl_Interp *interp, Require *reqPtr, int reqc, Tcl_Obj *const reqv[]) { PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion, *bestStableVersion; /* Internal rep. of versions */ char *script; int availStable, code, satisfies; + const char *name = reqPtr->name; + Package *pkgPtr = reqPtr->pkgPtr; Interp *iPtr = (Interp *) interp; /* @@ -678,10 +691,10 @@ int SelectPackage (Tcl_Interp *interp, const char *name, Package *pkgPtr, int re ckfree(pkgName); Tcl_Release(script); - pkgPtr = FindPackage(interp, name); + reqPtr->pkgPtr = FindPackage(interp, name); if (code == TCL_OK) { Tcl_ResetResult(interp); - if (pkgPtr->version == NULL) { + if (reqPtr->pkgPtr->version == NULL) { code = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" @@ -692,7 +705,7 @@ int SelectPackage (Tcl_Interp *interp, const char *name, Package *pkgPtr, int re } else { char *pvi, *vi; - if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi, + if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi, NULL) != TCL_OK) { code = TCL_ERROR; } else if (CheckVersionAndConvert(interp, @@ -710,7 +723,7 @@ int SelectPackage (Tcl_Interp *interp, const char *name, Package *pkgPtr, int re "attempt to provide package %s %s failed:" " package %s %s provided instead", name, versionToProvide, - name, pkgPtr->version)); + name, reqPtr->pkgPtr->version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "WRONGPROVIDE", NULL); } @@ -747,11 +760,11 @@ int SelectPackage (Tcl_Interp *interp, const char *name, Package *pkgPtr, int re * either. */ - if (pkgPtr->version != NULL) { - ckfree(pkgPtr->version); - pkgPtr->version = NULL; + if (reqPtr->pkgPtr->version != NULL) { + ckfree(reqPtr->pkgPtr->version); + reqPtr->pkgPtr->version = NULL; } - pkgPtr->clientData = NULL; + reqPtr->pkgPtr->clientData = NULL; return code; } } -- cgit v0.12 From 66b69b8d36c7218cee80e94890e1e6fb9b27fcc2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 31 Jan 2018 12:18:58 +0000 Subject: Change Tcl_Token definition (int -> size_t). Many related code-changes. --- doc/ParseCmd.3 | 4 ++-- generic/tcl.h | 4 ++-- generic/tclAssembly.c | 2 +- generic/tclCmdMZ.c | 3 ++- generic/tclCompCmds.c | 12 +++++++----- generic/tclCompCmdsGR.c | 8 +++++--- generic/tclCompCmdsSZ.c | 10 ++++++---- generic/tclCompExpr.c | 10 +++++----- generic/tclCompile.c | 6 +++--- generic/tclCompile.h | 2 +- generic/tclDictObj.c | 3 ++- generic/tclInt.decls | 2 +- generic/tclInt.h | 4 ++-- generic/tclIntDecls.h | 4 ++-- generic/tclListObj.c | 3 ++- generic/tclParse.c | 9 +++++---- generic/tclUtf.c | 2 +- generic/tclUtil.c | 15 ++++++++------- 18 files changed, 57 insertions(+), 46 deletions(-) diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 01b4065..41f43cb 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -208,8 +208,8 @@ typedef struct Tcl_Parse { typedef struct Tcl_Token { int \fItype\fR; const char *\fIstart\fR; - int \fIsize\fR; - int \fInumComponents\fR; + size_t \fIsize\fR; + size_t \fInumComponents\fR; } \fBTcl_Token\fR; .CE .PP diff --git a/generic/tcl.h b/generic/tcl.h index 7c07f5f..a11cb44 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1716,8 +1716,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - int size; /* Number of bytes in token. */ - int numComponents; /* If this token is composed of other tokens, + size_t size; /* Number of bytes in token. */ + size_t numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 4c5ae68..60be03d 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -979,7 +979,7 @@ TclCompileAssembleCmd( Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", - parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, + (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, Tcl_GetErrorLine(interp))); envPtr->numCommands = numCommands; envPtr->codeNext = envPtr->codeStart + offset; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d867172..5f46fee 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1756,7 +1756,8 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + int lenRemain; + size_t elemSize; register const char *p; string1 = TclGetStringFromObj(objPtr, &length1); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index b9bc228..3823364 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1084,7 +1084,8 @@ TclCompileDictIncrCmd( if (parsePtr->numWords == 4) { const char *word; - int numBytes, code; + size_t numBytes; + int code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; @@ -3346,7 +3347,7 @@ TclLocalScalarFromToken( int TclLocalScalar( const char *bytes, - int numBytes, + size_t numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, @@ -3397,9 +3398,10 @@ TclPushVarName( { register const char *p; const char *name, *elName; - register int i, n; + register size_t i, n; Tcl_Token *elemTokenPtr = NULL; - int nameChars, elNameChars, simpleVarName, localIndex; + size_t nameChars, elNameChars; + int simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* @@ -3471,7 +3473,7 @@ TclPushVarName( } } if (simpleVarName) { - int remainingChars; + size_t remainingChars; /* * Check the last token: if it is just ')', do not count it. diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index ff5495c..24553ba 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -196,7 +196,8 @@ TclCompileIfCmd( * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpIndex = 0; /* Avoid compiler warning. */ - int jumpFalseDist, numWords, wordIdx, numBytes, j, code; + size_t numBytes; + int jumpFalseDist, numWords, wordIdx, j, code; const char *word; int realCond = 1; /* Set to 0 for static conditions: * "if 0 {..}" */ @@ -514,7 +515,7 @@ TclCompileIncrCmd( incrTokenPtr = TokenAfter(varTokenPtr); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { const char *word = incrTokenPtr[1].start; - int numBytes = incrTokenPtr[1].size; + size_t numBytes = incrTokenPtr[1].size; int code; Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); @@ -2204,7 +2205,8 @@ TclCompileRegexpCmd( { Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ - int i, len, nocase, exact, sawLast, simple; + size_t len; + int i, nocase, exact, sawLast, simple; const char *str; DefineLineInformation; /* TIP #280 */ diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 25d10d6..d101899 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -789,7 +789,8 @@ TclCompileStringMatchCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; - int i, length, exactMatch = 0, nocase = 0; + size_t length; + int i, exactMatch = 0, nocase = 0; const char *str; if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { @@ -1480,7 +1481,8 @@ TclSubstCompile( */ if (tokenPtr->numComponents > 1) { - int i, foundCommand = 0; + size_t i; + int foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { @@ -1753,7 +1755,7 @@ TclCompileSwitchCmd( */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { - register unsigned size = tokenPtr[1].size; + register size_t size = tokenPtr[1].size; register const char *chrs = tokenPtr[1].start; /* @@ -1844,7 +1846,7 @@ TclCompileSwitchCmd( if (numWords == 1) { const char *bytes; - int maxLen, numBytes; + size_t maxLen, numBytes; int bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index a77077c..b5802b0 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -571,7 +571,7 @@ ParseExpr( * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ - int scanned = 0; /* Capture number of byte scanned by parsing + size_t scanned = 0; /* Capture number of byte scanned by parsing * routines. */ int lastParsed; /* Stores info about what the lexeme parsed * the previous pass through the parsing loop @@ -615,7 +615,7 @@ ParseExpr( * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ - const int limit = 25; /* Portions of the error message are + const unsigned limit = 25; /* Portions of the error message are * constructed out of substrings of the * original expression. In order to keep the * error message readable, we impose this @@ -1406,7 +1406,7 @@ ParseExpr( Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < parsePtr->string) ? "" : "...", ((start - limit) < parsePtr->string) - ? (int) (start - parsePtr->string) : limit - 3, + ? (int) (start - parsePtr->string) : (int)limit - 3, ((start - limit) < parsePtr->string) ? parsePtr->string : start - limit + 3, (scanned < limit) ? scanned : limit - 3, start, @@ -1434,8 +1434,8 @@ ParseExpr( numBytes = parsePtr->end - parsePtr->string; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing expression \"%.*s%s\")", - (numBytes < limit) ? numBytes : limit - 3, - parsePtr->string, (numBytes < limit) ? "" : "...")); + (numBytes < (int)limit) ? numBytes : (int)limit - 3, + parsePtr->string, (numBytes < (int)limit) ? "" : "...")); if (errCode) { Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode, subErrCode, NULL); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 52c1f11..f463820 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2276,8 +2276,8 @@ TclCompileVarSubst( CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - int nameBytes = tokenPtr[1].size; - int i, localVar, localVarName = 1; + size_t i, nameBytes = tokenPtr[1].size; + int localVar, localVarName = 1; /* * Determine how the variable name should be handled: if it contains any @@ -2485,7 +2485,7 @@ TclCompileTokens( default: Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s", - tokenPtr->type, tokenPtr->size, tokenPtr->start); + tokenPtr->type, (int)tokenPtr->size, tokenPtr->start); } } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 0730c08..1620c5d 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1138,7 +1138,7 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif -MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes, +MODULE_SCOPE int TclLocalScalar(const char *bytes, size_t numBytes, CompileEnv *envPtr); MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 1943a07..910bf7f 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -642,7 +642,8 @@ SetDictFromAny( while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; - int elemSize, literal; + size_t elemSize; + int literal; if (TclFindDictElement(interp, nextElem, (limit - nextElem), &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 1776679..1b7411f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -108,7 +108,7 @@ declare 16 { declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *bracePtr) + size_t *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) diff --git a/generic/tclInt.h b/generic/tclInt.h index dfd255a..54c5691 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2875,7 +2875,7 @@ MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *literalPtr); + size_t *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, @@ -3032,7 +3032,7 @@ MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE int TclParseBackslash(const char *src, - int numBytes, int *readPtr, char *dst); + int numBytes, size_t *readPtr, char *dst); MODULE_SCOPE int TclParseHex(const char *src, int numBytes, int *resultPtr); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 837ebae..5e65c9f 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -89,7 +89,7 @@ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); EXTERN int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); @@ -605,7 +605,7 @@ typedef struct TclIntStubs { void (*reserved19)(void); void (*reserved20)(void); void (*reserved21)(void); - int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */ + int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ int (*tclFormatInt) (char *buffer, long n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 25e775c..2993241 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1870,7 +1870,8 @@ SetListFromAny( while (nextElem < limit) { const char *elemStart; - int elemSize, literal; + size_t elemSize; + int literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { diff --git a/generic/tclParse.c b/generic/tclParse.c index a2227f7..b012222a 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -385,7 +385,7 @@ Tcl_ParseCommand( /* Haven't seen prefix already */ && (1 == parsePtr->numTokens - expIdx) /* Only one token */ - && (((1 == (size_t) expPtr->size) + && (((1 == expPtr->size) /* Same length as prefix */ && (expPtr->start[0] == '*'))) /* Is the prefix */ @@ -466,7 +466,7 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { - int size; + size_t size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); @@ -821,7 +821,7 @@ TclParseBackslash( const char *src, /* Points to the backslash character of a a * backslash sequence. */ int numBytes, /* Max number of bytes to scan. */ - int *readPtr, /* NULL, or points to storage where the number + size_t *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be @@ -1649,7 +1649,8 @@ Tcl_ParseBraces( { Tcl_Token *tokenPtr; register const char *src; - int startIndex, level, length; + int startIndex, level; + size_t length; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 6153a92..659d358 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -798,7 +798,7 @@ Tcl_UtfBackslash( * backslash sequence. */ { #define LINE_LENGTH 128 - int numRead; + size_t numRead; int result; result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0bc27fd..3c125d4 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -107,7 +107,7 @@ static void UpdateStringOfEndOffset(Tcl_Obj *objPtr); static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, size_t *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that @@ -493,7 +493,7 @@ TclFindElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -522,7 +522,7 @@ TclFindDictElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * element (next arg or end of list). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -554,7 +554,7 @@ FindElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list/dict). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -569,7 +569,7 @@ FindElement( int openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; int size = 0; /* lint. */ - int numChars; + size_t numChars; int literal = 1; const char *p2; @@ -792,7 +792,7 @@ TclCopyAndCollapse( char c = *src; if (c == '\\') { - int numRead; + size_t numRead; int backslashCount = TclParseBackslash(src, count, &numRead, dst); dst += backslashCount; @@ -851,7 +851,8 @@ Tcl_SplitList( { const char **argv, *end, *element; char *p; - int length, size, i, result, elSize; + int length, size, i, result; + size_t elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) -- cgit v0.12 From 98887219c2dcf8b1fd6debaf3c716f6a809d2a84 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 3 Feb 2018 18:15:06 +0000 Subject: Refine documentation for Tcl_NR* functions. --- doc/Eval.3 | 8 +- doc/NRE.3 | 260 ++++++++++++++++++++----------------------------------------- 2 files changed, 88 insertions(+), 180 deletions(-) diff --git a/doc/Eval.3 b/doc/Eval.3 index 191bace..e241794 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -176,10 +176,10 @@ it is faster to execute the script directly. .TP 23 \fBTCL_EVAL_GLOBAL\fR . -If this flag is set, the script is processed at global level. This -means that it is evaluated in the global namespace and its variable -context consists of global variables only (it ignores any Tcl -procedures that are active). +If this flag is set, the script is evaluated in the global namespace instead of +the current namespace and its variable context consists of global variables +only (it ignores any Tcl procedures that are active). +.\" TODO: document TCL_EVAL_INVOKE and TCL_EVAL_NOERR. .SH "MISCELLANEOUS DETAILS" .PP diff --git a/doc/NRE.3 b/doc/NRE.3 index ff0d108..6078a53 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -1,5 +1,6 @@ .\" .\" Copyright (c) 2008 by Kevin B. Kenny. +.\" Copyright (c) 2018 by Nathan Coulter. .\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -38,43 +39,39 @@ void .SH ARGUMENTS .AS Tcl_CmdDeleteProc *interp in .AP Tcl_Interp *interp in -Interpreter in which to create or evaluate a command. +The relevant Interpreter. .AP char *cmdName in -Name of a new command to create. +Name of the command to create. .AP Tcl_ObjCmdProc *proc in -Implementation of a command that will be called whenever \fIcmdName\fR -is invoked as a command in the unoptimized way. +Called in order to evaluate a command. Is often just a small wrapper that uses +\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves +in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3) +(\fIq.v.\fR). .AP Tcl_ObjCmdProc *nreProc in -Implementation of a command that will be called whenever \fIcmdName\fR -is invoked and requested to conserve the C stack. +Called instead of \fIproc\fR when a trampoline is already in use. .AP ClientData clientData in -Arbitrary one-word value that will be passed to \fIproc\fR, \fInreProc\fR, -\fIdeleteProc\fR and \fIobjProc\fR. +Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR +and \fIobjProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in/out -Procedure to call before \fIcmdName\fR is deleted from the interpreter. -This procedure allows for command-specific cleanup. If \fIdeleteProc\fR -is \fBNULL\fR, then no procedure is called before the command is deleted. +Called before \fIcmdName\fR is deleted from the interpreter, allowing for +command-specific cleanup. May be NULL. .AP int objc in -Count of parameters provided to the implementation of a command. +Number of items in \fIobjv\fR. .AP Tcl_Obj **objv in -Pointer to an array of Tcl values. Each value holds the value of a -single word in the command to execute. +Words in the command. .AP Tcl_Obj *objPtr in -Pointer to a Tcl_Obj whose value is a script or expression to execute. +A script or expression to evaluate. .AP int flags in -ORed combination of flag bits that specify additional options. -\fBTCL_EVAL_GLOBAL\fR is the only flag that is currently supported. -.\" TODO: This is a lie. But kbk didn't grasp TCL_EVAL_INVOKE and -.\" TCL_EVAL_NOERR well enough to document them. +As described for \fITcl_EvalObjv\fR. +.PP .AP Tcl_Command cmd in -Token for a command that is to be used instead of the currently -executing command. +Token to use instead of one derived from the first word of \fIobjv\fR in order +to evaluate a command. .AP Tcl_Obj *resultPtr out -Pointer to an unshared Tcl_Obj where the result of expression -evaluation is written. +Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if +the return code is TCL_OK. .AP Tcl_NRPostProc *postProcPtr in -Pointer to a function that will be invoked when the command currently -executing in the interpreter designated by \fIinterp\fR completes. +A function to push. .AP ClientData data0 in .AP ClientData data1 in .AP ClientData data2 in @@ -84,98 +81,51 @@ to the function designated by \fIpostProcPtr\fR when it is invoked. .BE .SH DESCRIPTION .PP -This series of C functions provides an interface whereby commands that -are implemented in C can be evaluated, and invoke Tcl commands scripts -and scripts, without consuming space on the C stack. The non-recursive -evaluation is done by installing a \fItrampoline\fR, a small piece of -code that invokes a command or script, and then executes a series of -callbacks when the command or script returns. -.PP -The \fBTcl_NRCreateCommand\fR function creates a Tcl command in the -interpreter designated by \fIinterp\fR that is prepared to handle -nonrecursive evaluation with a trampoline. The \fIcmdName\fR argument -gives the name of the new command. If \fIcmdName\fR contains any -namespace qualifiers, then the new command is added to the specified -namespace; otherwise, it is added to the global namespace. \fIproc\fR -gives the procedure that will be called when the interpreter wishes to -evaluate the command in an unoptimized manner, and \fInreProc\fR is -the procedure that will be called when the interpreter wishes to -evaluate the command using a trampoline. \fIdeleteProc\fR is a -function that will be called before the command is deleted from the -interpreter. When any of the three functions is invoked, it is passed -the \fIclientData\fR parameter. -.PP -\fBTcl_NRCreateCommand\fR deletes any existing command -\fIname\fR already associated with the interpreter -(however see below for an exception where the existing command -is not deleted). -It returns a token that may be used to refer -to the command in subsequent calls to \fBTcl_GetCommandName\fR. -If \fBTcl_NRCreateCommand\fR is called for an interpreter that is in -the process of being deleted, then it does not create a new command, -does not delete any existing command of the same name, and returns NULL. -.PP -The \fIproc\fR and \fInreProc\fR function are expected to conform to -all the rules set forth for the \fIproc\fR argument to -\fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR). -.PP -When a command that is written to cope with evaluation via trampoline -is invoked without a trampoline on the stack, it will usually respond -to the invocation by creating a trampoline and calling the -trampoline-enabled implementation of the same command. This call is done by -means of \fBTcl_NRCallObjProc\fR. In the call to -\fBTcl_NRCallObjProc\fR, the \fIinterp\fR, \fIclientData\fR, -\fIobjc\fR and \fIobjv\fR parameters should be the same ones that were -passed to \fIproc\fR. The \fInreProc\fR parameter should designate the -trampoline-enabled implementation of the command. -.PP -\fBTcl_NREvalObj\fR arranges for the script contained in \fIobjPtr\fR -to be evaluated in the interpreter designated by \fIinterp\fR after -the current command (which must be trampoline-enabled) returns. It is -the method by which a command may invoke a script without consuming -space on the C stack. Similarly, \fBTcl_NREvalObjv\fR arranges to -invoke a single Tcl command whose words have already been separated -and substituted. The \fIobjc\fR and \fIobjv\fR parameters give the -words of the command to be evaluated when execution reaches the -trampoline. -.PP -\fBTcl_NRCmdSwap\fR allows for trampoline evaluation of a command whose -resolution is already known. The \fIcmd\fR parameter gives a -\fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or -\fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in -the trampoline; this command must match the word in \fIobjv[0]\fR. -The remaining arguments are as for \fBTcl_NREvalObjv\fR. -.PP -\fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR -all accept a \fIflags\fR parameter, which is an OR-ed-together set of -bits to control evaluation. At the present time, the only supported flag -available to callers is \fBTCL_EVAL_GLOBAL\fR. -.\" TODO: Again, this is a lie. Do we want to explain TCL_EVAL_INVOKE -.\" and TCL_EVAL_NOERR? -If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is -evaluated in the global namespace. If it is not set, it is evaluated -in the current namespace. -.PP -\fBTcl_NRExprObj\fR arranges for the expression contained in \fIobjPtr\fR -to be evaluated in the interpreter designated by \fIinterp\fR after -the current command (which must be trampoline-enabled) returns. It is -the method by which a command may evaluate a Tcl expression without consuming -space on the C stack. The argument \fIresultPtr\fR is a pointer to an -unshared Tcl_Obj where the result of expression evaluation is to be written. -If expression evaluation returns any code other than TCL_OK, the -\fIresultPtr\fR value is left untouched. -.PP -All of the routines return \fBTCL_OK\fR if command or expression invocation -has been scheduled successfully. If for any reason the scheduling cannot -be completed (for example, if the interpreter is unable to find -the requested command), they return \fBTCL_ERROR\fR with an -appropriate message left in the interpreter's result. -.PP -\fBTcl_NRAddCallback\fR arranges to have a C function called when the -current trampoline-enabled command in the Tcl interpreter designated -by \fIinterp\fR returns. The \fIpostProcPtr\fR argument is a pointer -to the callback function, which must have arguments and return value -consistent with the \fBTcl_NRPostProc\fR data type: +These functions provide an interface to the function stack that an interpreter +iterates through to evaluate commands. The routine behind a command is +implemented by an initial function and any additional functions that the +routine pushes onto the stack as it progresses. The interpreter itself pushes +functions onto the stack to react to the end of a routine and to exercise other +forms of control such as switching between in-progress stacks and the +evaluation of other scripts at additional levels without adding frames to the C +stack. To execute a routine, the initial function for the routine is called +and then a small bit of code called a \fItrampoline\fR iteratively takes +functions off the stack and calls them, using the value of the last call as the +value of the routine. +.PP +\fBTcl_NRCallObjProc\fR calls \fInreProc\fR using a new trampoline. +.PP +\fBTcl_NRCreateCommand\fR, an alternative to \fBTcl_CreateObjCommand\fR, +resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the +current namespace, creates a command by that name, and returns a token for the +command which may be used in subsequent calls to \fBTcl_GetCommandName\fR. +Except for a few cases noted below any existing command by the same name is +first deleted. If \fIinterp\fR is in the process of being deleted +\fBTcl_NRCreateCommand\fR does not create any command, does not delete any +command, and returns NULL. +.PP +\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but +consumes no space on the C stack. +.PP +\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but +consumes no space on the C stack. +.PP +\fBTcl_NRCmdSwap\fR is like \fBTcl_NREvalObjv\fR, but uses \fIcmd\fR, a token +previously returned by \fBTcl_CreateObjCommand\fR or +\fBTcl_GetCommandFromObj\fR, instead of resolving the first word of \fIobjv\fR. +. The name of this command must be the same as \fIobjv[0]\fR. +.PP +\fBTcl_NRExprObj\fR pushes a function that evaluates \fIobjPtr\fR as an +expression in the same manner as \fBTcl_ExprObj\fR but without consuming space +on the C stack. +.PP +All of the functions return \fBTCL_OK\fR if the evaluation of the script, +command, or expression has been scheduled successfully. Otherwise (for example +if the command name cannot be resolved), they return \fBTCL_ERROR\fR and store +a message as the interpreter's result. +.PP +\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR. The signature for +\fBTcl_NRPostProc\fR is: .PP .CS typedef int @@ -185,25 +135,13 @@ typedef int int \fIresult\fR); .CE .PP -When the trampoline invokes the callback function, the \fIdata\fR -parameter will point to an array containing the four one-word -quantities that were passed to \fBTcl_NRAddCallback\fR in the -\fIdata0\fR through \fIdata3\fR parameters. The Tcl interpreter will -be designated by the \fIinterp\fR parameter, and the \fIresult\fR -parameter will contain the result (\fBTCL_OK\fR, \fBTCL_ERROR\fR, -\fBTCL_RETURN\fR, \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR) that was -returned by the command evaluation. The callback function is expected, -in turn, either to return a \fIresult\fR to control further evaluation. -.PP -Multiple \fBTcl_NRAddCallback\fR invocations may request multiple -callbacks, which may be to the same or different callback -functions. If multiple callbacks are requested, they are executed in -last-in, first-out order, that is, the most recently requested -callback is executed first. +\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR. +\fIresult\fR is the value returned by the previous function implementing part +the routine. .SH EXAMPLE .PP -The usual pattern for Tcl commands that invoke other Tcl commands -is something like: +The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C +stack, to evalute a script: .PP .CS int @@ -228,28 +166,17 @@ int \fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc); .CE .PP -To enable a command like this one for trampoline-based evaluation, -it must be split into three pieces: -.IP \(bu -A non-trampoline implementation, \fITheCmdNewObjProc\fR, -which will simply create a trampoline -and invoke the trampoline-based implementation. -.IP \(bu -A trampoline-enabled implementation, \fITheCmdNRObjProc\fR. This -function will perform the initialization, request that the trampoline -call the postprocessing routine after command evaluation, and finally, -request that the trampoline call the inner command. -.IP \(bu -A postprocessing routine, \fITheCmdPostProc\fR. This function will -perform the postprocessing formerly done after the return from the -inner command in \fITheCmdObjProc\fR. -.PP -The non-trampoline implementation is simple and stylized, containing -a single statement: +To avoid consuming space on the C stack, \fITheCmdOldObjProc\fR is renamed to +\fITheCmdNRObjProc\fR and the postprocessing step is split into a separate +function, \fITheCmdPostProc\fR, which is pushed onto the function stack. +\fITcl_EvalObjEx\fR is replaced with \fITcl_NREvalObj\fR, which uses a +trampoline instead of consuming space on the C stack. A new version of +\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to +call \fITheCmdNRObjProc\fR: .PP .CS int -\fITheCmdNewObjProc\fR( +\fITheCmdOldObjProc\fR( ClientData clientData, Tcl_Interp *interp, int objc, @@ -260,9 +187,6 @@ int } .CE .PP -The trampoline-enabled implementation requests postprocessing, -and returns to the trampoline requesting command evaluation. -.PP .CS int \fITheCmdNRObjProc\fR @@ -284,9 +208,6 @@ int } .CE .PP -The postprocessing procedure does whatever the original command did -upon return from the inner evaluation. -.PP .CS int \fITheCmdNRPostProc\fR( @@ -303,26 +224,13 @@ int } .CE .PP -If \fItheCommand\fR is a command that results in multiple commands or -scripts being evaluated, its postprocessing routine may schedule -additional postprocessing and then request another command evaluation -by means of \fBTcl_NREvalObj\fR or one of the other evaluation -routines. Looping and sequencing constructs may be implemented in this way. -.PP -Finally, to install a trampoline-enabled command in the interpreter, -\fBTcl_NRCreateCommand\fR is used in place of -\fBTcl_CreateObjCommand\fR. It accepts two command procedures instead -of one. The first is for use when no trampoline is yet on the stack, -and the second is for use when there is already a trampoline in place. +Any function comprising a routine can push other functions, making it possible +implement looping and sequencing constructs using the function stack. .PP -.CS -\fBTcl_NRCreateCommand\fR(interp, "theCommand", - \fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData, - TheCmdDeleteProc); -.CE .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3) .SH KEYWORDS stackless, nonrecursive, execute, command, global, value, result, script .SH COPYRIGHT -Copyright (c) 2008 by Kevin B. Kenny +Copyright (c) 2008 by Kevin B. Kenny. +Copyright (c) 2018 by Nathan Coulter. -- cgit v0.12 From da7f77f96f74cf57e80421226d7bf1e93d776f58 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 5 Feb 2018 13:33:21 +0000 Subject: Improved overflow prevention. --- generic/tclStringObj.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index ae75e44..8437555 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -140,8 +140,8 @@ GrowStringBuffer( objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { - attempt = 2 * needed; - if (attempt >= 0) { + if (needed <= INT_MAX / 2) { + attempt = 2 * needed; ptr = attemptckrealloc(objPtr->bytes, attempt + 1); } if (ptr == NULL) { -- cgit v0.12 From 3be49723fced40ef581ccd12dbeb35b8cf346b12 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 5 Feb 2018 13:41:26 +0000 Subject: Improved overflow prevention. --- generic/tclStringObj.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 8437555..c3a0192 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -190,8 +190,8 @@ GrowUnicodeBuffer( * Subsequent appends - apply the growth algorithm. */ - attempt = 2 * needed; - if (attempt >= 0 && attempt <= STRING_MAXCHARS) { + if (needed <= STRING_MAXCHARS / 2) { + attempt = 2 * needed; ptr = stringAttemptRealloc(stringPtr, attempt); } if (ptr == NULL) { -- cgit v0.12 From 836fa11775ae940ca572c7c330afbae5a7632d5b Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 5 Feb 2018 16:10:02 +0000 Subject: Revise TclStringRepeat() interface so that in place operations are done only by caller request. Establish a re-usable pattern. --- generic/tclCmdMZ.c | 9 +++++---- generic/tclInt.h | 15 +++++++++++++-- generic/tclStringObj.c | 31 +++++++++++++++---------------- 3 files changed, 33 insertions(+), 22 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 1fc2d17..e0344ef 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2294,11 +2294,12 @@ StringReptCmd( return TCL_OK; } - if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) { - return TCL_ERROR; + resultPtr = TclStringRepeat(interp, objv[1], count, TCL_STRING_IN_PLACE); + if (resultPtr) { + Tcl_SetObjResult(interp, resultPtr); + return TCL_OK; } - Tcl_SetObjResult(interp, resultPtr); - return TCL_OK; + return TCL_ERROR; } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index a3bd8ba..cee1d3a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3201,8 +3201,6 @@ MODULE_SCOPE int TclStringMatch(const char *str, int strLen, MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr); -MODULE_SCOPE int TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, - int count, Tcl_Obj **objPtrPtr); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, int line, struct CompileEnv *envPtr); @@ -4008,6 +4006,19 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, struct CompileEnv *envPtr); /* + * Routines that provide the [string] ensemble functionality. Possible + * candidates for public interface. + */ + +MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, + int count, int flags); + +/* Flag values for the [string] ensemble functions. */ + +#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */ +#define TCL_STRING_IN_PLACE (1<<1) + +/* * Functions defined in generic/tclVar.c and currently exported only for use * by the bytecode compiler and engine. Some of these could later be placed in * the public interface. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c3a0192..8bb76c1 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2708,23 +2708,24 @@ TclGetStringStorage( * Performs the [string repeat] function. * * Results: - * A standard Tcl result. + * A (Tcl_Obj *) pointing to the result value, or NULL in case of an + * error. * * Side effects: - * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation - * of count copies of the value in objPtr. + * On error, when interp is not NULL, error information is left in it. * *--------------------------------------------------------------------------- */ -int +Tcl_Obj * TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, int count, - Tcl_Obj **objPtrPtr) + int flags) { Tcl_Obj *objResultPtr; + int inPlace = flags & TCL_STRING_IN_PLACE; int length = 0, unichar = 0, done = 1; int binary = TclIsPureByteArray(objPtr); @@ -2759,8 +2760,7 @@ TclStringRepeat( if (length == 0) { /* Any repeats of empty is empty. */ - *objPtrPtr = objPtr; - return TCL_OK; + return objPtr; } if (count > INT_MAX/length) { @@ -2769,13 +2769,13 @@ TclStringRepeat( "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } if (binary) { /* Efficiently produce a pure byte array result */ - objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr) - : objPtr; + objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ? + Tcl_DuplicateObj(objPtr) : objPtr; Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); @@ -2788,7 +2788,7 @@ TclStringRepeat( (count - done) * length); } else if (unichar) { /* Efficiently produce a pure Tcl_UniChar array result */ - if (Tcl_IsShared(objPtr)) { + if (!inPlace || Tcl_IsShared(objPtr)) { objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length); } else { TclInvalidateStringRep(objPtr); @@ -2803,7 +2803,7 @@ TclStringRepeat( (Tcl_WideUInt)STRING_SIZE(count*length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { @@ -2814,7 +2814,7 @@ TclStringRepeat( (count - done) * length); } else { /* Efficiently concatenate string reps */ - if (Tcl_IsShared(objPtr)) { + if (!inPlace || Tcl_IsShared(objPtr)) { objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length); } else { TclFreeIntRep(objPtr); @@ -2827,7 +2827,7 @@ TclStringRepeat( count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { @@ -2837,8 +2837,7 @@ TclStringRepeat( Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr), (count - done) * length); } - *objPtrPtr = objResultPtr; - return TCL_OK; + return objResultPtr; } /* -- cgit v0.12 From ca5e7c5b63ce1355c653763e82f8e75f7a38d333 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 5 Feb 2018 16:34:28 +0000 Subject: Revise the TclStringCat() interface to follow a common pattern. --- generic/tclCmdIL.c | 3 +-- generic/tclCmdMZ.c | 15 +++------------ generic/tclDictObj.c | 9 ++++++--- generic/tclExecute.c | 6 +++--- generic/tclInt.h | 5 ++--- generic/tclStringObj.c | 35 ++++++++++++++++------------------- 6 files changed, 31 insertions(+), 42 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 77b8434..fa32340 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2193,8 +2193,7 @@ Tcl_JoinObjCmd( (void) Tcl_GetStringFromObj(joinObjPtr, &length); if (length == 0) { - TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs, - &resObjPtr); + resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { int i; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index e0344ef..f9e404b 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2847,7 +2847,6 @@ StringCatCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int code; Tcl_Obj *objResultPtr; if (objc < 2) { @@ -2857,23 +2856,15 @@ StringCatCmd( */ return TCL_OK; } - if (objc == 2) { - /* - * Other trivial case, single arg, just return it. - */ - Tcl_SetObjResult(interp, objv[1]); - return TCL_OK; - } - code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1, - &objResultPtr); + objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE); - if (code == TCL_OK) { + if (objResultPtr) { Tcl_SetObjResult(interp, objResultPtr); return TCL_OK; } - return code; + return TCL_ERROR; } /* diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 3b983e3..a0f6491 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2309,9 +2309,12 @@ DictAppendCmd( if (objc == 4) { appendObjPtr = objv[3]; - } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, - objc-3, objv+3, &appendObjPtr)) { - return TCL_ERROR; + } else { + appendObjPtr = TclStringCat(interp, objc-3, objv+3, + TCL_STRING_IN_PLACE); + if (appendObjPtr == NULL) { + return TCL_ERROR; + } } } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f2cda0c..a30ec89 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2682,9 +2682,9 @@ TEBCresume( case INST_STR_CONCAT1: opnd = TclGetUInt1AtPtr(pc+1); - - if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, - opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) { + objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1), + TCL_STRING_IN_PLACE); + if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } diff --git a/generic/tclInt.h b/generic/tclInt.h index cee1d3a..6cb9955 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3189,9 +3189,6 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); -MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int inPlace, - int objc, Tcl_Obj *const objv[], - Tcl_Obj **objPtrPtr); MODULE_SCOPE int TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack, int start); MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, @@ -4010,6 +4007,8 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, * candidates for public interface. */ +MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], int flags); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, int count, int flags); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 8bb76c1..46162ff 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2843,40 +2843,39 @@ TclStringRepeat( /* *--------------------------------------------------------------------------- * - * TclStringCatObjv -- + * TclStringCat -- * * Performs the [string cat] function. * * Results: - * A standard Tcl result. + * A (Tcl_Obj *) pointing to the result value, or NULL in case of an + * error. * * Side effects: - * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation - * of all objc values in objv. + * On error, when interp is not NULL, error information is left in it. * *--------------------------------------------------------------------------- */ -int -TclStringCatObjv( +Tcl_Obj * +TclStringCat( Tcl_Interp *interp, - int inPlace, int objc, Tcl_Obj * const objv[], - Tcl_Obj **objPtrPtr) + int flags) { Tcl_Obj *objResultPtr, * const *ov; int oc, length = 0, binary = 1; int allowUniChar = 1, requestUniChar = 0; int first = objc - 1; /* Index of first value possibly not empty */ int last = 0; /* Index of last value possibly not empty */ + int inPlace = flags & TCL_STRING_IN_PLACE; /* assert ( objc >= 0 ) */ if (objc <= 1) { /* Only one or no objects; return first or empty */ - *objPtrPtr = objc ? objv[0] : Tcl_NewObj(); - return TCL_OK; + return objc ? objv[0] : Tcl_NewObj(); } /* assert ( objc >= 2 ) */ @@ -3053,8 +3052,7 @@ TclStringCatObjv( if (last <= first /*|| length == 0 */) { /* Only one non-empty value or zero length; return first */ /* NOTE: (length == 0) implies (last <= first) */ - *objPtrPtr = objv[first]; - return TCL_OK; + return objv[first]; } objv += first; objc = (last - first + 1); @@ -3108,7 +3106,7 @@ TclStringCatObjv( (Tcl_WideUInt)STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } dst = Tcl_GetUnicode(objResultPtr) + start; } else { @@ -3125,7 +3123,7 @@ TclStringCatObjv( (Tcl_WideUInt)STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } dst = Tcl_GetUnicode(objResultPtr); } @@ -3156,7 +3154,7 @@ TclStringCatObjv( length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } dst = Tcl_GetString(objResultPtr) + start; @@ -3172,7 +3170,7 @@ TclStringCatObjv( length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } dst = Tcl_GetString(objResultPtr); } @@ -3187,8 +3185,7 @@ TclStringCatObjv( } } } - *objPtrPtr = objResultPtr; - return TCL_OK; + return objResultPtr; overflow: if (interp) { @@ -3196,7 +3193,7 @@ TclStringCatObjv( "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - return TCL_ERROR; + return NULL; } /* -- cgit v0.12 From 2567185fd23306471a28bd33da7ddea94b0b44bc Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 6 Feb 2018 11:16:51 +0000 Subject: Add remaining wrapper to the NR functions, remaining calls to TCL_NRAddCallback, and a test for a package require script that yields. --- generic/tclBasic.c | 4 +- generic/tclPkg.c | 436 +++++++++++++++++++++++++++++++++-------------------- tests/package.test | 12 ++ 3 files changed, 288 insertions(+), 164 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index fa54551..366fd1f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -238,7 +238,7 @@ static const CmdInfo builtInCmds[] = { {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"package", Tcl_PackageObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, @@ -4480,6 +4480,8 @@ TclNRRunCallbacks( (void) Tcl_GetObjResult(interp); } + /* This is the trampoline. */ + while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; diff --git a/generic/tclPkg.c b/generic/tclPkg.c index ce00fbf..6c5b827 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -69,8 +69,14 @@ typedef struct Require { void * clientDataPtr; const char *name; Package *pkgPtr; + char *versionToProvide; } Require; +typedef struct RequireProcArgs { + const char *name; + void *clientDataPtr; +} RequireProcArgs; + /* * Prototypes for functions defined in this file: */ @@ -91,10 +97,15 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); -static int PkgRequireCore(ClientData clientData, Tcl_Interp *interp, - int reqc, Tcl_Obj *const reqv[]); -static int SelectPackage (Tcl_Interp *interp, Require *reqPtr, - int reqc, Tcl_Obj *const reqv[]); +static int PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result); +static int TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); +static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result); +static int SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result); +static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result); /* * Helper macros. @@ -406,80 +417,116 @@ Tcl_PkgRequireProc( * available. */ void *clientDataPtr) { + RequireProcArgs args; + args.name = name; + args.clientDataPtr = clientDataPtr; + return Tcl_NRCallObjProc(interp, TclNRPkgRequireProc, (void *)&args, reqc, reqv); +} + +static int +TclNRPkgRequireProc( + ClientData clientData, + Tcl_Interp *interp, + int reqc, + Tcl_Obj *const reqv[]) { + RequireProcArgs *args = clientData; + Tcl_NRAddCallback(interp, PkgRequireCore, (void *)args->name, INT2PTR(reqc), (void *)reqv, args->clientDataPtr); + return TCL_OK; +} + +static int +PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result) +{ + const char *name = data[0]; + int reqc = PTR2INT(data[1]); + Tcl_Obj *const *reqv = data[2]; int code = CheckAllRequirements(interp, reqc, reqv); - Require require; + Require *reqPtr; if (code != TCL_OK) { return code; } - require.clientDataPtr = clientDataPtr; - require.name = name; - require.pkgPtr = NULL; - return Tcl_NRCallObjProc(interp, PkgRequireCore, &require, reqc, reqv); + reqPtr = ckalloc(sizeof(Require)); + Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL); + reqPtr->clientDataPtr = data[3]; + reqPtr->name = name; + reqPtr->pkgPtr = FindPackage(interp, name); + if (reqPtr->pkgPtr->version == NULL) { + Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1); + } else { + Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); + } + return TCL_OK; } -int -PkgRequireCore( - ClientData clientData, - Tcl_Interp *interp, /* Interpreter in which package is now - * available. */ - int reqc, /* Requirements constraining the desired - * version. */ - Tcl_Obj *const reqv[] /* 0 means to use the latest version - * available. */ - ) -{ - int code, satisfies; +static int +PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) { Tcl_DString command; - Require *reqPtr = clientData; - char *script, *pkgVersionI; + char *script; + Require *reqPtr = data[0]; + int reqc = PTR2INT(data[1]); + Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name /* Name of desired package. */; - void *clientDataPtr = reqPtr->clientDataPtr; - - reqPtr->pkgPtr = FindPackage(interp, name); if (reqPtr->pkgPtr->version == NULL) { - code = SelectPackage(interp, reqPtr, reqc, reqv); - if (code != TCL_OK) { - return code; - } - if (reqPtr->pkgPtr->version == NULL) { - /* - * The package is not in the database. If there is a "package unknown" - * command, invoke it. - */ + /* + * The package is not in the database. If there is a "package unknown" + * command, invoke it. + */ - script = ((Interp *) interp)->packageUnknown; - if (script != NULL) { - Tcl_DStringInit(&command); - Tcl_DStringAppend(&command, script, -1); - Tcl_DStringAppendElement(&command, name); - AddRequirementsToDString(&command, reqc, reqv); - - code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), - Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); - Tcl_DStringFree(&command); - - if ((code != TCL_OK) && (code != TCL_ERROR)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad return code: %d", code)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); - code = TCL_ERROR; - } - if (code == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (\"package unknown\" script)"); - return code; - } - Tcl_ResetResult(interp); - /* pkgPtr may now be invalid, so refresh it. */ - reqPtr->pkgPtr = FindPackage(interp, name); - code = SelectPackage(interp, reqPtr, reqc, reqv); - if (code != TCL_OK) { - return code; - } - } - } + script = ((Interp *) interp)->packageUnknown; + if (script == NULL) { + Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); + } else { + Tcl_DStringInit(&command); + Tcl_DStringAppend(&command, script, -1); + Tcl_DStringAppendElement(&command, name); + AddRequirementsToDString(&command, reqc, reqv); + + Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); + Tcl_NREvalObj(interp, + Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)), + TCL_EVAL_GLOBAL + ); + Tcl_DStringFree(&command); + } + return TCL_OK; + } else { + Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); } + return TCL_OK; +} +static int +PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) { + Require *reqPtr = data[0]; + int reqc = PTR2INT(data[1]); + Tcl_Obj **const reqv = data[2]; + const char *name = reqPtr->name /* Name of desired package. */; + if ((result != TCL_OK) && (result != TCL_ERROR)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad return code: %d", result)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); + result = TCL_ERROR; + } + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (\"package unknown\" script)"); + return result; + } + Tcl_ResetResult(interp); + /* pkgPtr may now be invalid, so refresh it. */ + reqPtr->pkgPtr = FindPackage(interp, name); + Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreFinal); + return TCL_OK; +} + +static int +PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) { + Require *reqPtr = data[0]; + int reqc = PTR2INT(data[1]), satisfies; + Tcl_Obj **const reqv = data[2]; + char *pkgVersionI; + void *clientDataPtr = reqPtr->clientDataPtr; + const char *name = reqPtr->name /* Name of desired package. */; if (reqPtr->pkgPtr->version == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't find package %s", name)); @@ -517,13 +564,23 @@ PkgRequireCore( Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1)); return TCL_OK; } + +static int +PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) { + ckfree(data[0]); + return result; +} + -int SelectPackage (Tcl_Interp *interp, Require *reqPtr, int reqc, Tcl_Obj *const reqv[]) { +static int +SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion, *bestStableVersion; /* Internal rep. of versions */ - char *script; - int availStable, code, satisfies; + int availStable, satisfies; + Require *reqPtr = data[0]; + int reqc = PTR2INT(data[1]); + Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name; Package *pkgPtr = reqPtr->pkgPtr; Interp *iPtr = (Interp *) interp; @@ -660,7 +717,9 @@ int SelectPackage (Tcl_Interp *interp, Require *reqPtr, int reqc, Tcl_Obj *const bestPtr = bestStablePtr; } - if (bestPtr != NULL) { + if (bestPtr == NULL) { + Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL); + } else { /* * We found an ifneeded script for the package. Be careful while * executing it: this could cause reentrancy, so (a) protect the @@ -669,105 +728,118 @@ int SelectPackage (Tcl_Interp *interp, Require *reqPtr, int reqc, Tcl_Obj *const */ char *versionToProvide = bestPtr->version; - PkgFiles *pkgFiles; - PkgName *pkgName; - script = bestPtr->script; - - pkgPtr->clientData = versionToProvide; Tcl_Preserve(versionToProvide); - Tcl_Preserve(script); - pkgFiles = TclInitPkgFiles(interp); - /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ - pkgName = ckalloc(sizeof(PkgName) + strlen(name)); - pkgName->nextPtr = pkgFiles->names; - strcpy(pkgName->name, name); - pkgFiles->names = pkgName; + pkgPtr->clientData = versionToProvide; if (bestPtr->pkgIndex) { TclPkgFileSeen(interp, bestPtr->pkgIndex); } - code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); - /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ - pkgFiles->names = pkgName->nextPtr; - ckfree(pkgName); - Tcl_Release(script); + reqPtr->versionToProvide = versionToProvide; + Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]); + Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL); + } + return TCL_OK; +} + +static int +SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) { + Require *reqPtr = data[0]; + int reqc = PTR2INT(data[1]); + Tcl_Obj **const reqv = data[2]; + const char *name = reqPtr->name; + char *versionToProvide = reqPtr->versionToProvide; - reqPtr->pkgPtr = FindPackage(interp, name); - if (code == TCL_OK) { - Tcl_ResetResult(interp); - if (reqPtr->pkgPtr->version == NULL) { - code = TCL_ERROR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to provide package %s %s failed:" - " no version of package %s provided", - name, versionToProvide, name)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", - NULL); - } else { - char *pvi, *vi; - - if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi, - NULL) != TCL_OK) { - code = TCL_ERROR; - } else if (CheckVersionAndConvert(interp, - versionToProvide, &vi, NULL) != TCL_OK) { - ckfree(pvi); - code = TCL_ERROR; - } else { - int res = CompareVersions(pvi, vi, NULL); - - ckfree(pvi); - ckfree(vi); - if (res != 0) { - code = TCL_ERROR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to provide package %s %s failed:" - " package %s %s provided instead", - name, versionToProvide, - name, reqPtr->pkgPtr->version)); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", - "WRONGPROVIDE", NULL); - } - } - } - } else if (code != TCL_ERROR) { - Tcl_Obj *codePtr = Tcl_NewIntObj(code); + PkgFiles *pkgFiles; + PkgName *pkgName; + + pkgFiles = TclInitPkgFiles(interp); + /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ + pkgName = ckalloc(sizeof(PkgName) + strlen(name)); + pkgName->nextPtr = pkgFiles->names; + strcpy(pkgName->name, name); + pkgFiles->names = pkgName; + + /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ + pkgFiles->names = pkgName->nextPtr; + ckfree(pkgName); + reqPtr->pkgPtr = FindPackage(interp, name); + if (result == TCL_OK) { + Tcl_ResetResult(interp); + if (reqPtr->pkgPtr->version == NULL) { + result = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" - " bad return code: %s", - name, versionToProvide, TclGetString(codePtr))); - Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); - TclDecrRefCount(codePtr); - code = TCL_ERROR; - } + " no version of package %s provided", + name, versionToProvide, name)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", + NULL); + } else { + char *pvi, *vi; - if (code == TCL_ERROR) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"package ifneeded %s %s\" script)", - name, versionToProvide)); + if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi, + NULL) != TCL_OK) { + result = TCL_ERROR; + } else if (CheckVersionAndConvert(interp, + versionToProvide, &vi, NULL) != TCL_OK) { + ckfree(pvi); + result = TCL_ERROR; + } else { + int res = CompareVersions(pvi, vi, NULL); + + ckfree(pvi); + ckfree(vi); + if (res != 0) { + result = TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "attempt to provide package %s %s failed:" + " package %s %s provided instead", + name, versionToProvide, + name, reqPtr->pkgPtr->version)); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", + "WRONGPROVIDE", NULL); + } + } } - Tcl_Release(versionToProvide); + } else if (result != TCL_ERROR) { + Tcl_Obj *codePtr = Tcl_NewIntObj(result); - if (code != TCL_OK) { - /* - * Take a non-TCL_OK code from the script as an indication the - * package wasn't loaded properly, so the package system - * should not remember an improper load. - * - * This is consistent with our returning NULL. If we're not - * willing to tell our caller we got a particular version, we - * shouldn't store that version for telling future callers - * either. - */ + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "attempt to provide package %s %s failed:" + " bad return code: %s", + name, versionToProvide, TclGetString(codePtr))); + Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); + TclDecrRefCount(codePtr); + result = TCL_ERROR; + } - if (reqPtr->pkgPtr->version != NULL) { - ckfree(reqPtr->pkgPtr->version); - reqPtr->pkgPtr->version = NULL; - } - reqPtr->pkgPtr->clientData = NULL; - return code; + if (result == TCL_ERROR) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"package ifneeded %s %s\" script)", + name, versionToProvide)); + } + Tcl_Release(versionToProvide); + + if (result != TCL_OK) { + /* + * Take a non-TCL_OK code from the script as an indication the + * package wasn't loaded properly, so the package system + * should not remember an improper load. + * + * This is consistent with our returning NULL. If we're not + * willing to tell our caller we got a particular version, we + * shouldn't store that version for telling future callers + * either. + */ + + if (reqPtr->pkgPtr->version != NULL) { + ckfree(reqPtr->pkgPtr->version); + reqPtr->pkgPtr->version = NULL; } + reqPtr->pkgPtr->clientData = NULL; + return result; } + + Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL); return TCL_OK; } @@ -874,10 +946,19 @@ Tcl_PkgPresentEx( * *---------------------------------------------------------------------- */ +int +Tcl_PackageObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv); +} /* ARGSUSED */ int -Tcl_PackageObjCmd( +TclNRPackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -894,7 +975,7 @@ Tcl_PackageObjCmd( PKG_VERSIONS, PKG_VSATISFIES }; Interp *iPtr = (Interp *) interp; - int optionIndex, exact, i, satisfies; + int optionIndex, exact, i, newobjc, satisfies; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; @@ -903,6 +984,7 @@ Tcl_PackageObjCmd( const char *version; const char *argv2, *argv3, *argv4; char *iva = NULL, *ivb = NULL; + Tcl_Obj *objvListPtr, **newObjvPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); @@ -1148,7 +1230,6 @@ Tcl_PackageObjCmd( argv2 = TclGetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { Tcl_Obj *ov; - int res; if (objc != 5) { goto requireSyntax; @@ -1165,20 +1246,42 @@ Tcl_PackageObjCmd( */ ov = Tcl_NewStringObj(version, -1); + Tcl_IncrRefCount(ov); Tcl_AppendStringsToObj(ov, "-", version, NULL); version = NULL; argv3 = TclGetString(objv[3]); + Tcl_IncrRefCount(objv[3]); - Tcl_IncrRefCount(ov); - res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL); - TclDecrRefCount(ov); - return res; + objvListPtr = Tcl_NewListObj(0, NULL); + Tcl_IncrRefCount(objvListPtr); + Tcl_ListObjAppendElement(interp, objvListPtr, ov); + Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); + + Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL); + Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL); + return TCL_OK; } else { + int i, newobjc = objc-3; + Tcl_Obj *const *newobjv = objv + 3; if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { return TCL_ERROR; } + objvListPtr = Tcl_NewListObj(0, NULL); + Tcl_IncrRefCount(objvListPtr); + Tcl_IncrRefCount(objv[2]); + for (i = 0; i < newobjc; i++) { - return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL); + /* + * Tcl_Obj structures may have come from another interpreter, + * so duplicate them. + */ + + Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); + } + Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); + Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL); + Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv2, INT2PTR(newobjc), newObjvPtr, NULL); + return TCL_OK; } break; case PKG_UNKNOWN: { @@ -1318,6 +1421,13 @@ Tcl_PackageObjCmd( } return TCL_OK; } + +static int +TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result) { + TclDecrRefCount((Tcl_Obj *)data[0]); + TclDecrRefCount((Tcl_Obj *)data[1]); + return result; +} /* *---------------------------------------------------------------------- diff --git a/tests/package.test b/tests/package.test index bb938b8..2843701 100644 --- a/tests/package.test +++ b/tests/package.test @@ -625,6 +625,18 @@ test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} -constrain package require t set x } -result {1.1} +test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup { + package forget t +} -body { + coroutine coro1 apply {{} { + package ifneeded t 2.1 { + yield + package provide t 2.1 + } + package require t 2.1 + }} + list [catch {coro1} msg] $msg +} -match glob -result {0 2.1} test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body { -- cgit v0.12 From 25fcbf685dbd09f24d7d45c8c6b90ed3c33eab17 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Feb 2018 17:26:40 +0000 Subject: Rename TclStringFind to TclStringFirst. Repair its operations on bytearrays. Stop trying to operate on utf-8 until we nail that down better. --- generic/tclCmdMZ.c | 10 +------- generic/tclExecute.c | 2 +- generic/tclInt.h | 4 ++-- generic/tclStringObj.c | 63 +++++++++++++++++++++++--------------------------- 4 files changed, 33 insertions(+), 46 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index f9e404b..5d49d2a 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1335,16 +1335,8 @@ StringFirstCmd( if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) { return TCL_ERROR; } - - if (start < 0) { - start = 0; - } - if (start >= size) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); - return TCL_OK; - } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1], + Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFirst(objv[1], objv[2], start))); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a30ec89..679b57a 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5715,7 +5715,7 @@ TEBCresume( NEXT_INST_V(1, 3, 1); case INST_STR_FIND: - match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); + match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); diff --git a/generic/tclInt.h b/generic/tclInt.h index 6cb9955..f288a3a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3189,8 +3189,6 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); -MODULE_SCOPE int TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack, - int start); MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, int last); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, @@ -4009,6 +4007,8 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); +MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, + int start); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, int count, int flags); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 46162ff..bb72acd 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3199,7 +3199,7 @@ TclStringCat( /* *--------------------------------------------------------------------------- * - * TclStringFind -- + * TclStringFirst -- * * Implements the [string first] operation. * @@ -3215,20 +3215,20 @@ TclStringCat( */ int -TclStringFind( +TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, int start) { int lh, ln = Tcl_GetCharLength(needle); + if (start < 0) { + start = 0; + } if (ln == 0) { - /* - * We don't find empty substrings. Bizarre! - * - * TODO: When we one day make this a true substring - * finder, change this to "return 0" - */ + /* We don't find empty substrings. Bizarre! + * Whenever this routine is turned into a proper substring + * finder, change to `return start` after limits imposed. */ return -1; } @@ -3236,51 +3236,46 @@ TclStringFind( unsigned char *end, *try, *bh; unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + /* Find bytes in bytes */ bh = Tcl_GetByteArrayFromObj(haystack, &lh); end = bh + lh; try = bh + start; while (try + ln <= end) { - try = memchr(try, bn[0], end - try); - + /* + * Look for the leading byte of the needle in the haystack + * starting at try and stopping when there's not enough room + * for the needle left. + */ + try = memchr(try, bn[0], (end + 1 - ln) - try); if (try == NULL) { + /* Leading byte not found -> needle cannot be found. */ return -1; } + /* Leading byte found, check rest of needle. */ if (0 == memcmp(try+1, bn+1, ln-1)) { + /* Checks! Return the successful index. */ return (try - bh); } + /* Rest of needle match failed; Iterate to continue search. */ try++; } return -1; } /* - * Check if we have two strings of single-byte characters. If we have, we - * can use strstr() to do the search. Note that we can sometimes have - * multibyte characters when the string could be minimally represented - * using single byte characters; we can't assume that a mismatch here - * means no match. + * TODO: It might be nice to support some cases where it is not + * necessary to shimmer to &tclStringType to compute the result, + * and instead operate just on the objPtr->bytes values directly. + * However, we also do not want the answer to change based on the + * code pathway, or if it does we want that to be for some values + * we explicitly decline to support. Getting there will involve + * locking down in practice more firmly just what encodings produce + * what supported results for the objPtr->bytes values. For now, + * do only the well-defined Tcl_UniChar array search. */ - lh = Tcl_GetCharLength(haystack); - if (haystack->bytes && (lh == haystack->length) && needle->bytes - && (ln == needle->length)) { - /* - * Both haystack and needle are all single-byte chars. - */ - - char *found = strstr(haystack->bytes + start, needle->bytes); - - if (found) { - return (found - haystack->bytes); - } else { - return -1; - } - } else { - /* - * Do the search on the unicode representation for simplicity. - */ - + { Tcl_UniChar *try, *end, *uh; Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); -- cgit v0.12 From 99ca63a80a648b2e65a9b54be78022e5cd161307 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Feb 2018 18:33:41 +0000 Subject: TclStringLast fixed. --- generic/tclCmdMZ.c | 8 -------- generic/tclStringObj.c | 48 ++++++++++-------------------------------------- 2 files changed, 10 insertions(+), 46 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 5d49d2a..03b254d 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1380,14 +1380,6 @@ StringLastCmd( if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) { return TCL_ERROR; } - - if (last < 0) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); - return TCL_OK; - } - if (last >= size) { - last = size - 1; - } } Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1], objv[2], last))); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index bb72acd..4481818 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3323,24 +3323,24 @@ TclStringLast( * We don't find empty substrings. Bizarre! * * TODO: When we one day make this a true substring - * finder, change this to "return 0" + * finder, change this to "return last", after limitation. */ return -1; } - if (ln > last + 1) { + lh = Tcl_GetCharLength(haystack); + if (last >= lh) { + last = lh - 1; + } + + if (last < ln - 1) { return -1; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *try, *bh; + unsigned char *try, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); - bh = Tcl_GetByteArrayFromObj(haystack, &lh); - - if (last + 1 > lh) { - last = lh - 1; - } try = bh + last + 1 - ln; while (try >= bh) { if ((*try == bn[0]) @@ -3352,38 +3352,10 @@ TclStringLast( return -1; } - lh = Tcl_GetCharLength(haystack); - if (last + 1 > lh) { - last = lh - 1; - } - if (haystack->bytes && (lh == haystack->length)) { - /* haystack is all single-byte chars */ - - if (needle->bytes && (ln == needle->length)) { - /* needle is also all single-byte chars */ - - char *try = haystack->bytes + last + 1 - ln; - while (try >= haystack->bytes) { - if ((*try == needle->bytes[0]) - && (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) { - return (try - haystack->bytes); - } - try--; - } - return -1; - } else { - /* - * Cannot find substring with a multi-byte char inside - * a string with no multi-byte chars. - */ - return -1; - } - } else { - Tcl_UniChar *try, *uh; + { + Tcl_UniChar *try, *uh = Tcl_GetUnicodeFromObj(haystack, &lh); Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); - uh = Tcl_GetUnicodeFromObj(haystack, &lh); - try = uh + last + 1 - ln; while (try >= uh) { if ((*try == un[0]) -- cgit v0.12 From fde3c52d294c62edfd6aa2735c4244bd1b763b83 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Feb 2018 19:10:45 +0000 Subject: Rework TclStringReverse to consistent standard form. --- generic/tclCmdMZ.c | 2 +- generic/tclInt.h | 6 +++--- generic/tclStringObj.c | 20 +++++++++++--------- 3 files changed, 15 insertions(+), 13 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 03b254d..ed4312e 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2382,7 +2382,7 @@ StringRevCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, TclStringObjReverse(objv[1])); + Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE)); return TCL_OK; } diff --git a/generic/tclInt.h b/generic/tclInt.h index f288a3a..f8149be 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3189,13 +3189,10 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); -MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, - int last); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOP