Builds for Tcl 8 and 9. Passes test suite on Win and Ubuntu

Author: apnadkarni

configure

@@ -34,17 +34,8 @@ AC_CONFIG_AUX_DIR(tclconfig)
 #--------------------------------------------------------------------
 
 TEA_PATH_TCLCONFIG
-if test x"${with_tcl8}" != x; then
-with_tcl8=""
-AC_MSG_WARN([--with-tcl8 option ignored])
-fi
 TEA_LOAD_TCLCONFIG
 
-if test "${TCL_MAJOR_VERSION}" -eq 8; then
-    AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 9.0+
-Found config for Tcl ${TCL_VERSION}])
-fi
-
 #--------------------------------------------------------------------
 # Load the tkConfig.sh file if necessary (Tk extension)
 #--------------------------------------------------------------------
@@ -213,16 +204,19 @@ TEA_PROG_TCLSH
 #--------------------------------------------------------------------
 #	Zipfs support - Tip 430
 #--------------------------------------------------------------------
-AC_ARG_ENABLE(zipfs,
-    AS_HELP_STRING([--enable-zipfs],[build with Zipfs support (default: on)]),
-    [tcl_ok=$enableval], [tcl_ok=yes])
-if test "$tcl_ok" = "yes" -a "x$enable_framework" != "xyes"; then
-    ZIPFS_BUILD=1
-    THREAD_ZIP_FILE=lib${PACKAGE_NAME}${PACKAGE_VERSION}.zip
-else
-    ZIPFS_BUILD=0
-    THREAD_ZIP_FILE=
+if test "${TCL_MAJOR_VERSION}" -gt 8; then
+    AC_ARG_ENABLE(zipfs,
+        AS_HELP_STRING([--enable-zipfs],[build with Zipfs support (default: on)]),
+        [tcl_ok=$enableval], [tcl_ok=yes])
+    if test "$tcl_ok" = "yes" -a "x$enable_framework" != "xyes"; then
+        ZIPFS_BUILD=1
+        THREAD_ZIP_FILE=lib${PACKAGE_NAME}${PACKAGE_VERSION}.zip
+    else
+        ZIPFS_BUILD=0
+        THREAD_ZIP_FILE=
+    fi
 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

configure.ac

@@ -22,6 +22,34 @@
 
 #include <tcl.h>
 
+/*
+ * Bunch of Tcl8 and Tcl9 compatibility definitions.
+ */
+#ifdef Tcl_Size
+# undef Tcl_Size
+  typedef int Tcl_Size;
+#endif
+#ifndef TCL_INDEX_NONE
+# define TCL_INDEX_NONE (-1)
+#endif
+
+#if TCL_MAJOR_VERSION < 9
+  typedef Tcl_ObjCmdProc Tcl_ObjCmdProc2;
+# ifndef TCL_HASH_TYPE
+#   define TCL_HASH_TYPE size_t
+# endif
+#endif
+
+#ifndef TCL_Z_MODIFIER
+#   if defined(__GNUC__) && !defined(_WIN32)
+#	define TCL_Z_MODIFIER	"z"
+#   elif defined(_WIN64)
+#	define TCL_Z_MODIFIER	TCL_LL_MODIFIER
+#   else
+#	define TCL_Z_MODIFIER	""
+#   endif
+#endif /* !TCL_Z_MODIFIER */
+
 /*
  * Exported from threadCmd.c file.
  */

generic/tclThread.h

@@ -135,6 +135,9 @@ MODULE_SCOPE const char *TpoolInit(Tcl_Interp *interp);
  * Utility macros
  */
 
+#if TCL_MAJOR_VERSION < 9
+# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
+#endif
 #define TCL_CMD(a,b,c) \
   if (Tcl_CreateObjCommand2((a),(b),(c),NULL, NULL) == NULL) \
     return NULL;
@@ -147,6 +150,19 @@ MODULE_SCOPE const char *TpoolInit(Tcl_Interp *interp);
   (ThreadSpecificData*)Tcl_GetThreadData((keyPtr),sizeof(ThreadSpecificData))
 #endif
 
+#ifdef TCL_QUEUE_ALERT_IF_EMPTY
+static inline void
+ThreadQueueEvent(Tcl_ThreadId thrId, Tcl_Event *evPtr, int position) {
+    Tcl_ThreadQueueEvent(thrId, evPtr, position|TCL_QUEUE_ALERT_IF_EMPTY);
+}
+#else
+static inline void
+ThreadQueueEvent(Tcl_ThreadId thrId, Tcl_Event *evPtr, int position) {
+    Tcl_ThreadQueueEvent(thrId, evPtr, position);
+    Tcl_ThreadAlert(thrId);
+}
+#endif
+
 /*
  * Structure to pass to NsThread_Init. This holds the module
  * and virtual server name for proper interp initializations.

generic/tclThreadInt.h

@@ -312,7 +312,9 @@ const Tcl_ObjType keyedListType = {
     DupKeyedListInternalRep,  /* dupIntRepProc */
     UpdateStringOfKeyedList,  /* updateStringProc */
     NULL,                     /* setFromAnyProc */
+#if TCL_MAJOR_VERSION >= 9
     TCL_OBJTYPE_V0
+#endif
 };
 
 

generic/tclXkeylist.c

