summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.github/workflows/win-build.yml2
-rw-r--r--doc/FindExec.35
-rw-r--r--doc/InitSubSyst.37
-rw-r--r--doc/Panic.35
-rw-r--r--doc/zipfs.312
-rw-r--r--generic/tcl.decls12
-rw-r--r--generic/tcl.h6
-rw-r--r--generic/tclBasic.c111
-rw-r--r--generic/tclDecls.h18
-rw-r--r--generic/tclEncoding.c5
-rw-r--r--generic/tclEvent.c88
-rw-r--r--generic/tclPanic.c5
-rw-r--r--generic/tclPkg.c6
-rw-r--r--generic/tclPkgConfig.c2
-rw-r--r--generic/tclTest.c74
-rw-r--r--generic/tclZipfs.c11
-rw-r--r--tests/async.test2
-rw-r--r--tests/compile.test2
-rw-r--r--tests/config.test2
-rw-r--r--tests/format.test4
-rw-r--r--tests/socket.test1
-rw-r--r--tests/tcltests.tcl27
-rw-r--r--tests/winDde.test2
-rw-r--r--tests/winFCmd.test2
-rw-r--r--unix/Makefile.in22
-rw-r--r--unix/tclConfig.h.in6
-rw-r--r--win/Makefile.in7
-rw-r--r--win/makefile.vc12
-rw-r--r--win/svnmanifest.in1
-rw-r--r--win/tclUuid.h.in1
-rw-r--r--win/tclWinInit.c3
31 files changed, 304 insertions, 159 deletions
diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml
index f8a0a6c..5c787f5 100644
--- a/.github/workflows/win-build.yml
+++ b/.github/workflows/win-build.yml
@@ -42,8 +42,6 @@ jobs:
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
- env:
- CI_BUILD_WITH_MSVC: 1
gcc:
runs-on: windows-latest
defaults:
diff --git a/doc/FindExec.3 b/doc/FindExec.3
index 149ef8a..7f8c8a4 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -13,7 +13,7 @@ Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of th
.nf
\fB#include <tcl.h>\fR
.sp
-void
+const char *
\fBTcl_FindExecutable\fR(\fIargv0\fR)
.sp
const char *
@@ -35,6 +35,9 @@ Tcl. For example, it is needed on some platforms in the
implementation of the \fBload\fR command.
It is also returned by the \fBinfo nameofexecutable\fR command.
.PP
+The result of \fBTcl_FindExecutable\fR is the full Tcl version (e.g.,
+\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
+.PP
On UNIX platforms this procedure is typically invoked as the very
first thing in the application's main program; it must be passed
\fIargv[0]\fR as its argument. It is important not to change the
diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3
index 3c138a4..89f2b88 100644
--- a/doc/InitSubSyst.3
+++ b/doc/InitSubSyst.3
@@ -13,7 +13,7 @@ Tcl_InitSubsystems \- initialize the Tcl library.
.nf
\fB#include <tcl.h>\fR
.sp
-void
+const char *
\fBTcl_InitSubsystems\fR(\fIvoid\fR)
.SH DESCRIPTION
.PP
@@ -21,10 +21,13 @@ The \fBTcl_InitSubsystems\fR procedure initializes the Tcl
library. This procedure is typically invoked as the very
first thing in the application's main program.
.PP
+The result of \fBTcl_InitSubsystems\fR is the full Tcl version (e.g.,
+\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
+.PP
\fBTcl_InitSubsystems\fR is very similar in use to
\fBTcl_FindExecutable\fR. 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
+iso8859-1 or utf-16 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.
.SH KEYWORDS
diff --git a/doc/Panic.3 b/doc/Panic.3
index 53b84da..bd019db 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -18,7 +18,7 @@ void
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
-void
+const char *
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
void
@@ -82,6 +82,9 @@ making calls into the Tcl library, or into other libraries that may
call the Tcl library, since the original call to \fBTcl_Panic\fR
indicates the Tcl library is not in a state of reliable operation.
.PP
+The result of \fBTcl_SetPanicProc\fR is the full Tcl version (e.g.,
+\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
+.PP
The typical use of \fBTcl_SetPanicProc\fR arranges for the error message
to be displayed or reported in a manner more suitable for the
application or the platform.
diff --git a/doc/zipfs.3 b/doc/zipfs.3
index 348557f..3b13cd9 100644
--- a/doc/zipfs.3
+++ b/doc/zipfs.3
@@ -13,7 +13,7 @@
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
-int
+const char *
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
@@ -87,11 +87,11 @@ it uses WCHAR instead of char. As a result, it requires your application to
be compiled with the UNICODE preprocessor symbol defined (e.g., via the
\fB-DUNICODE\fR compiler flag).
.PP
-The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
-when the function is successful). The function \fImay\fR modify the variables
-pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
-current implementation does not do so, but callers \fIshould not\fR assume
-that this will be true in the future.
+The result of \fBTclZipfs_AppHook\fR is the full Tcl version (e.g.,
+\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
+The function \fImay\fR modify the variables pointed to by \fIargcPtr\fR and
+\fIargvPtr\fR to remove arguments; the current implementation does not do so,
+but callers \fIshould not\fR assume that this will be true in the future.
.PP
\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 6e8b24f..cc67a54 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -514,7 +514,7 @@ declare 143 {
void Tcl_Finalize(void)
}
declare 144 {nostub {Don't use this function in a stub-enabled extension}} {
- void Tcl_FindExecutable(const char *argv0)
+ const char *Tcl_FindExecutable(const char *argv0)
}
declare 145 {
Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
@@ -813,7 +813,7 @@ declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
declare 230 {nostub {Don't use this function in a stub-enabled extension}} {
- void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
+ const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
@@ -2511,13 +2511,13 @@ export {
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
export {
- void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
+ const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
export {
Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
export {
- void Tcl_FindExecutable(const char *argv0)
+ const char *Tcl_FindExecutable(const char *argv0)
}
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
@@ -2535,10 +2535,10 @@ export {
void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
}
export {
- void Tcl_InitSubsystems(void)
+ const char *Tcl_InitSubsystems(void)
}
export {
- int TclZipfs_AppHook(int *argc, char ***argv)
+ const char *TclZipfs_AppHook(int *argc, char ***argv)
}
# Local Variables:
diff --git a/generic/tcl.h b/generic/tcl.h
index 3548d03..3038bb8 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2397,16 +2397,16 @@ EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
-EXTERN void Tcl_InitSubsystems(void);
+EXTERN const char * Tcl_InitSubsystems(void);
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
EXTERN const char * Tcl_SetPreInitScript(const char *string);
#ifndef TCL_NO_DEPRECATED
# define Tcl_StaticPackage Tcl_StaticLibrary
#endif
#ifdef _WIN32
-EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv);
+EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
-EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
+EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 599366b..29392d2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -607,6 +607,108 @@ TclFinalizeEvaluation(void)
/*
*----------------------------------------------------------------------
*
+ * buildInfoObjCmd --
+ *
+ * Implements tcl::build-info command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+buildInfoObjCmd(
+ void *clientData,
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?option?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ int len;
+ const char *arg = TclGetStringFromObj(objv[1], &len);
+ if (len == 7 && !strcmp(arg, "version")) {
+ char buf[80];
+ const char *p = strchr((char *)clientData, '.');
+ if (p) {
+ const char *q = strchr(p+1, '.');
+ const char *r = strchr(p+1, '+');
+ p = (q < r) ? q : r;
+ }
+ if (p) {
+ memcpy(buf, (char *)clientData, p - (char *)clientData);
+ buf[p - (char *)clientData] = '\0';
+ Tcl_AppendResult(interp, buf, NULL);
+ }
+ return TCL_OK;
+ } else if (len == 10 && !strcmp(arg, "patchlevel")) {
+ char buf[80];
+ const char *p = strchr((char *)clientData, '+');
+ if (p) {
+ memcpy(buf, (char *)clientData, p - (char *)clientData);
+ buf[p - (char *)clientData] = '\0';
+ Tcl_AppendResult(interp, buf, NULL);
+ }
+ return TCL_OK;
+ } else if (len == 6 && !strcmp(arg, "commit")) {
+ const char *q, *p = strchr((char *)clientData, '+');
+ if (p) {
+ if ((q = strchr(p, '.'))) {
+ char buf[80];
+ memcpy(buf, p+1, q - p - 1);
+ buf[q - p - 1] = '\0';
+ Tcl_AppendResult(interp, buf, NULL);
+ } else {
+ Tcl_AppendResult(interp, p+1, NULL);
+ }
+ }
+ return TCL_OK;
+ } else if (len == 8 && !strcmp(arg, "compiler")) {
+ const char *p = strchr((char *)clientData, '.');
+ while (p) {
+ if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4)
+ || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) {
+ const char *q = strchr(p+1, '.');
+ if (q) {
+ char buf[16];
+ memcpy(buf, p+1, q - p - 1);
+ buf[q - p - 1] = '\0';
+ Tcl_AppendResult(interp, buf, NULL);
+ } else {
+ Tcl_AppendResult(interp, p+1, NULL);
+ }
+ return TCL_OK;
+ }
+ p = strchr(p+1, '.');
+ }
+ Tcl_AppendResult(interp, "0", NULL);
+ return TCL_OK;
+ }
+ const char *p = strchr((char *)clientData, '.');
+ while (p) {
+ if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) {
+ Tcl_AppendResult(interp, "1", NULL);
+ return TCL_OK;
+ }
+ p = strchr(p+1, '.');
+ }
+ Tcl_AppendResult(interp, "0", NULL);
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, (char *)clientData, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_CreateInterp --
*
* Create a new TCL command interpreter.
@@ -644,8 +746,7 @@ Tcl_CreateInterp(void)
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
CallFrame *framePtr;
-
- Tcl_InitSubsystems();
+ const char *version = Tcl_InitSubsystems();
/*
* Panic if someone updated the CallFrame structure without also updating
@@ -1162,7 +1263,7 @@ Tcl_CreateInterp(void)
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
-#if TCL_THREADS
+#if TCL_THREADS && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The existence of the "threaded" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with threads
@@ -1176,10 +1277,14 @@ Tcl_CreateInterp(void)
/*
* Register Tcl's version number.
* TIP #268: Full patchlevel instead of just major.minor
+ * TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
*/
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
+ Tcl_CreateObjCommand(interp, "::tcl::build-info",
+ buildInfoObjCmd, (void *)version, NULL);
+
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index ae57f20..176d0af 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -471,7 +471,7 @@ EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
EXTERN void Tcl_Finalize(void);
/* 144 */
-EXTERN void Tcl_FindExecutable(const char *argv0);
+EXTERN const char * Tcl_FindExecutable(const char *argv0);
/* 145 */
EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr);
@@ -710,7 +710,7 @@ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* 230 */
-EXTERN void Tcl_SetPanicProc(
+EXTERN const char * Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *panicProc);
/* 231 */
EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
@@ -2125,7 +2125,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 */
- TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */
+ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_FindExecutable) (const char *argv0); /* 144 */
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
@@ -2219,7 +2219,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 */
- TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
+ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_SetPanicProc) (TCL_NORETURN1 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 */
@@ -4025,10 +4025,18 @@ extern const TclStubs *tclStubsPtr;
#endif
#if defined(_WIN32) && defined(UNICODE)
-# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
+# if defined(TCL_NO_DEPRECATED)
+# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
+# else
+# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)((const char *)(arg))))
+# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg)))
+# endif
# define Tcl_MainEx Tcl_MainExW
EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
+#elif !defined(TCL_NO_DEPRECATED)
+# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)(arg)))
+# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg)))
#endif
#undef TCL_STORAGE_CLASS
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 162fa2a..3d0225b 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1576,14 +1576,15 @@ Tcl_UtfToExternal(
*---------------------------------------------------------------------------
*/
#undef Tcl_FindExecutable
-void
+const char *
Tcl_FindExecutable(
const char *argv0) /* The value of the application's argv[0]
* (native). */
{
- Tcl_InitSubsystems();
+ const char *version = Tcl_InitSubsystems();
TclpSetInitialEncodings();
TclpFindExecutable(argv0);
+ return version;
}
/*
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index cb2e529..22b6a77 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
+#include "tclUuid.h"
/*
* The data structure below is used to report background errors. One such
@@ -1016,7 +1017,7 @@ Tcl_Exit(
* down another.
*
* Results:
- * None.
+ * The full Tcl version with build information.
*
* Side effects:
* Varied, see the respective initialization routines.
@@ -1024,7 +1025,89 @@ Tcl_Exit(
*-------------------------------------------------------------------------
*/
-void
+MODULE_SCOPE const TclStubs tclStubs;
+
+#ifndef STRINGIFY
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+#endif
+
+static const struct {
+ const TclStubs *stubs;
+ const char version[256];
+} stubInfo = {
+ &tclStubs, {TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
+#if defined(__clang__) && defined(__clang_major__)
+ ".clang-" STRINGIFY(__clang_major__)
+#if __clang_minor__ < 10
+ "0"
+#endif
+ STRINGIFY(__clang_minor__)
+#endif
+#ifdef TCL_COMPILE_DEBUG
+ ".compiledebug"
+#endif
+#ifdef TCL_COMPILE_STATS
+ ".compilestats"
+#endif
+#if defined(__cplusplus) && !defined(__OBJC__)
+ ".cplusplus"
+#endif
+#ifndef NDEBUG
+ ".debug"
+#endif
+#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
+ ".gcc-" STRINGIFY(__GNUC__)
+#if __GNUC_MINOR__ < 10
+ "0"
+#endif
+ STRINGIFY(__GNUC_MINOR__)
+#endif
+#ifdef __INTEL_COMPILER
+ ".icc-" STRINGIFY(__INTEL_COMPILER)
+#endif
+#if (defined(_WIN32) && !defined(_WIN64)) || (ULONG_MAX == 0xffffffffUL)
+ ".ilp32"
+#endif
+#ifdef TCL_MEM_DEBUG
+ ".memdebug"
+#endif
+#if defined(_MSC_VER)
+ ".msvc-" STRINGIFY(_MSC_VER)
+#endif
+#ifdef USE_NMAKE
+ ".nmake"
+#endif
+#ifdef TCL_NO_DEPRECATED
+ ".no-deprecate"
+#endif
+#if !TCL_THREADS
+ ".no-thread"
+#endif
+#ifndef TCL_CFG_OPTIMIZED
+ ".no-optimize"
+#endif
+#ifdef __OBJC__
+ ".objective-c"
+#if defined(__cplusplus)
+ "plusplus"
+#endif
+#endif
+#ifdef TCL_CFG_PROFILED
+ ".profile"
+#endif
+#ifdef PURIFY
+ ".purify"
+#endif
+#ifdef STATIC_BUILD
+ ".static"
+#endif
+#if TCL_UTF_MAX < 4
+ ".utf-16"
+#endif
+}};
+
+const char *
Tcl_InitSubsystems(void)
{
if (inExit != 0) {
@@ -1071,6 +1154,7 @@ Tcl_InitSubsystems(void)
TclpInitUnlock();
}
TclInitNotifier();
+ return stubInfo.version;
}
/*
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 394661f..ba7e801 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -45,7 +45,8 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
*----------------------------------------------------------------------
*/
-void
+#undef Tcl_SetPanicProc
+const char *
Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *proc)
{
@@ -58,7 +59,7 @@ Tcl_SetPanicProc(
else
#endif
panicProc = proc;
- Tcl_InitSubsystems();
+ return Tcl_InitSubsystems();
}
/*
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index c3f2f17..3311f6a 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1696,7 +1696,7 @@ CheckVersionAndConvert(
*ip++ = *p;
- for (prevChar = *p, p++; *p != 0; p++) {
+ for (prevChar = *p, p++; (*p != 0) && (*p != '+'); p++) {
if (!isdigit(UCHAR(*p)) && /* INTL: digit */
((*p!='.' && *p!='a' && *p!='b') ||
((hasunstable && (*p=='a' || *p=='b')) ||
@@ -2000,10 +2000,10 @@ CheckRequirement(
char *dash = NULL, *buf;
- dash = (char *)strchr(string, '-');
+ dash = strchr(string, '+') ? NULL : (char *)strchr(string, '-');
if (dash == NULL) {
/*
- * No dash found, has to be a simple version.
+ * '+' found or no dash found: has to be a simple version.
*/
return CheckVersionAndConvert(interp, string, NULL, NULL);
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index d84472c..a0dae51 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -93,6 +93,7 @@
#endif
static Tcl_Config const cfg[] = {
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{"debug", CFG_DEBUG},
{"threaded", CFG_THREADED},
{"profiled", CFG_PROFILED},
@@ -101,6 +102,7 @@ static Tcl_Config const cfg[] = {
{"mem_debug", CFG_MEMDEBUG},
{"compile_debug", CFG_COMPILE_DEBUG},
{"compile_stats", CFG_COMPILE_STATS},
+#endif
/* Runtime paths to various stuff */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index ca44e36..46a1459 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -225,7 +225,6 @@ static Tcl_CmdProc TestcreatecommandCmd;
static Tcl_CmdProc TestdcallCmd;
static Tcl_CmdProc TestdelCmd;
static Tcl_CmdProc TestdelassocdataCmd;
-static Tcl_ObjCmdProc TestdebugObjCmd;
static Tcl_ObjCmdProc TestdoubledigitsObjCmd;
static Tcl_CmdProc TestdstringCmd;
static Tcl_ObjCmdProc TestencodingObjCmd;
@@ -264,7 +263,6 @@ static Tcl_ObjCmdProc TestparsevarObjCmd;
static Tcl_ObjCmdProc TestparsevarnameObjCmd;
static Tcl_ObjCmdProc TestpreferstableObjCmd;
static Tcl_ObjCmdProc TestprintObjCmd;
-static Tcl_ObjCmdProc TestpurifyObjCmd;
static Tcl_ObjCmdProc TestregexpObjCmd;
static Tcl_ObjCmdProc TestreturnObjCmd;
static void TestregexpXflags(const char *string,
@@ -504,8 +502,6 @@ Tcltest_Init(
Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testdebug", TestdebugObjCmd,
- NULL, NULL);
Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
NULL, NULL);
@@ -570,8 +566,6 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
NULL, NULL);
- Tcl_CreateObjCommand(interp, "testpurify", TestpurifyObjCmd,
- NULL, NULL);
Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
@@ -3359,40 +3353,6 @@ TestlocaleCmd(
/*
*----------------------------------------------------------------------
*
- * TestdebugObjCmd --
- *
- * Implements the "testdebug" command, to detect whether Tcl was built with
- * --enabble-symbols.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestdebugObjCmd(
- TCL_UNUSED(void *),
- Tcl_Interp *interp, /* Current interpreter. */
- TCL_UNUSED(int) /*objc*/,
- TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
-{
-
-#if defined(NDEBUG) && NDEBUG == 1
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
-#else
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
-#endif
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* CleanupTestSetassocdataTests --
*
* This function is called when an interpreter is deleted to clean
@@ -3794,40 +3754,6 @@ TestprintObjCmd(
/*
*----------------------------------------------------------------------
*
- * TestpurifyObjCmd --
- *
- * Implements the "testpurify" command, to detect whether Tcl was built with
- * -DPURIFY.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestpurifyObjCmd(
- TCL_UNUSED(void *),
- Tcl_Interp *interp, /* Current interpreter. */
- TCL_UNUSED(int) /*objc*/,
- TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
-{
-
-#ifdef PURIFY
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
-#else
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
-#endif
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TestregexpObjCmd --
*
* This procedure implements the "testregexp" command. It is used to give
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 60d77f4..98a2820 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -5802,7 +5802,7 @@ ZipfsMountExitHandler(
*-------------------------------------------------------------------------
*/
-int
+const char *
TclZipfs_AppHook(
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
int *argcPtr, /* Pointer to argc */
@@ -5816,6 +5816,7 @@ TclZipfs_AppHook(
#endif /* _WIN32 */
{
const char *archive;
+ const char *version = Tcl_InitSubsystems();
#ifdef _WIN32
Tcl_FindExecutable(NULL);
@@ -5858,7 +5859,7 @@ TclZipfs_AppHook(
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
- return TCL_OK;
+ return version;
}
}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
@@ -5891,7 +5892,7 @@ TclZipfs_AppHook(
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Tcl_SetStartupScript(vfsInitScript, NULL);
}
- return TCL_OK;
+ return version;
} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
int found;
Tcl_Obj *vfsInitScript;
@@ -5915,7 +5916,7 @@ TclZipfs_AppHook(
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
- return TCL_OK;
+ return version;
}
}
#ifdef _WIN32
@@ -5923,7 +5924,7 @@ TclZipfs_AppHook(
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
}
- return TCL_OK;
+ return version;
}
#ifndef HAVE_ZLIB
diff --git a/tests/async.test b/tests/async.test
index 2d8f678..49a00ff 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -21,7 +21,7 @@ catch [list package require -exact tcl::test [info patchlevel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint testasync [llength [info commands testasync]]
-testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
+testConstraint knownMsvcBug [string match msvc-* [tcl::build-info compiler]]
proc async1 {result code} {
global aresult acode
diff --git a/tests/compile.test b/tests/compile.test
index 31af2e2..9959da4 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -500,7 +500,7 @@ test compile-13.2 {TclCompileScript: testing expected nested scripts compilation
# with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
# boxes or systems, please don't decrease it (either provide a constraint)
ti eval {foreach cmd {eval "if 1" try catch} {
- set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd]
+ set c [gencode [expr {[tcl::build-info debug] ? 1500 : 1000}] $cmd]
if 1 $c
}}
ti eval {set result}
diff --git a/tests/config.test b/tests/config.test
index 2d8b593..50f03ce 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
test pkgconfig-1.1 {query keys} -body {
lsort [::tcl::pkgconfig list]
-} -match glob -result {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}
+} -match glob -result {*bindir,install bindir,runtime*docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime*scriptdir,install scriptdir,runtime*}
test pkgconfig-1.2 {query keys multiple times} {
string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
diff --git a/tests/format.test b/tests/format.test
index a3ca81d..c5053e8 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -23,8 +23,8 @@ testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
# particularly in Continuous Integration, and there isn't anything much we can
# do about it.
-testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
-
+testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}]
+
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
diff --git a/tests/socket.test b/tests/socket.test
index a1a66b5..4644e1d 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -79,7 +79,6 @@ testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
-testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
testConstraint notWinCI [expr {
$tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
index f7407b4..61076f5 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -2,24 +2,19 @@
package require tcltest 2.5
namespace import ::tcltest::*
-testConstraint exec [llength [info commands exec]]
-if {[namespace which testdebug] ne {}} {
- testConstraint debug [testdebug]
- testConstraint purify [testpurify]
- testConstraint debugpurify [
- expr {
- ![testConstraint memory]
- &&
- [testConstraint debug]
- &&
- [testConstraint purify]
- }]
-}
-testConstraint nodep [info exists tcl_precision]
+testConstraint exec [llength [info commands exec]]
+testConstraint nodep [expr {![tcl::build-info no-deprecate]}]
+testConstraint debug [tcl::build-info debug]
+testConstraint purify [tcl::build-info purify]
+testConstraint debugpurify [
+ expr {
+ ![tcl::build-info memdebug]
+ && [testConstraint debug]
+ && [testConstraint purify]
+ }]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint fileevent [llength [info commands fileevent]]
-testConstraint thread [
- expr {0 == [catch {package require Thread 2.7-}]}]
+testConstraint thread [expr {![catch {package require Thread 2.7-}]}]
testConstraint notValgrind [expr {![testConstraint valgrind]}]
diff --git a/tests/winDde.test b/tests/winDde.test
index 925574b..ad21426 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -13,8 +13,8 @@ if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
+package require tcltests
-testConstraint debug [::tcl::pkgconfig get debug]
testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index d118725..43c7ced 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -29,7 +29,7 @@ testConstraint longFileNames 0
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
-testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
+testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}]
proc createfile {file {string a}} {
set f [open $file w]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 6f2ea52..33a87bb 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1257,11 +1257,6 @@ tclAsync.o: $(GENERIC_DIR)/tclAsync.c
tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBasic.c
-tclUuid.h: $(TOP_DIR)/manifest.uuid
- echo "#define TCL_VERSION_UUID \\" >$@
- cat $(TOP_DIR)/manifest.uuid >>$@
- echo "" >>$@
-
tclBinary.o: $(GENERIC_DIR)/tclBinary.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBinary.c
@@ -1316,7 +1311,7 @@ tclEnsemble.o: $(GENERIC_DIR)/tclEnsemble.c $(COMPILEHDR)
tclEnv.o: $(GENERIC_DIR)/tclEnv.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c
-tclEvent.o: $(GENERIC_DIR)/tclEvent.c
+tclEvent.o: $(GENERIC_DIR)/tclEvent.c tclUuid.h
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c
tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)
@@ -1529,7 +1524,7 @@ tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
-I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \
$(GENERIC_DIR)/tclZipfs.c
-tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
+tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h
$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
@@ -2230,9 +2225,17 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
cd $(MAC_OSX_DIR); autoheader; touch $@
+tclUuid.h: $(TOP_DIR)/manifest.uuid
+ echo "#define TCL_VERSION_UUID \\" >$@
+ cat $(TOP_DIR)/manifest.uuid >>$@
+ echo "" >>$@
+
$(TOP_DIR)/manifest.uuid:
printf "git-" >$(TOP_DIR)/manifest.uuid
- (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || printf "unknown" >$(TOP_DIR)/manifest.uuid)
+ (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \
+ (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \
+ svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \
+ printf "unknown" >$(TOP_DIR)/manifest.uuid)
dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \
$(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH}
@@ -2315,7 +2318,8 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen
cp -p $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \
$(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \
$(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
- $(TOP_DIR)/win/tclsh.exe.manifest.in \
+ $(TOP_DIR)/win/tclsh.exe.manifest.in $(TOP_DIR)/win/tclUuid.h.in \
+ $(TOP_DIR)/win/gitmanifest.in $(TOP_DIR)/win/svnmanifest.in \
$(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
$(DISTDIR)/win
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index d7f51bf..5c24d40 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -184,15 +184,15 @@
/* Define to 1 if you have the `OSSpinLockLock' function. */
#undef HAVE_OSSPINLOCKLOCK
+/* Should we use pselect()? */
+#undef HAVE_PSELECT
+
/* Define to 1 if you have the `pthread_atfork' function. */
#undef HAVE_PTHREAD_ATFORK
/* Define to 1 if you have the `pthread_attr_setstacksize' function. */
#undef HAVE_PTHREAD_ATTR_SETSTACKSIZE
-/* Define to 1 if you have the `pselect' function */
-#undef HAVE_PSELECT
-
/* Does putenv() copy strings or incorporate them by reference? */
#undef HAVE_PUTENV_THAT_COPIES
diff --git a/win/Makefile.in b/win/Makefile.in
index 4b6921c..35c4f21 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -673,9 +673,14 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c
-DBUILD_tcl \
@DEPARG@ $(CC_OBJNAME)
+tclEvent.${OBJEXT}: tclEvent.c tclUuid.h
+
$(TOP_DIR)/manifest.uuid:
printf "git-" >$(TOP_DIR)/manifest.uuid
- (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || printf "unknown" >$(TOP_DIR)/manifest.uuid)
+ (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \
+ (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \
+ svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \
+ printf "unknown" >$(TOP_DIR)/manifest.uuid)
tclUuid.h: $(TOP_DIR)/manifest.uuid
echo "#define TCL_VERSION_UUID \\" >$@
diff --git a/win/makefile.vc b/win/makefile.vc
index 70d7629..74a72f6 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -799,14 +799,18 @@ $(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c
-Fo$@ $?
$(ROOT)\manifest.uuid:
- copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
- git rev-parse HEAD >>$(ROOT)\manifest.uuid
+ copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
+ git rev-parse HEAD >>$(ROOT)\manifest.uuid
$(TMP_DIR)\tclUuid.h: $(ROOT)\manifest.uuid
copy $(WIN_DIR)\tclUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\tclUuid.h
-$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(appcflags) -Fo$@ $?
+$(TMP_DIR)\tclEvent.obj: $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclUuid.h
+ $(cc32) $(pkgcflags) -I$(TMP_DIR) \
+ -Fo$@ $(GENERICDIR)\tclEvent.c
+
+$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
+ $(cc32) $(appcflags) -I$(TMP_DIR) -Fo$@ $?
$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(cc32) $(appcflags) -Fo$@ $?
diff --git a/win/svnmanifest.in b/win/svnmanifest.in
new file mode 100644
index 0000000..18d2cad
--- /dev/null
+++ b/win/svnmanifest.in
@@ -0,0 +1 @@
+svn-r \ No newline at end of file
diff --git a/win/tclUuid.h.in b/win/tclUuid.h.in
new file mode 100644
index 0000000..cbb83e4
--- /dev/null
+++ b/win/tclUuid.h.in
@@ -0,0 +1 @@
+#define TCL_VERSION_UUID \
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2830a85..e51b909 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -535,7 +535,8 @@ TclpSetVariables(
TCL_GLOBAL_ONLY);
}
-#ifndef NDEBUG
+#if !defined(NDEBUG) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+
/*
* The existence of the "debug" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with debug
generated by cgit v0.12 at 2025-12-07 23:08:17 (GMT)