Fix [Bug 2883850]: pkgIndex.tcl doesn't

get created with static Tcl build

5 files changed, 97 insertions, 27 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index eefe5f6..d02df6b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.447 2009/11/16 18:00:11 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.448 2009/11/18 23:46:05 nijtmans Exp $
  */
 
 #ifndef _TCLINT
@@ -4026,6 +4026,22 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
 			    Tcl_WideUInt initVal);
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * External (platform specific) initialization routine, these declarations
+ * explicitly don't use EXTERN since this code does not get compiled into the
+ * library:
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int	TclplatformtestInit(Tcl_Interp *interp);
+MODULE_SCOPE int	TclObjTest_Init(Tcl_Interp *interp);
+MODULE_SCOPE int	TclThread_Init(Tcl_Interp *interp);
+MODULE_SCOPE int	Procbodytest_Init(Tcl_Interp *interp);
+MODULE_SCOPE int	Procbodytest_SafeInit(Tcl_Interp *interp);
+
+/*
  *----------------------------------------------------------------
  * Macro used by the Tcl core to check whether a pattern has any characters
  * special to [string match]. The ANSI C "prototype" for this macro is:
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b089065..ca0d507 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,9 +14,12 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.138 2009/11/16 18:01:49 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.139 2009/11/18 23:46:05 nijtmans Exp $
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #define TCL_TEST
 #include "tclInt.h"
 
@@ -40,6 +43,17 @@
  */
 
 /*
+ * 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);
+
+/*
  * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
  * the results of the various deletion callbacks.
  */
@@ -494,15 +508,6 @@ static const Tcl_Filesystem simpleFilesystem = {
 
 
 /*
- * External (platform specific) initialization routine, these declarations
- * explicitly don't use EXTERN since this code does not get compiled into the
- * library:
- */
-
-extern int		TclplatformtestInit(Tcl_Interp *interp);
-extern int		TclThread_Init(Tcl_Interp *interp);
-
-/*
  *----------------------------------------------------------------------
  *
  * Tcltest_Init --
@@ -535,6 +540,9 @@ Tcltest_Init(
 	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
     };
 
+    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+	return TCL_ERROR;
+    }
     /* TIP #268: Full patchlevel instead of just major.minor */
 
     if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
@@ -672,7 +680,12 @@ Tcltest_Init(
     Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
 	    (ClientData) NULL, NULL);
 
-
+    if (TclObjTest_Init(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Procbodytest_Init(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
 #ifdef TCL_THREADS
     if (TclThread_Init(interp) != TCL_OK) {
 	return TCL_ERROR;
@@ -718,6 +731,35 @@ Tcltest_Init(
 
     return TclplatformtestInit(interp);
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcltest_SafeInit --
+ *
+ *	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
+Tcltest_SafeInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+	return TCL_ERROR;
+    }
+    return Procbodytest_SafeInit(interp);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -4387,7 +4429,7 @@ TestfinexitObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int value;
-    
+
     if ((objc != 1) && (objc != 2)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
 	return TCL_ERROR;
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index dba06f9..43a64cd 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -13,9 +13,12 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTestObj.c,v 1.34 2009/02/16 04:33:10 dgp Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.35 2009/11/18 23:46:05 nijtmans Exp $
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
 #include "tommath.h"
 
@@ -996,7 +999,7 @@ TeststringobjCmd(
     TestString *strPtr;
     static const char *const options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
-	"set", "set2", "setlength", "maxchars", "getunicode", 
+	"set", "set2", "setlength", "maxchars", "getunicode",
 	"appendself", "appendself2", NULL
     };
 
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index b961e3c..2d5745e 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -10,23 +10,26 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.9 2009/02/10 23:08:56 nijtmans Exp $
+ * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.10 2009/11/18 23:46:05 nijtmans Exp $
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
 
 /*
  * name and version of this package
  */
 
-static char packageName[] = "procbodytest";
-static char packageVersion[] = "1.0";
+static const char packageName[] = "procbodytest";
+static const char packageVersion[] = "1.0";
 
 /*
  * Name of the commands exported by this package
  */
 
-static char procCommand[] = "proc";
+static const char procCommand[] = "proc";
 
 /*
  * this struct describes an entry in the table of command names and command
@@ -34,7 +37,7 @@ static char procCommand[] = "proc";
  */
 
 typedef struct CmdTable {
-    char *cmdName;		/* command name */
+    const char *cmdName;		/* command name */
     Tcl_ObjCmdProc *proc;	/* command proc */
     int exportIt;		/* if 1, export the command */
 } CmdTable;
@@ -47,7 +50,7 @@ static int	ProcBodyTestProcObjCmd(ClientData dummy,
 			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
 static int	ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
 static int	RegisterCommand(Tcl_Interp* interp,
-			char *namespace, const CmdTable *cmdTablePtr);
+			const char *namespace, const CmdTable *cmdTablePtr);
 int		Procbodytest_Init(Tcl_Interp * interp);
 int		Procbodytest_SafeInit(Tcl_Interp * interp);
 
@@ -135,7 +138,7 @@ static int
 RegisterCommand(
     Tcl_Interp* interp,		/* the Tcl interpreter for which the operation
 				 * is performed */
-    char *namespace,		/* the namespace in which the command is
+    const char *namespace,		/* the namespace in which the command is
 				 * registered */
     const CmdTable *cmdTablePtr)/* the command to register */
 {
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 3b7c506..d4a5f92 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -12,13 +12,14 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclThreadTest.c,v 1.31 2009/02/10 23:09:05 nijtmans Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.32 2009/11/18 23:46:05 nijtmans Exp $
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
 
-extern int	Tcltest_Init(Tcl_Interp *interp);
-
 #ifdef TCL_THREADS
 /*
  * Each thread has an single instance of the following structure. There is one
@@ -577,14 +578,19 @@ NewTestThread(
 
     tsdPtr->interp = Tcl_CreateInterp();
     result = Tcl_Init(tsdPtr->interp);
-    result = TclThread_Init(tsdPtr->interp);
+    if (result != TCL_OK) {
+	ThreadErrorProc(tsdPtr->interp);
+    }
 
     /*
      * This is part of the test facility. Initialize _ALL_ test commands for
      * use by the new thread.
      */
 
-    result = Tcltest_Init(tsdPtr->interp);
+    result = Tcl_PackageRequire(tsdPtr->interp, "Tcltest", TCL_VERSION, 1);
+    if (result != TCL_OK) {
+	ThreadErrorProc(tsdPtr->interp);
+    }
 
     /*
      * Update the list of threads.