@@ -375,25 +375,15 @@ static const char *
 ThreadInit(
     Tcl_Interp *interp /* The current Tcl interpreter */
 ) {
-    /* Tcl 8.7 interps are only supported on 32-bit machines.
-     * Lower than that is never supported. Bye!
-     */
-#if defined(TCL_WIDE_INT_IS_LONG) && TCL_MAJOR_VERSION < 9
-#   error "Thread 3.0 is only supported with Tcl 9.0 and higher."
-#	error "Please use Thread 2.8 (branch thread-2-8-branch)"
-#endif
-
-	/* Even though it's not supported, Thread 3.0 works with Tcl 8.7
-	 * on 32-bit platforms, so allow that for now. It could be that
-	 * Tcl 9.0 introduces a further binary incompatibility in the
-	 * future, so this is not guaranteed to stay like it is now!
-	 */
-    const char *ver = (sizeof(size_t) == sizeof(int))? "8.7-": "9.0";
-
-    if (!((Tcl_InitStubs)(interp, ver, (TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16),
-	    TCL_STUB_MAGIC))) {
+#ifdef USE_TCL_STUBS
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 	return NULL;
     }
+#else
+    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
+	return NULL;
+    }
+#endif
 
     if (threadMutex == NULL){
 	Tcl_MutexLock(&threadMutex);
@@ -2469,7 +2459,7 @@ ThreadTransfer(
      * Queue the event and poke the other thread's notifier.
      */
 
-    Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
+    ThreadQueueEvent(thrId, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
 
     /*
      * (*) Block until the other thread has either processed the transfer
@@ -2810,9 +2800,9 @@ ThreadSend(
 
     eventPtr->event.proc = ThreadEventProc;
     if ((flags & THREAD_SEND_HEAD)) {
-	Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_HEAD|TCL_QUEUE_ALERT_IF_EMPTY);
+	ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_HEAD);
     } else {
-	Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
+	ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_TAIL);
     }
 
     if ((flags & THREAD_SEND_WAIT) == 0) {
@@ -3087,7 +3077,7 @@ ThreadReserve(
 	    evPtr->clbkData   = NULL;
 	    evPtr->resultPtr  = resultPtr;
 
-	    Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
+	    ThreadQueueEvent(thrId, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL);
 
 	    if (dowait) {
 		while (resultPtr->result == NULL) {

generic/threadCmd.c

@@ -1815,7 +1815,7 @@ SignalWaiter(
     evPtr = (Tcl_Event *)Tcl_Alloc(sizeof(Tcl_Event));
     evPtr->proc = RunStopEvent;
 
-    Tcl_ThreadQueueEvent(waitPtr->threadId,(Tcl_Event*)evPtr,TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
+    ThreadQueueEvent(waitPtr->threadId,(Tcl_Event*)evPtr,TCL_QUEUE_TAIL);
 }
 
 /*

generic/threadPoolCmd.c

@@ -190,9 +190,8 @@ ThreadMutexObjCmd(
     static const char *const cmdOpts[] = {
 	"create", "destroy", "lock", "unlock", NULL
     };
-    enum options {
-	m_CREATE, m_DESTROY, m_LOCK, m_UNLOCK
-    } opt;
+    enum options { m_CREATE, m_DESTROY, m_LOCK, m_UNLOCK };
+    int opt;
 
     /*
      * Syntax:
@@ -367,7 +366,8 @@ ThreadRWMutexObjCmd(
     };
     enum options {
 	w_CREATE, w_DESTROY, w_RLOCK, w_WLOCK, w_UNLOCK
-    } opt;
+    };
+    int opt;
 
     /*
      * Syntax:
@@ -527,9 +527,8 @@ ThreadCondObjCmd(
     static const char *const cmdOpts[] = {
 	"create", "destroy", "notify", "wait", NULL
     };
-    enum options {
-	c_CREATE, c_DESTROY, c_NOTIFY, c_WAIT
-    } opt;
+    enum options { c_CREATE, c_DESTROY, c_NOTIFY, c_WAIT };
+    int opt;
 
     /*
      * Syntax:

generic/threadSpCmd.c

@@ -1233,7 +1233,8 @@ SvArrayObjCmd(
     enum options {
 	ASET,   ARESET,  AGET,  ANAMES,  ASIZE,  AEXISTS, AISBOUND,
 	ABIND,  AUNBIND
-    } index;
+    };
+    int index;
 
     svObj = (Container*)arg;
 

generic/threadSvCmd.c

@@ -13,6 +13,25 @@
 #include "threadSvCmd.h"
 #include "threadSvListCmd.h"
 
+/* Tcl 8 only defines Tcl_GetIntForIndex in its internal stubs */
+#if TCL_MAJOR_VERSION < 9 && defined(USE_TCL_STUBS)
+/*  Little hack to eliminate the need for "tclInt.h" here:
+    Just copy a small portion of TclIntStubs, just
+    enough to make it work */
+typedef struct TclIntStubs {
+    int magic;
+    void *hooks;
+    void (*dummy[34]) (void); /* dummy entries 0-33, not used */
+    int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
+} TclIntStubs;
+extern const TclIntStubs *tclIntStubsPtr;
+
+# undef Tcl_GetIntForIndex
+# define Tcl_GetIntForIndex(interp, obj, max, ptr) ((tclIntStubsPtr->tclGetIntForIndex == NULL)? \
+    ((int (*)(Tcl_Interp*,  Tcl_Obj *, int, int*))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[645]))((interp), (obj), (max), (ptr)): \
+	tclIntStubsPtr->tclGetIntForIndex((interp), (obj), (max), (ptr)))
+#endif
+
 /*
  * Implementation of list commands for shared variables.
  * Most of the standard Tcl list commands are implemented.
@@ -661,7 +680,8 @@ SvLsearchObjCmd(
     Container *svObj = (Container*)arg;
 
     static const char *const modes[] = {"-exact", "-glob", "-regexp", NULL};
-    enum {LS_EXACT, LS_GLOB, LS_REGEXP} mode;
+    enum { LS_EXACT, LS_GLOB, LS_REGEXP };
+    int mode;
 
     mode = LS_GLOB;